1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2010-2020. 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
21-module(lcnt).
22-behaviour(gen_server).
23-author("Björn-Egil Dahlberg").
24
25%% gen_server callbacks
26-export([init/1,
27         handle_call/3,
28         handle_cast/2,
29         handle_info/2,
30         terminate/2,
31         code_change/3]).
32
33%% start/stop
34-export([start/0,
35         stop/0]).
36
37%% erts_debug:lcnt_xxx api
38-export([rt_mask/0,
39         rt_mask/1,
40         rt_mask/2,
41         rt_collect/0,
42         rt_collect/1,
43         rt_clear/0,
44         rt_clear/1,
45         rt_opt/1,
46         rt_opt/2]).
47
48
49%% gen_server call api
50-export([raw/0,
51         collect/0,
52         collect/1,
53         clear/0,
54         clear/1,
55         conflicts/0,
56         conflicts/1,
57         locations/0,
58         locations/1,
59         inspect/1,
60         inspect/2,
61         histogram/1,
62         histogram/2,
63         information/0,
64         swap_pid_keys/0,
65         % set options
66         set/1,
67         set/2,
68
69         load/1,
70         save/1]).
71
72%% convenience
73-export([apply/3,
74         apply/2,
75         apply/1,
76         all_conflicts/0,
77         all_conflicts/1,
78         pid/2, pid/3,
79         port/1, port/2]).
80
81-define(version, "1.0").
82
83-record(state, {
84	locks      = [],
85	duration   = 0
86    }).
87
88-record(stats, {
89	file  :: atom(),
90	line  :: non_neg_integer() | 'undefined',
91	tries :: non_neg_integer(),
92	colls :: non_neg_integer(),
93	time  :: non_neg_integer(), % us
94	nt    :: non_neg_integer(), % #timings collected
95	hist  :: tuple() | 'undefined'  % histogram
96    }).
97
98-record(lock, {
99	name,
100	id,
101	type,
102	stats = []
103    }).
104
105-record(print, {
106	name,
107	id,
108	type,
109	entry,
110	tries,
111	colls,
112	cr,     % collision ratio
113	time,
114	dtr,    % time duration ratio
115	%% new
116	hist    % log2 histogram of lock wait_time
117    }).
118
119
120
121%% -------------------------------------------------------------------- %%
122%%
123%% start/stop/init
124%%
125%% -------------------------------------------------------------------- %%
126
127-spec start() -> {'ok', Pid} | {'error', {'already_started', Pid}} when
128      Pid :: pid().
129
130start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []).
131
132-spec stop() -> 'ok'.
133
134stop()-> gen_server:stop(?MODULE, normal, infinity).
135
136init([]) -> {ok, #state{ locks = [], duration = 0 } }.
137
138-dialyzer({no_match, start_internal/0}).
139start_internal() ->
140    case start() of
141        {ok,_} -> ok;
142        {error, {already_started,_}} -> ok;
143        Error -> Error
144    end.
145
146%% -------------------------------------------------------------------- %%
147%%
148%% API erts_debug:lcnt_xxx
149%%
150%% -------------------------------------------------------------------- %%
151
152-spec rt_mask(Node, Categories) ->  'ok' | {'error', 'copy_save_enabled'} when
153      Node :: node(),
154      Categories :: [category_atom()].
155
156rt_mask(Node, Categories) when is_atom(Node), is_list(Categories) ->
157    rpc:call(Node, lcnt, rt_mask, [Categories]).
158
159-type category_atom() :: atom().
160
161-spec rt_mask(Node) -> [category_atom()] when
162                  Node :: node();
163             (Categories) -> 'ok' | {'error', 'copy_save_enabled'} when
164                  Categories :: [category_atom()].
165
166rt_mask(Node) when is_atom(Node) ->
167    rpc:call(Node, lcnt, rt_mask, []);
168rt_mask(Categories) when is_list(Categories) ->
169    case erts_debug:lcnt_control(copy_save) of
170        false ->
171            erts_debug:lcnt_control(mask, Categories);
172        true ->
173            {error, copy_save_enabled}
174    end.
175
176-spec rt_mask() -> [category_atom()].
177
178rt_mask() ->
179    erts_debug:lcnt_control(mask).
180
181-type lock_counter_data() :: term().
182
183-spec rt_collect(Node) -> [lock_counter_data()] when
184      Node :: node().
185
186rt_collect(Node) ->
187    rpc:call(Node, lcnt, rt_collect, []).
188
189-spec rt_collect() -> [lock_counter_data()].
190
191rt_collect() ->
192    erts_debug:lcnt_collect().
193
194-spec rt_clear(Node) -> 'ok' when
195      Node :: node().
196
197rt_clear(Node) ->
198    rpc:call(Node, lcnt, rt_clear, []).
199
200-spec rt_clear() -> 'ok'.
201
202rt_clear() ->
203    erts_debug:lcnt_clear().
204
205-spec rt_opt(Node, Option) -> boolean() when
206      Node :: node(),
207      Option :: {Type, Value :: boolean()},
208      Type :: 'copy_save' | 'process_locks'.
209
210rt_opt(Node, Arg) ->
211    rpc:call(Node, lcnt, rt_opt, [Arg]).
212
213-spec rt_opt(Option) -> boolean() when
214      Option :: {Type, Value :: boolean()},
215      Type :: 'copy_save' | 'process_locks'.
216
217%% Compatibility shims for the "process/port_locks" options mentioned in the
218%% manual.
219rt_opt({process_locks, Enable}) ->
220    toggle_category(process, Enable);
221rt_opt({port_locks, Enable}) ->
222    toggle_category(io, Enable);
223rt_opt({Type, NewVal}) ->
224    PreviousVal = erts_debug:lcnt_control(Type),
225    erts_debug:lcnt_control(Type, NewVal),
226    PreviousVal.
227
228toggle_category(Category, true) ->
229    PreviousMask = erts_debug:lcnt_control(mask),
230    erts_debug:lcnt_control(mask, [Category | PreviousMask]),
231    lists:member(Category, PreviousMask);
232
233toggle_category(Category, false) ->
234    PreviousMask = erts_debug:lcnt_control(mask),
235    erts_debug:lcnt_control(mask, lists:delete(Category, PreviousMask)),
236    lists:member(Category, PreviousMask).
237
238%% -------------------------------------------------------------------- %%
239%%
240%% API implementation
241%%
242%% -------------------------------------------------------------------- %%
243
244-spec clear() -> 'ok'.
245
246clear() -> rt_clear().
247
248-spec clear(Node) -> 'ok' when
249      Node :: node().
250
251clear(Node) -> rt_clear(Node).
252
253-spec collect() -> 'ok'.
254
255collect() -> call({collect, rt_collect()}).
256
257-spec collect(Node) -> 'ok' when
258      Node :: node().
259
260collect(Node) -> call({collect, rt_collect(Node)}).
261
262-spec locations() -> 'ok'.
263
264locations() -> call({locations,[]}).
265
266-spec locations(Options) -> 'ok' when
267      Options :: [option()].
268
269locations(Opts) -> call({locations, Opts}).
270
271-spec conflicts() -> 'ok'.
272
273conflicts() -> call({conflicts, []}).
274
275-type sort() :: 'colls' | 'entry' | 'id' | 'name' | 'ratio' | 'time' |
276                'tries' | 'type'.
277
278-type threshold() :: {'colls', non_neg_integer()}
279                   | {'time', non_neg_integer()}
280                   | {'tries', non_neg_integer()}.
281
282-type print() :: 'colls' | 'duration' | 'entry' | 'id' | 'name' |
283                 'ratio' | 'time' | 'tries' | 'type'.
284
285-type option() :: {'sort', Sort :: sort()}
286                | {'reverse', boolean()}
287                | {'locations', boolean()}
288                | {'thresholds', Thresholds :: [threshold()]}
289                | {'print',
290                   PrintOptions :: [print() | {print(), non_neg_integer()}]}
291                | {'max_locks', MaxLocks :: non_neg_integer() | 'none'}
292                | {'combine', boolean()}.
293
294-spec conflicts(Options) -> 'ok' when
295      Options :: [option()].
296
297conflicts(Opts)      -> call({conflicts, Opts}).
298
299-spec inspect(Lock) -> 'ok' when
300      Lock :: Name | {Name, Id | [Id]},
301      Name :: atom() | pid() | port(),
302      Id :: atom() | integer() | pid() | port().
303
304inspect(Lock)        -> call({inspect, Lock, []}).
305
306-spec inspect(Lock, Options) -> 'ok' when
307      Lock :: Name | {Name, Id | [Id]},
308      Name :: atom() | pid() | port(),
309      Id :: atom() | integer() | pid() | port(),
310      Options :: [option()].
311
312inspect(Lock, Opts)  -> call({inspect, Lock, Opts}).
313
314histogram(Lock)      -> call({histogram, Lock, []}).
315histogram(Lock, Opts)-> call({histogram, Lock, Opts}).
316
317-spec information() -> 'ok'.
318
319information()        -> call(information).
320
321-spec swap_pid_keys() -> 'ok'.
322
323swap_pid_keys()      -> call(swap_pid_keys).
324
325raw()                -> call(raw).
326set(Option, Value)   -> call({set, Option, Value}).
327set({Option, Value}) -> call({set, Option, Value}).
328
329-spec save(Filename) -> 'ok' when
330      Filename :: file:filename().
331
332save(Filename)       -> call({save, Filename}).
333
334-spec load(Filename) -> 'ok' when
335      Filename :: file:filename().
336
337load(Filename)       -> call({load, Filename}).
338
339call(Msg) ->
340    ok = start_internal(),
341    gen_server:call(?MODULE, Msg, infinity).
342
343%% -------------------------------------------------------------------- %%
344%%
345%% convenience implementation
346%%
347%% -------------------------------------------------------------------- %%
348
349-spec apply(Module, Function, Args) -> term() when
350      Module :: module(),
351      Function :: atom(),
352      Args :: [term()].
353
354apply(M,F,As) when is_atom(M), is_atom(F), is_list(As) ->
355    apply(fun() ->
356        erlang:apply(M,F,As)
357    end).
358
359-spec apply(Fun) -> term() when
360      Fun :: fun().
361
362apply(Fun) when is_function(Fun) ->
363    lcnt:apply(Fun, []).
364
365-spec apply(Fun, Args) -> term() when
366      Fun :: fun(),
367      Args :: [term()].
368
369apply(Fun, As) when is_function(Fun) ->
370    Opt = lcnt:rt_opt({copy_save, true}),
371    lcnt:clear(),
372    Res = erlang:apply(Fun, As),
373    lcnt:collect(),
374    %% _ is bound to silence a dialyzer warning; it used to fail silently and
375    %% we don't want to change the error semantics.
376    _ = lcnt:rt_opt({copy_save, Opt}),
377    Res.
378
379all_conflicts() -> all_conflicts(time).
380all_conflicts(Sort) ->
381    conflicts([{max_locks, none}, {thresholds, []},{combine,false}, {sort, Sort}, {reverse, true}]).
382
383-spec pid(Id, Serial) -> pid() when
384      Id :: integer(),
385      Serial :: integer().
386
387pid(Id, Serial) -> pid(node(), Id, Serial).
388
389-spec pid(Node, Id, Serial) -> pid() when
390      Node :: node(),
391      Id :: integer(),
392      Serial :: integer().
393
394pid(Node, Id, Serial) when is_atom(Node) ->
395    Header   = <<131,103,100>>,
396    String   = atom_to_list(Node),
397    L        = length(String),
398    binary_to_term(list_to_binary([Header, bytes16(L), String, bytes32(Id), bytes32(Serial),0])).
399
400-spec port(Id) -> port() when
401      Id :: integer().
402
403port(Id) -> port(node(), Id).
404
405-spec port(Node, Id) -> port() when
406      Node :: node(),
407      Id :: integer().
408
409port(Node, Id ) when is_atom(Node) ->
410    Header   = <<131,102,100>>,
411    String   = atom_to_list(Node),
412    L        = length(String),
413    binary_to_term(list_to_binary([Header, bytes16(L), String, bytes32(Id), 0])).
414
415%% -------------------------------------------------------------------- %%
416%%
417%% handle_call
418%%
419%% -------------------------------------------------------------------- %%
420
421% printing
422
423handle_call({conflicts, InOpts}, _From, #state{ locks = Locks } = State) when is_list(InOpts) ->
424    Default = [
425	{sort,       time},
426	{reverse,    false},
427	{print,      [name,id,tries,colls,ratio,time,duration]},
428	{max_locks,  20},
429	{combine,    true},
430	{thresholds, [{tries, 0}, {colls, 0}, {time, 0}] },
431	{locations,  false}],
432
433    Opts       = options(InOpts, Default),
434    Flocks     = filter_locks_type(Locks, proplists:get_value(type, Opts)),
435    Combos     = combine_classes(Flocks, proplists:get_value(combine, Opts)),
436    Printables = locks2print(Combos, State#state.duration),
437    Filtered   = filter_print(Printables, Opts),
438
439    print_lock_information(Filtered, proplists:get_value(print, Opts)),
440
441    {reply, ok, State};
442
443handle_call(information, _From, State) ->
444    print_state_information(State),
445    {reply, ok, State};
446
447handle_call({locations, InOpts}, _From, #state{ locks = Locks } = State) when is_list(InOpts) ->
448    Default = [
449	{sort,       time},
450	{reverse,    false},
451	{print,      [name,entry,tries,colls,ratio,time,duration]},
452	{max_locks,  20},
453	{combine,    true},
454	{thresholds, [{tries, 0}, {colls, 0}, {time, 0}] },
455	{locations,  true}],
456
457    Opts = options(InOpts, Default),
458    Printables = filter_print([#print{
459	    name  = string_names(Names),
460	    entry = term2string("~tp:~p", [Stats#stats.file, Stats#stats.line]),
461	    colls = Stats#stats.colls,
462	    tries = Stats#stats.tries,
463	    cr    = percent(Stats#stats.colls, Stats#stats.tries),
464	    time  = Stats#stats.time,
465	    dtr   = percent(Stats#stats.time, State#state.duration)
466	} || {Stats, Names} <- combine_locations(Locks) ], Opts),
467
468    print_lock_information(Printables, proplists:get_value(print, Opts)),
469
470    {reply, ok, State};
471
472handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks=Locks } = State) when is_list(InOpts) ->
473    Default = [
474	{sort,       time},
475	{reverse,    false},
476	{print,      [name,id,tries,colls,ratio,time,duration,histogram]},
477	{max_locks,  20},
478	{combine,    false},
479	{thresholds, []},
480	{locations,  false}],
481
482    Opts      = options(InOpts, Default),
483    Filtered  = filter_locks(Locks, Lockname),
484    IDs       = case {proplists:get_value(full_id, Opts), proplists:get_value(combine, Opts)} of
485	{true, true} -> locks_ids(Filtered);
486	_            -> []
487    end,
488    Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)),
489    case proplists:get_value(locations, Opts) of
490	true ->
491	    lists:foreach(fun
492		    (#lock{ name = Name, id = Id, type = Type, stats =  Stats })  ->
493			IdString = case proplists:get_value(full_id, Opts) of
494			    true -> term2string(proplists:get_value(Name, IDs, Id));
495			    _    -> term2string(Id)
496			end,
497			Combined = [CStats || {CStats,_} <- combine_locations(Stats)],
498			case Combined of
499			    [] ->
500				ok;
501			    _  ->
502				print("lock: " ++ term2string(Name)),
503				print("id:   " ++ IdString),
504				print("type: " ++ term2string(Type)),
505				Ps = stats2print(Combined, Duration),
506				Opts1 = options([{print, [entry, tries,colls,ratio,time,duration,histogram]},
507					{thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts),
508				print_lock_information(filter_print(Ps, Opts1), proplists:get_value(print, Opts1))
509			end
510		end, Combos);
511	_ ->
512	    Print = filter_print(locks2print(Combos, Duration), Opts),
513	    print_lock_information(Print, proplists:get_value(print, Opts))
514    end,
515    {reply, ok, State};
516
517%% histogram
518
519handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, locks=Locks} = State)->
520    Default = [
521	{sort,       time},
522	{reverse,    false},
523	{print,      [name,id,tries,colls,ratio,time,duration,histogram]},
524	{max_locks,  20},
525	{combine,    true},
526	{thresholds, []},
527	{locations,  false}],
528
529    Opts     = options(InOpts, Default),
530    Filtered = filter_locks(Locks, Lockname),
531    Combos   = combine_classes(Filtered, proplists:get_value(combine, Opts)),
532    lists:foreach(fun
533	    (#lock{ stats = Stats }=L) ->
534		SumStats = summate_stats(Stats),
535		Opts1 = options([{print, [name,id,tries,colls,ratio,time,duration]},
536			{thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts),
537		Prints = locks2print([L], Duration),
538		print_lock_information(Prints, proplists:get_value(print, Opts1)),
539		print_full_histogram(SumStats#stats.hist)
540	end, Combos),
541
542    {reply, ok, State};
543
544handle_call(raw, _From, #state{ locks = Locks} = State)->
545    {reply, Locks, State};
546
547% collecting
548handle_call({collect, Data}, _From, State)->
549    {reply, ok, data2state(Data, State)};
550
551% manipulate
552handle_call(swap_pid_keys, _From, #state{ locks = Locks } = State)->
553    SwappedLocks = lists:map(fun
554	(L) when L#lock.name =:= port_lock; L#lock.type =:= proclock ->
555	    L#lock{ id = L#lock.name, name = L#lock.id };
556	(L) ->
557	    L
558    end, Locks),
559    {reply, ok, State#state{ locks = SwappedLocks}};
560
561% settings
562handle_call({set, data, Data}, _From, State)->
563    {reply, ok, data2state(Data, State)};
564
565handle_call({set, duration, Duration}, _From, State)->
566    {reply, ok, State#state{ duration = Duration}};
567
568% file operations
569handle_call({load, Filename}, _From, State) ->
570    case file:read_file(Filename) of
571	{ok, Binary} ->
572	    case binary_to_term(Binary) of
573		{?version, Statelist} ->
574		    {reply, ok, list2state(Statelist)};
575		{Version, _} ->
576		    {reply, {error, {mismatch, Version, ?version}}, State}
577	    end;
578	Error ->
579	    {reply, {error, Error}, State}
580    end;
581
582handle_call({save, Filename}, _From, State) ->
583    Binary = term_to_binary({?version, state2list(State)}),
584    case file:write_file(Filename, Binary) of
585	ok ->
586	    {reply, ok, State};
587	Error ->
588	    {reply, {error, Error}, State}
589    end;
590
591handle_call(Command, _From, State) ->
592    {reply, {error, {undefined, Command}}, State}.
593
594%% -------------------------------------------------------------------- %%
595%%
596%% handle_cast
597%%
598%% -------------------------------------------------------------------- %%
599
600handle_cast(_, State) ->
601    {noreply, State}.
602
603%% -------------------------------------------------------------------- %%
604%%
605%% handle_info
606%%
607%% -------------------------------------------------------------------- %%
608
609handle_info(_Info, State) ->
610    {noreply, State}.
611
612%% -------------------------------------------------------------------- %%
613%%
614%% termination
615%%
616%% -------------------------------------------------------------------- %%
617
618terminate(_Reason, _State) ->
619    ok.
620
621%% -------------------------------------------------------------------- %%
622%%
623%% code_change
624%%
625%% -------------------------------------------------------------------- %%
626
627code_change(_OldVsn, State, _Extra) ->
628    {ok, State}.
629
630%% -------------------------------------------------------------------- %%
631%%
632%% AUX
633%%
634%% -------------------------------------------------------------------- %%
635
636% summate
637
638summate_locks(Locks) -> summate_locks(Locks, #stats{ tries = 0, colls = 0, time = 0, nt = 0}).
639summate_locks([], Stats) -> Stats;
640summate_locks([L|Ls], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt, hist = Hist}) ->
641    S = summate_stats(L#lock.stats),
642    summate_locks(Ls, #stats{
643	    tries = Tries + S#stats.tries,
644	    colls = Colls + S#stats.colls,
645	    time  = Time + S#stats.time,
646	    nt    = Nt + S#stats.nt,
647	    hist  = summate_histogram(Hist, S#stats.hist)
648	}).
649
650summate_stats(Stats) -> summate_stats(Stats, #stats{ tries = 0, colls = 0, time = 0, nt = 0}).
651summate_stats([], Stats) -> Stats;
652summate_stats([S|Ss], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt, hist = Hist}) ->
653    summate_stats(Ss, #stats{
654	    tries = Tries + S#stats.tries,
655	    colls = Colls + S#stats.colls,
656	    time  = Time + S#stats.time,
657	    nt    = Nt + S#stats.nt,
658	    hist  = summate_histogram(Hist, S#stats.hist)
659	}).
660
661%% first call is undefined
662summate_histogram(Tup,undefined) when is_tuple(Tup) -> Tup;
663summate_histogram(undefined,Tup) when is_tuple(Tup) -> Tup;
664summate_histogram(Hs1,Hs2) ->
665    list_to_tuple([ A + B || {A,B} <- lists:zip(tuple_to_list(Hs1),tuple_to_list(Hs2))]).
666
667%% manipulators
668filter_locks_type(Locks, undefined) -> Locks;
669filter_locks_type(Locks, all) -> Locks;
670filter_locks_type(Locks, Types) when is_list(Types) ->
671    [ L || L <- Locks, lists:member(L#lock.type, Types)];
672filter_locks_type(Locks, Type) ->
673    [ L || L <- Locks, L#lock.type =:= Type].
674
675filter_locks(Locks, {Lockname, Ids}) when is_list(Ids) ->
676    [ L || L <- Locks, L#lock.name =:= Lockname, lists:member(L#lock.id, Ids)];
677filter_locks(Locks, {Lockname, Id}) ->
678    [ L || L <- Locks, L#lock.name =:= Lockname, L#lock.id =:= Id ];
679filter_locks(Locks, Lockname) ->
680    [ L || L <- Locks, L#lock.name =:= Lockname ].
681% order of processing
682% 2. cut thresholds
683% 3. sort locks
684% 4. max length of locks
685
686filter_print(PLs, Opts) ->
687    TLs = threshold_locks(PLs, proplists:get_value(thresholds,  Opts, [])),
688    SLs =      sort_locks(TLs, proplists:get_value(sort,        Opts, time)),
689    CLs =       cut_locks(SLs, proplists:get_value(max_locks,   Opts, none)),
690	    reverse_locks(CLs, proplists:get_value(reverse, Opts, false)).
691
692sort_locks(Locks, name)  -> reverse_sort_locks(#print.name,  Locks);
693sort_locks(Locks, id)    -> reverse_sort_locks(#print.id,    Locks);
694sort_locks(Locks, type)  -> reverse_sort_locks(#print.type,  Locks);
695sort_locks(Locks, tries) -> reverse_sort_locks(#print.tries, Locks);
696sort_locks(Locks, colls) -> reverse_sort_locks(#print.colls, Locks);
697sort_locks(Locks, ratio) -> reverse_sort_locks(#print.cr,    Locks);
698sort_locks(Locks, time)  -> reverse_sort_locks(#print.time,  Locks);
699sort_locks(Locks, _)     -> sort_locks(Locks, time).
700
701reverse_sort_locks(Ix, Locks) ->
702    lists:reverse(lists:keysort(Ix, Locks)).
703
704% cut locks not above certain thresholds
705threshold_locks(Locks, Thresholds) ->
706    Tries = proplists:get_value(tries, Thresholds, -1),
707    Colls = proplists:get_value(colls, Thresholds, -1),
708    Time  = proplists:get_value(time,  Thresholds, -1),
709    [ L || L <- Locks, L#print.tries > Tries, L#print.colls > Colls, L#print.time > Time].
710
711cut_locks(Locks, N) when is_integer(N), N > 0 -> lists:sublist(Locks, N);
712cut_locks(Locks, _) -> Locks.
713
714%% reversal
715reverse_locks(Locks, true) -> lists:reverse(Locks);
716reverse_locks(Locks, _) -> Locks.
717
718
719%%
720string_names([]) -> "";
721string_names(Names) -> string_names(Names, []).
722string_names([Name], Strings) -> strings(lists:reverse([term2string(Name) | Strings]));
723string_names([Name|Names],Strings) -> string_names(Names, [term2string(Name) ++ ","|Strings]).
724
725%% combine_locations
726%% In:
727%%	Locations :: [#lock{}] | [#stats{}]
728%% Out:
729%%	[{{File,Line}, #stats{}, [Lockname]}]
730
731
732combine_locations(Locations)    -> gb_trees:values(combine_locations(Locations, gb_trees:empty())).
733combine_locations([], Tree) -> Tree;
734combine_locations([S|_] = Stats, Tree) when is_record(S, stats) ->
735    combine_locations(Stats, undefined, Tree);
736combine_locations([#lock{ stats = Stats, name = Name}|Ls], Tree)  ->
737    combine_locations(Ls, combine_locations(Stats, Name, Tree)).
738
739combine_locations([], _, Tree) -> Tree;
740combine_locations([S|Ss], Name, Tree) when is_record(S, stats)->
741    Key  = {S#stats.file, S#stats.line},
742    Tree1 = case gb_trees:lookup(Key, Tree) of
743	none ->
744	    gb_trees:insert(Key, {S, [Name]}, Tree);
745	{value, {C, Names}} ->
746	    NewNames = case lists:member(Name, Names) of
747		true -> Names;
748		_    -> [Name | Names]
749	    end,
750	    gb_trees:update(Key, {
751		C#stats{
752		    tries = C#stats.tries + S#stats.tries,
753		    colls = C#stats.colls + S#stats.colls,
754		    time  = C#stats.time  + S#stats.time,
755		    nt    = C#stats.nt    + S#stats.nt
756		}, NewNames}, Tree)
757    end,
758    combine_locations(Ss, Name, Tree1).
759
760%% combines all statistics for a class (name) lock
761%% id's are translated to #id's.
762
763combine_classes(Locks, true) ->  combine_classes1(Locks, gb_trees:empty());
764combine_classes(Locks, _) -> Locks.
765
766combine_classes1([], Tree) ->  gb_trees:values(Tree);
767combine_classes1([L|Ls], Tree) ->
768    Key = L#lock.name,
769    case gb_trees:lookup(Key, Tree) of
770	none ->
771	    combine_classes1(Ls, gb_trees:insert(Key, L#lock{ id = 1 }, Tree));
772	{value, C} ->
773	    combine_classes1(Ls, gb_trees:update(Key, C#lock{
774		id    = C#lock.id    + 1,
775		stats = L#lock.stats ++ C#lock.stats
776	    }, Tree))
777    end.
778
779locks_ids(Locks) -> locks_ids(Locks, []).
780locks_ids([], Out) -> Out;
781locks_ids([#lock{ name = Key } = L|Ls], Out) ->
782    case proplists:get_value(Key, Out) of
783	undefined -> locks_ids(Ls, [{Key, [L#lock.id]}|Out]);
784	Ids ->       locks_ids(Ls, [{Key, [L#lock.id|Ids]}|proplists:delete(Key,Out)])
785    end.
786
787stats2print(Stats, Duration) ->
788    lists:map(fun
789	(S) ->
790	    #print{entry = term2string("~tp:~p", [S#stats.file, S#stats.line]),
791		   colls = S#stats.colls,
792		   tries = S#stats.tries,
793		   cr    = percent(S#stats.colls, S#stats.tries),
794		   time  = S#stats.time,
795		   dtr   = percent(S#stats.time,  Duration),
796		   hist  = format_histogram(S#stats.hist)}
797	end, Stats).
798
799locks2print(Locks, Duration) ->
800    lists:map( fun
801	(L) ->
802	    #stats{tries = Tries,
803		   colls = Colls,
804		   time  = Time,
805		   hist  = Hist} = summate_stats(L#lock.stats),
806	    Cr  = percent(Colls, Tries),
807	    Dtr = percent(Time,  Duration),
808	    #print{name  = L#lock.name,
809		   id    = L#lock.id,
810		   type  = L#lock.type,
811		   tries = Tries,
812		   colls = Colls,
813		   hist  = format_histogram(Hist),
814		   cr    = Cr,
815		   time  = Time,
816		   dtr   = Dtr}
817	end, Locks).
818
819
820format_histogram(Tup) when is_tuple(Tup) ->
821    Vs   = tuple_to_list(Tup),
822    Max  = lists:max(Vs),
823    case Max of
824	0 -> string_histogram(Vs);
825	_ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs])
826    end.
827
828string_histogram(Vs) ->
829    [$||histogram_values_to_string(Vs,$|)].
830
831histogram_values_to_string([0|Vs],End) ->
832    [$\s|histogram_values_to_string(Vs,End)];
833histogram_values_to_string([V|Vs],End) when V > 0.66 ->
834    [$X|histogram_values_to_string(Vs,End)];
835histogram_values_to_string([V|Vs],End) when V > 0.33 ->
836    [$x|histogram_values_to_string(Vs,End)];
837histogram_values_to_string([_|Vs],End) ->
838    [$.|histogram_values_to_string(Vs,End)];
839histogram_values_to_string([],End) ->
840    [End].
841
842%% state making
843
844data2state(Data, State) ->
845    Duration = time2us(proplists:get_value(duration, Data)),
846    Rawlocks = proplists:get_value(locks, Data),
847    Locks    = locks2records(Rawlocks),
848    State#state{
849	duration = Duration,
850	locks    = Locks
851    }.
852
853locks2records([{Name, Id, Type, Stats}|Locks]) ->
854    [#lock{name  = Name,
855	   id    = clean_id_creation(Id),
856	   type  = Type,
857	   stats = stats2record(Stats)}|locks2records(Locks)];
858locks2records([]) -> [].
859
860%% new stats with histogram
861stats2record([{{File,Line},{Tries,Colls,{S,Ns,N}},Hist}|Stats]) ->
862    [#stats{file  = File,
863	    line  = Line,
864	    hist  = Hist,
865	    tries = Tries,
866	    colls = Colls,
867	    time  = time2us({S, Ns}),
868	    nt    = N} | stats2record(Stats)];
869%% old stats without histogram
870stats2record([{{File,Line},{Tries,Colls,{S,Ns,N}}}|Stats]) ->
871    [#stats{file  = File,
872	    line  = Line,
873	    hist  = {},
874	    tries = Tries,
875	    colls = Colls,
876	    time  = time2us({S, Ns}),
877	    nt    = N} | stats2record(Stats)];
878stats2record([]) -> [].
879
880
881clean_id_creation(Id) when is_pid(Id) ->
882    Bin = term_to_binary(Id),
883    <<H:3/binary, Rest/binary>> = Bin,
884    <<131, PidTag, AtomTag>> = H,
885    LL = atomlen_bits(AtomTag),
886    CL = creation_bits(PidTag),
887    <<L:LL, Node:L/binary, Ids:8/binary, _Creation/binary>> = Rest,
888    Bin2 = list_to_binary([H, <<L:LL>>, Node, Ids, <<0:CL>>]),
889    binary_to_term(Bin2);
890clean_id_creation(Id) when is_port(Id) ->
891    Bin = term_to_binary(Id),
892    <<H:3/binary, Rest/binary>> = Bin,
893    <<131, PortTag, AtomTag>> = H,
894    LL = atomlen_bits(AtomTag),
895    CL = creation_bits(PortTag),
896    <<L:LL, Node:L/binary, Ids:4/binary, _Creation/binary>> = Rest,
897    Bin2 = list_to_binary([H, <<L:LL>>, Node, Ids, <<0:CL>>]),
898    binary_to_term(Bin2);
899clean_id_creation(Id) ->
900    Id.
901
902-define(PID_EXT, $g).
903-define(NEW_PID_EXT, $X).
904-define(PORT_EXT, $f).
905-define(NEW_PORT_EXT, $Y).
906-define(ATOM_EXT, $d).
907-define(SMALL_ATOM_EXT, $s).
908-define(ATOM_UTF8_EXT, $v).
909-define(SMALL_ATOM_UTF8_EXT, $w).
910
911atomlen_bits(?ATOM_EXT) -> 16;
912atomlen_bits(?SMALL_ATOM_EXT) -> 8;
913atomlen_bits(?ATOM_UTF8_EXT) -> 16;
914atomlen_bits(?SMALL_ATOM_UTF8_EXT) -> 8.
915
916creation_bits(?PID_EXT) -> 8;
917creation_bits(?NEW_PID_EXT) -> 32;
918creation_bits(?PORT_EXT) -> 8;
919creation_bits(?NEW_PORT_EXT) -> 32.
920
921%% serializer
922
923state_default(Field) -> proplists:get_value(Field, state2list(#state{})).
924
925state2list(State) ->
926    [_|Values] = tuple_to_list(State),
927    lists:zipwith(fun
928	(locks, Locks) -> {locks, [lock2list(Lock) || Lock <- Locks]};
929	(X, Y) -> {X,Y}
930    end, record_info(fields, state), Values).
931
932lock_default(Field) -> proplists:get_value(Field, lock2list(#lock{})).
933
934lock2list(Lock) ->
935    [_|Values] = tuple_to_list(Lock),
936    lists:zip(record_info(fields, lock), Values).
937
938
939list2state(List) ->
940    list_to_tuple([state|list2state(record_info(fields, state), List)]).
941list2state([], _) -> [];
942list2state([locks|Fs], List) ->
943    Locks = [list2lock(Lock) || Lock <- proplists:get_value(locks, List, [])],
944    [Locks|list2state(Fs,List)];
945list2state([F|Fs], List) ->
946    [proplists:get_value(F, List, state_default(F))|list2state(Fs, List)].
947
948list2lock(Ls) ->
949    list_to_tuple([lock|list2lock(record_info(fields, lock), Ls)]).
950
951list2lock([],_) -> [];
952list2lock([stats=F|Fs], Ls) ->
953    Stats = stats2stats(proplists:get_value(F, Ls, lock_default(F))),
954    [Stats|list2lock(Fs, Ls)];
955list2lock([F|Fs], Ls) ->
956    [proplists:get_value(F, Ls, lock_default(F))|list2lock(Fs, Ls)].
957
958%% process old stats (hack)
959%% old stats had no histograms
960%% in future versions stats should be serialized as a list, not a record
961
962stats2stats([]) -> [];
963stats2stats([Stat|Stats]) ->
964    Sz = record_info(size, stats),
965    [stat2stat(Stat,Sz)|stats2stats(Stats)].
966
967stat2stat(Stat,Sz) when tuple_size(Stat) =:= Sz -> Stat;
968stat2stat(Stat,_) ->
969    %% assume no histogram at the end
970    list_to_tuple(tuple_to_list(Stat) ++ [{0}]).
971
972%% printing
973
974%% print_lock_information
975%% In:
976%%	Locks :: [#lock{}]
977%%	Print :: [Type | {Type, non_neg_integer()}]
978%%
979%% Out:
980%%	ok
981
982auto_print_width(Locks, Print) ->
983    % iterate all lock entries to save all max length values
984    % these are records, so we do a little tuple <-> list smashing
985    R = lists:foldl(fun
986	(L, Max) ->
987		list_to_tuple(lists:reverse(lists:foldl(fun
988		    ({print,print}, Out) -> [print|Out];
989		    ({Str, Len}, Out)    -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out]
990		end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max)))))
991	end, #print{ id=4, type=5, entry=5, name=6, tries=8, colls=13, cr=16, time=11, dtr=14, hist=20 },
992	Locks),
993    % Setup the offsets for later pruning
994    Offsets = [
995	{id, R#print.id},
996	{name, R#print.name},
997	{type, R#print.type},
998	{entry, R#print.entry},
999	{tries, R#print.tries},
1000	{colls, R#print.colls},
1001	{ratio, R#print.cr},
1002	{time, R#print.time},
1003	{duration, R#print.dtr},
1004	{histogram, R#print.hist}
1005    ],
1006    % Prune offsets to only allow specified print options
1007    lists:foldr(fun
1008	    ({Type, W}, Out) -> [{Type, W}|Out];
1009	    (Type, Out)      -> [proplists:lookup(Type, Offsets)|Out]
1010	end, [], Print).
1011
1012print_lock_information(Locks, Print) ->
1013    % remake Print to autosize entries
1014    AutoPrint = auto_print_width(Locks, Print),
1015    print_header(AutoPrint),
1016    lists:foreach(fun
1017	(L) ->
1018	    print_lock(L, AutoPrint)
1019    end, Locks),
1020    ok.
1021
1022print_header(Opts) ->
1023    Header = #print{
1024	name  = "lock",
1025	id    = "id",
1026	type  = "type",
1027	entry = "location",
1028	tries = "#tries",
1029	colls = "#collisions",
1030	cr    = "collisions [%]",
1031	time  = "time [us]",
1032	dtr   = "duration [%]",
1033	hist  = "histogram [log2(us)]"
1034    },
1035    Divider = #print{
1036	name  = lists:duplicate(1 + length(Header#print.name),  45),
1037	id    = lists:duplicate(1 + length(Header#print.id),    45),
1038	type  = lists:duplicate(1 + length(Header#print.type),  45),
1039	entry = lists:duplicate(1 + length(Header#print.entry), 45),
1040	tries = lists:duplicate(1 + length(Header#print.tries), 45),
1041	colls = lists:duplicate(1 + length(Header#print.colls), 45),
1042	cr    = lists:duplicate(1 + length(Header#print.cr),    45),
1043	time  = lists:duplicate(1 + length(Header#print.time),  45),
1044	dtr   = lists:duplicate(1 + length(Header#print.dtr),   45),
1045	hist  = lists:duplicate(1 + length(Header#print.hist),  45)
1046    },
1047    print_lock(Header, Opts),
1048    print_lock(Divider, Opts),
1049    ok.
1050
1051
1052print_lock(L, Opts) ->
1053    print(strings(format_lock(L, Opts))).
1054
1055format_lock(_, []) -> [];
1056format_lock(L, [Opt|Opts]) ->
1057    case Opt of
1058	id             -> [{space, 25, s(L#print.id)   } | format_lock(L, Opts)];
1059	{id, W}        -> [{space,  W, s(L#print.id)   } | format_lock(L, Opts)];
1060	type           -> [{space, 18, s(L#print.type) } | format_lock(L, Opts)];
1061	{type, W}      -> [{space,  W, s(L#print.type) } | format_lock(L, Opts)];
1062	entry          -> [{space, 30, s(L#print.entry)} | format_lock(L, Opts)];
1063	{entry, W}     -> [{space,  W, s(L#print.entry)} | format_lock(L, Opts)];
1064	name           -> [{space, 22, s(L#print.name) } | format_lock(L, Opts)];
1065	{name, W}      -> [{space,  W, s(L#print.name) } | format_lock(L, Opts)];
1066	tries          -> [{space, 12, s(L#print.tries)} | format_lock(L, Opts)];
1067	{tries, W}     -> [{space,  W, s(L#print.tries)} | format_lock(L, Opts)];
1068	colls          -> [{space, 14, s(L#print.colls)} | format_lock(L, Opts)];
1069	{colls, W}     -> [{space,  W, s(L#print.colls)} | format_lock(L, Opts)];
1070	ratio          -> [{space, 20, s(L#print.cr)   } | format_lock(L, Opts)];
1071	{ratio, W}     -> [{space,  W, s(L#print.cr)   } | format_lock(L, Opts)];
1072	time           -> [{space, 15, s(L#print.time) } | format_lock(L, Opts)];
1073	{time, W}      -> [{space,  W, s(L#print.time) } | format_lock(L, Opts)];
1074	duration       -> [{space, 20, s(L#print.dtr)  } | format_lock(L, Opts)];
1075	{duration, W}  -> [{space,  W, s(L#print.dtr)  } | format_lock(L, Opts)];
1076	histogram      -> [{space, 20, s(L#print.hist) } | format_lock(L, Opts)];
1077	{histogram, W} -> [{left,  W - length(s(L#print.hist)) - 1, s(L#print.hist)} | format_lock(L, Opts)];
1078	_              -> format_lock(L, Opts)
1079    end.
1080
1081print_state_information(#state{locks = Locks} = State) ->
1082    Stats = summate_locks(Locks),
1083    print("information:"),
1084    print(kv("#locks",          s(length(Locks)))),
1085    print(kv("duration",        s(State#state.duration) ++ " us" ++ " (" ++ s(State#state.duration/1000000) ++ " s)")),
1086    print("\nsummated stats:"),
1087    print(kv("#tries",          s(Stats#stats.tries))),
1088    print(kv("#colls",          s(Stats#stats.colls))),
1089    print(kv("wait time",       s(Stats#stats.time) ++ " us" ++ " ( " ++ s(Stats#stats.time/1000000) ++ " s)")),
1090    print(kv("percent of duration", s(percent(Stats#stats.time, State#state.duration)) ++ " %")),
1091    ok.
1092
1093
1094print_full_histogram(T) when is_tuple(T) ->
1095    Vs = tuple_to_list(T),
1096    Max = lists:max(Vs),
1097    W = 60,
1098    print_full_histogram(0,Vs,Max,W).
1099
1100print_full_histogram(_,[],_,_) -> ok;
1101print_full_histogram(Ix,[V|Vs],0,W) ->
1102    io:format("~2w = log2 : ~8w |~n", [Ix,V]),
1103    print_full_histogram(Ix+1,Vs,0,W);
1104print_full_histogram(Ix,[V|Vs],Max,W) ->
1105    io:format("~2w = log2 : ~8w | ~s~n", [Ix,V,lists:duplicate(trunc(W*(V/Max)), $#)]),
1106    print_full_histogram(Ix+1,Vs,Max,W).
1107
1108
1109%% AUX
1110
1111time2us({S, Ns}) -> S*1000000 + (Ns div 1000).
1112
1113percent(_,0) -> 0.0;
1114percent(T,N) -> T/N*100.
1115
1116options(Opts, Default) when is_list(Default) ->
1117    options1(proplists:unfold(Opts), Default).
1118options1([], Defaults) -> Defaults;
1119options1([{Key, Value}|Opts], Defaults) ->
1120    case proplists:get_value(Key, Defaults) of
1121	undefined -> options1(Opts, [{Key, Value} | Defaults]);
1122	_         -> options1(Opts, [{Key, Value} | proplists:delete(Key, Defaults)])
1123    end.
1124
1125%%% AUX STRING FORMATTING
1126
1127print(String) -> io:format("~ts~n", [String]).
1128
1129kv(Key, Value) -> kv(Key, Value, 20).
1130kv(Key, Value, Offset) -> term2string(term2string("~~~ps : ~~s", [Offset]),[Key, Value]).
1131
1132s(T) when is_float(T) -> term2string("~.4f", [T]);
1133s(T) when is_list(T)  -> term2string("~ts", [T]);
1134s(T)                  -> term2string(T).
1135
1136strings(Strings) -> strings(Strings, []).
1137strings([], Out) -> Out;
1138strings([{space,  N,      S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S]));
1139strings([{left,   N,      S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""]));
1140strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])).
1141
1142
1143term2string({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) -> term2string("~p:~p/~p", [M,F,A]);
1144term2string(Term) when is_port(Term) ->
1145    %  ex #Port<6442.816>
1146    case term_to_binary(Term) of
1147        <<_:2/binary, ?SMALL_ATOM_UTF8_EXT, L:8, Node:L/binary, Ids:32, _/binary>> ->
1148            term2string("#Port<~ts.~w>", [Node, Ids]);
1149        <<_:2/binary, ?ATOM_UTF8_EXT, L:16, Node:L/binary, Ids:32, _/binary>> ->
1150            term2string("#Port<~ts.~w>", [Node, Ids]);
1151        <<_:2/binary, ?ATOM_EXT, L:16, Node:L/binary, Ids:32, _/binary>> ->
1152            term2string("#Port<~s.~w>", [Node, Ids])
1153    end;
1154term2string(Term) when is_pid(Term) ->
1155    %  ex <0.80.0>
1156    case  term_to_binary(Term) of
1157        <<_:2/binary, ?SMALL_ATOM_UTF8_EXT, L:8, Node:L/binary, Ids:32, Serial:32,  _/binary>> ->
1158            term2string("<~ts.~w.~w>", [Node, Ids, Serial]);
1159        <<_:2/binary, ?ATOM_UTF8_EXT, L:16, Node:L/binary, Ids:32, Serial:32,  _/binary>> ->
1160            term2string("<~ts.~w.~w>", [Node, Ids, Serial]);
1161        <<_:2/binary, ?ATOM_EXT, L:16, Node:L/binary, Ids:32, Serial:32,  _/binary>> ->
1162            term2string("<~s.~w.~w>", [Node, Ids, Serial])
1163    end;
1164term2string(Term) -> term2string("~w", [Term]).
1165term2string(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)).
1166
1167%%% AUX id binary
1168
1169bytes16(Value) ->
1170    B0 =  Value band 255,
1171    B1 = (Value bsr 8) band 255,
1172    <<B1, B0>>.
1173
1174bytes32(Value) ->
1175    B0 =  Value band 255,
1176    B1 = (Value bsr  8) band 255,
1177    B2 = (Value bsr 16) band 255,
1178    B3 = (Value bsr 24) band 255,
1179    <<B3, B2, B1, B0>>.
1180