1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2001-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%%%---------------------------------------------------------------------- 22%%% File : fprof.erl 23%%% Author : Raimo Niskanen <raimo@erix.ericsson.se> 24%%% Purpose : File tracing profiling tool wich accumulated times. 25%%% Created : 18 Jun 2001 by Raimo Niskanen <raimo@erix.ericsson.se> 26%%%---------------------------------------------------------------------- 27 28-module(fprof). 29-author('raimo@erix.ericsson.se'). 30 31%% External exports 32-export([ 33 apply/2, apply/3, apply/4, 34 start/0, stop/0, stop/1, 35 trace/1, trace/2, 36 profile/0, profile/1, profile/2, 37 analyse/0, analyse/1, analyse/2]). 38%% Debug functions 39-export([get_state/0, 40 save_profile/0, save_profile/1, save_profile/2, 41 load_profile/0, load_profile/1, load_profile/2, 42 code_change/0]). 43 44%% Debug exports 45-export([call/1, just_call/1, reply/2]). 46-export([trace_off/0, trace_on/3]). 47-export([getopts/2, setopts/1]). 48-export([println/5, print_callers/2, print_func/2, print_called/2]). 49-export([trace_call_collapse/1]). 50-export([parsify/1]). 51 52%% Internal exports 53-export(['$code_change'/1]). 54 55 56 57-define(FNAME_WIDTH, 72). 58-define(NR_WIDTH, 15). 59 60-define(TRACE_FILE, "fprof.trace"). 61-define(DUMP_FILE, "fprof.dump"). 62-define(PROFILE_FILE, "fprof.profile"). 63-define(ANALYSIS_FILE, "fprof.analysis"). 64 65-define(FPROF_SERVER, fprof_server). 66-define(FPROF_SERVER_TIMEOUT, infinity). 67 68 69 70-define(debug, 9). 71%-define(debug, 0). 72-ifdef(debug). 73dbg(Level, F, A) when Level >= ?debug -> 74 io:format(F, A), 75 ok; 76dbg(_, _, _) -> 77 ok. 78-define(dbg(Level, F, A), dbg((Level), (F), (A))). 79-else. 80-define(dbg(Level, F, A), ok). 81-endif. 82 83 84 85%%%---------------------------------------------------------------------- 86%%% Higher order API functions 87%%%---------------------------------------------------------------------- 88 89 90-spec apply(Func, Args) -> term() when 91 Func :: fun() | {Module :: module(), Function :: atom()}, 92 Args :: [term()]. 93 94apply({M, F}, Args) 95 when is_atom(M), is_atom(F), is_list(Args) -> 96 apply_1(M, F, Args, []); 97apply(Fun, Args) 98 when is_function(Fun), is_list(Args) -> 99 apply_1(Fun, Args, []); 100apply(A, B) -> 101 erlang:error(badarg, [A, B]). 102 103-type pid_spec() :: pid() | atom(). 104-type trace_option() :: 'cpu_time' 105 | {'cpu_time', boolean()} 106 | 'file' 107 | {'file', Filename :: file:filename()} 108 | {'procs', PidSpec :: pid_spec()} 109 | {'procs', [PidSpec :: pid_spec()]} 110 | 'start' 111 | 'stop' 112 | {'tracer', Tracer :: pid() | port()} 113 | 'verbose' 114 | {'verbose', boolean()}. 115 116-type apply_option() :: 'continue' 117 | {'procs', PidList :: [pid()]} 118 | 'start' 119 | TraceStartOption :: trace_option(). 120 121-spec apply(Module, Function, Args) -> term() when 122 Module :: module(), 123 Function :: atom(), 124 Args :: [term()]; 125 (Func, Args, OptionList) -> term() when 126 Func :: fun() | {Module :: module(), Function :: atom()}, 127 Args :: [term()], 128 OptionList :: [Option], 129 Option :: apply_option(). 130 131apply(M, F, Args) when is_atom(M), is_atom(F), is_list(Args) -> 132 apply_1(M, F, Args, []); 133apply({M, F}, Args, Options) 134 when is_atom(M), is_atom(F), is_list(Args), is_list(Options) -> 135 apply_1(M, F, Args, Options); 136apply(Fun, Args, Options) 137 when is_function(Fun), is_list(Args), is_list(Options) -> 138 apply_1(Fun, Args, Options); 139apply(A, B, C) -> 140 erlang:error(badarg, [A, B, C]). 141 142-spec apply(Module, Function, Args, OptionList) -> term() when 143 Module :: module(), 144 Function :: atom(), 145 Args :: [term()], 146 OptionList :: [Option], 147 Option :: apply_option(). 148 149apply(M, F, Args, Options) 150 when is_atom(M), is_atom(F), is_list(Args), is_list(Options) -> 151 apply_1(M, F, Args, Options); 152apply(A, B, C, D) -> 153 erlang:error(badarg, [A, B, C, D]). 154 155apply_1(M, F, Args, Options) -> 156 Arity = length(Args), 157 apply_1(fun M:F/Arity, Args, Options). 158 159apply_1(Function, Args, Options) -> 160 {[_, Procs, Continue], Options_1} = 161 getopts(Options, [start, procs, continue]), 162 Procs_1 = case Procs of 163 [{procs, P}] when is_list(P) -> 164 P; 165 _ -> 166 [] 167 end, 168 case Continue of 169 [] -> 170 apply_start_stop(Function, Args, Procs_1, Options_1); 171 [continue] -> 172 apply_continue(Function, Args, Procs_1, Options_1); 173 _ -> 174 erlang:error(badarg, [Function, Args, Options]) 175 end. 176 177 178 179apply_start_stop(Function, Args, Procs, Options) -> 180 Ref = make_ref(), 181 Parent = self(), 182 Child = 183 spawn( 184 fun() -> 185 MRef = erlang:monitor(process, Parent), 186 receive 187 {Parent, Ref, start_trace} -> 188 case trace([start, 189 {procs, [Parent | Procs]} 190 | Options]) of 191 ok -> 192 catch Parent ! {self(), Ref, trace_started}, 193 receive 194 {Parent, Ref, stop_trace} -> 195 trace([stop]), 196 catch Parent 197 ! {self(), Ref, trace_stopped}, 198 done; 199 {'DOWN', MRef, _, _, _} -> 200 trace([stop]) 201 end; 202 {error, Reason} -> 203 exit(Reason) 204 end; 205 {'DOWN', MRef, _, _, _} -> 206 done 207 end 208 end), 209 MRef = erlang:monitor(process, Child), 210 catch Child ! {self(), Ref, start_trace}, 211 receive 212 {Child, Ref, trace_started} -> 213 try erlang:apply(Function, Args) 214 after 215 catch Child ! {self(), Ref, stop_trace}, 216 receive 217 {Child, Ref, trace_stopped} -> 218 receive 219 {'DOWN', MRef, _, _, _} -> 220 ok 221 end; 222 {'DOWN', MRef, _, _, _} -> 223 trace([stop]) 224 end 225 end; 226 {'DOWN', MRef, _, _, Reason} -> 227 exit(Reason) 228 end. 229 230apply_continue(Function, Args, Procs, Options) -> 231 Ref = make_ref(), 232 Parent = self(), 233 Child = 234 spawn( 235 fun() -> 236 MRef = erlang:monitor(process, Parent), 237 receive 238 {Parent, Ref, start_trace} -> 239 case trace([start, 240 {procs, [Parent | Procs]} 241 | Options]) of 242 ok -> 243 exit({Ref, trace_started}); 244 {error, Reason} -> 245 exit(Reason) 246 end; 247 {'DOWN', MRef, _, _, _} -> 248 done 249 end 250 end), 251 MRef = erlang:monitor(process, Child), 252 catch Child ! {self(), Ref, start_trace}, 253 receive 254 {'DOWN', MRef, _, _, {Ref, trace_started}} -> 255 erlang:apply(Function, Args); 256 {'DOWN', MRef, _, _, Reason} -> 257 exit(Reason) 258 end. 259 260 261 262%%%---------------------------------------------------------------------- 263%%% Requests to ?FPROF_SERVER 264%%%---------------------------------------------------------------------- 265 266-record(trace_start, {procs, % List of processes 267 mode, % normal | verbose 268 type, % file | tracer 269 dest}). % Filename | Pid/Port 270 271-record(trace_stop, {}). 272 273% -record(open_out, {file}). 274 275% -record(close_out, {}). 276 277-record(profile, {src, % Filename 278 group_leader, % IoPid 279 dump, % Filename | IoPid 280 flags}). % List 281 282-record(profile_start, {group_leader, % IoPid 283 dump, % Filename | IoPid 284 flags}). % List 285 286-record(profile_stop, {}). 287 288-record(analyse, {group_leader, % IoPid 289 dest, % Filename | IoPid 290 flags, % List 291 cols, % Integer 292 callers, % Boolean 293 sort, % acc_r | own_r 294 totals, % Boolean 295 details}). % Boolean 296 297-record(stop, { 298 reason}). 299 300 301 302%%--------------- 303%% Debug requests 304%%--------------- 305 306-record(get_state, {}). 307 308-record(save_profile, {file}). 309 310-record(load_profile, {file}). 311 312 313 314%%%---------------------------------------------------------------------- 315%%% Basic API functions 316%%%---------------------------------------------------------------------- 317 318 319-dialyzer({no_contracts, trace/2}). 320-spec trace('start', Filename) -> 'ok' | 321 {'error', Reason} | 322 {'EXIT', ServerPid, Reason} when 323 Filename :: file:filename(), 324 ServerPid :: pid(), 325 Reason :: term(); 326 ('verbose', Filename) -> 'ok' | 327 {'error', Reason} | 328 {'EXIT', ServerPid, Reason} when 329 Filename :: file:filename(), 330 ServerPid :: pid(), 331 Reason :: term(); 332 (OptionName, OptionValue) -> 'ok' | 333 {'error', Reason} | 334 {'EXIT', ServerPid, Reason} when 335 OptionName :: atom(), 336 OptionValue :: term(), 337 ServerPid :: pid(), 338 Reason :: term(). 339 340trace(start, Filename) -> 341 trace([start, {file, Filename}]); 342trace(verbose, Filename) -> 343 trace([start, verbose, {file, Filename}]); 344trace(OptionName, Value) when is_atom(OptionName) -> 345 trace([{OptionName, Value}]); 346trace(OptionName, Value) -> 347 erlang:error(badarg, [OptionName, Value]). 348 349-dialyzer({no_contracts, trace/1}). 350-spec trace('verbose') -> 'ok' | 351 {'error', Reason} | 352 {'EXIT', ServerPid, Reason} when 353 ServerPid :: pid(), 354 Reason :: term(); 355 (OptionName) -> 'ok' | 356 {'error', Reason} | 357 {'EXIT', ServerPid, Reason} when 358 OptionName :: atom(), 359 ServerPid :: pid(), 360 Reason :: term(); 361 ({OptionName, OptionValue}) -> 'ok' | 362 {'error', Reason} | 363 {'EXIT', ServerPid, Reason} when 364 OptionName :: atom(), 365 OptionValue :: term(), 366 ServerPid :: pid(), 367 Reason :: term(); 368 (OptionList) -> 'ok' | 369 {'error', Reason} | 370 {'EXIT', ServerPid, Reason} when 371 OptionList :: [Option], 372 Option :: trace_option(), 373 ServerPid :: pid(), 374 Reason :: term(). 375 376trace(stop) -> 377 %% This shortcut is present to minimize the number of undesired 378 %% function calls at the end of the trace. 379 call(#trace_stop{}); 380trace(verbose) -> 381 trace([start, verbose]); 382trace([stop]) -> 383 %% This shortcut is present to minimize the number of undesired 384 %% function calls at the end of the trace. 385 call(#trace_stop{}); 386trace({Opt, _Val} = Option) when is_atom(Opt) -> 387 trace([Option]); 388trace(Option) when is_atom(Option) -> 389 trace([Option]); 390trace(Options) when is_list(Options) -> 391 case getopts(Options, 392 [start, stop, procs, verbose, file, tracer, cpu_time]) of 393 {[[], [stop], [], [], [], [], []], []} -> 394 call(#trace_stop{}); 395 {[[start], [], Procs, Verbose, File, Tracer, CpuTime], []} -> 396 {Type, Dest} = case {File, Tracer} of 397 {[], [{tracer, Pid} = T]} 398 when is_pid(Pid); is_port(Pid) -> 399 T; 400 {[file], []} -> 401 {file, ?TRACE_FILE}; 402 {[{file, []}], []} -> 403 {file, ?TRACE_FILE}; 404 {[{file, _} = F], []} -> 405 F; 406 {[], []} -> 407 {file, ?TRACE_FILE}; 408 _ -> 409 erlang:error(badarg, [Options]) 410 end, 411 V = case Verbose of 412 [] -> normal; 413 [verbose] -> verbose; 414 [{verbose, true}] -> verbose; 415 [{verbose, false}] -> normal; 416 _ -> erlang:error(badarg, [Options]) 417 end, 418 CT = case CpuTime of 419 [] -> wallclock; 420 [cpu_time] -> cpu_time; 421 [{cpu_time, true}] -> cpu_time; 422 [{cpu_time, false}] -> wallclock; 423 _ -> erlang:error(badarg, [Options]) 424 end, 425 call(#trace_start{procs = case Procs of 426 [] -> 427 [self()]; 428 [{procs, P}] when is_list(P) -> 429 P; 430 [{procs, P}] -> 431 [P]; 432 _ -> 433 erlang:error(badarg, [Options]) 434 end, 435 mode = {V, CT}, 436 type = Type, 437 dest = Dest}); 438 _ -> 439 erlang:error(badarg, [Options]) 440 end; 441trace(Options) -> 442 erlang:error(badarg, [Options]). 443 444 445-spec profile() -> 'ok' | 446 {'error', Reason} | 447 {'EXIT', ServerPid, Reason} when 448 ServerPid :: pid(), 449 Reason :: term(). 450 451profile() -> 452 profile([]). 453 454-type profile_option() :: 'append' 455 | 'dump' 456 | {'dump', 457 pid() | Dump :: (Dumpfile :: file:filename() | [])} 458 | 'file' 459 | {'file', Filename :: file:filename()} 460 | 'start' 461 | 'stop'. 462 463-spec profile(OptionName, OptionValue) ->'ok' | 464 {'ok', Tracer} | 465 {'error', Reason} | 466 {'EXIT', ServerPid, Reason} when 467 OptionName :: atom(), 468 OptionValue :: term(), 469 Tracer :: pid(), 470 ServerPid :: pid(), 471 Reason :: term(). 472 473profile(Option, Value) when is_atom(Option) -> 474 profile([{Option, Value}]); 475profile(Option, Value) -> 476 erlang:error(badarg, [Option, Value]). 477 478-spec profile(OptionName) -> 'ok' | 479 {'ok', Tracer} | 480 {'error', Reason} | 481 {'EXIT', ServerPid, Reason} when 482 OptionName :: atom(), 483 Tracer :: pid(), 484 ServerPid :: pid(), 485 Reason :: term(); 486 ({OptionName, OptionValue}) -> 'ok' | 487 {'ok', Tracer} | 488 {'error', Reason} | 489 {'EXIT', ServerPid, Reason} when 490 OptionName :: atom(), 491 OptionValue :: term(), 492 Tracer :: pid(), 493 ServerPid :: pid(), 494 Reason :: term(); 495 (OptionList) -> 'ok' | 496 {'ok', Tracer} | 497 {'error', Reason} | 498 {'EXIT', ServerPid, Reason} when 499 OptionList :: [Option], 500 Option :: profile_option(), 501 Tracer :: pid(), 502 ServerPid :: pid(), 503 Reason :: term(). 504 505profile(Option) when is_atom(Option) -> 506 profile([Option]); 507profile({Opt, _Val} = Option) when is_atom(Opt) -> 508 profile([Option]); 509profile(Options) when is_list(Options) -> 510 case getopts(Options, [start, stop, file, dump, append]) of 511 {[Start, [], File, Dump, Append], []} -> 512 {Target, Flags} = 513 case {Dump, Append} of 514 {[], []} -> 515 {[], []}; 516 {[dump], []} -> 517 {group_leader(), []}; 518 {[{dump, []}], []} -> 519 {?DUMP_FILE, []}; 520 {[{dump, []}], [append]} -> 521 {?DUMP_FILE, [append]}; 522 {[{dump, D}], [append]} when is_pid(D) -> 523 erlang:error(badarg, [Options]); 524 {[{dump, D}], [append]} -> 525 {D, [append]}; 526 {[{dump, D}], []} -> 527 {D, []}; 528 _ -> 529 erlang:error(badarg, [Options]) 530 end, 531 case {Start, File} of 532 {[start], []} -> 533 call(#profile_start{group_leader = group_leader(), 534 dump = Target, 535 flags = Flags}); 536 {[], _} -> 537 Src = 538 case File of 539 [] -> 540 ?TRACE_FILE; 541 [file] -> 542 ?TRACE_FILE; 543 [{file, []}] -> 544 ?TRACE_FILE; 545 [{file, F}] -> 546 F; 547 _ -> 548 erlang:error(badarg, [Options]) 549 end, 550 call(#profile{src = Src, 551 group_leader = group_leader(), 552 dump = Target, 553 flags = Flags}); 554 _ -> 555 erlang:error(badarg, [Options]) 556 end; 557 {[[], [stop], [], [], []], []} -> 558 call(#profile_stop{}); 559 _ -> 560 erlang:error(badarg, [Options]) 561 end; 562profile(Options) -> 563 erlang:error(badarg, [Options]). 564 565 566-spec analyse() -> 'ok' | 567 {'error', Reason} | 568 {'EXIT', ServerPid, Reason} when 569 ServerPid :: pid(), 570 Reason :: term(). 571 572analyse() -> 573 analyse([]). 574 575-spec analyse(OptionName, OptionValue) ->'ok' | 576 {'error', Reason} | 577 {'EXIT', ServerPid, Reason} when 578 OptionName :: atom(), 579 OptionValue :: term(), 580 ServerPid :: pid(), 581 Reason :: term(). 582 583analyse(Option, Value) when is_atom(Option) -> 584 analyse([{Option, Value}]); 585analyse(Option, Value) -> 586 erlang:error(badarg, [Option, Value]). 587 588-type analyse_option() :: 'append' 589 | 'callers' 590 | {'callers', boolean()} 591 | {'cols', Cols :: non_neg_integer()} 592 | 'dest' 593 | {'dest', 594 Dest :: (pid() | (Destfile :: file:filename()))} 595 | 'details' 596 | {'details', boolean()} 597 | 'no_callers' 598 | 'no_details' 599 | {'sort', SortSpec :: 'acc' | 'own'} 600 | 'totals' 601 | {'totals', boolean()}. 602 603-spec analyse(OptionName) -> 'ok' | 604 {'error', Reason} | 605 {'EXIT', ServerPid, Reason} when 606 OptionName :: atom(), 607 ServerPid :: pid(), 608 Reason :: term(); 609 ({OptionName, OptionValue}) -> 'ok' | 610 {'error', Reason} | 611 {'EXIT', ServerPid, Reason} when 612 OptionName :: atom(), 613 OptionValue :: term(), 614 ServerPid :: pid(), 615 Reason :: term(); 616 (OptionList) -> 'ok' | 617 {'error', Reason} | 618 {'EXIT', ServerPid, Reason} when 619 OptionList :: [Option], 620 Option :: analyse_option(), 621 ServerPid :: pid(), 622 Reason :: term(). 623 624analyse(Option) when is_atom(Option) -> 625 analyse([Option]); 626analyse({Opt, _Val} = Option) when is_atom(Opt) -> 627 analyse([Option]); 628analyse(Options) when is_list(Options) -> 629 case getopts(Options, 630 [dest, append, cols, callers, no_callers, 631 sort, totals, details, no_details]) of 632 {[Dest, Append, Cols, Callers, NoCallers, 633 Sort, Totals, Details, NoDetails], []} -> 634 {Target, Flags} = 635 case {Dest, Append} of 636 {[], []} -> 637 {group_leader(), []}; 638 {[dest], []} -> 639 {group_leader(), []}; 640 {[{dest, []}], []} -> 641 {?ANALYSIS_FILE, []}; 642 {[{dest, []}], [append]} -> 643 {?ANALYSIS_FILE, [append]}; 644 {[{dest, F}], [append]} when is_pid(F) -> 645 erlang:error(badarg, [Options]); 646 {[{dest, F}], [append]} -> 647 {F, [append]}; 648 {[{dest, F}], []} -> 649 {F, []}; 650 _ -> 651 erlang:error(badarg, [Options]) 652 end, 653 call(#analyse{group_leader = group_leader(), 654 dest = Target, 655 flags = Flags, 656 cols = case Cols of 657 [] -> 658 80; 659 [{cols, C}] when is_integer(C), C > 0 -> 660 C; 661 _ -> 662 erlang:error(badarg, [Options]) 663 end, 664 callers = case {Callers, NoCallers} of 665 {[], []} -> 666 true; 667 {[callers], []} -> 668 true; 669 {[{callers, true}], []} -> 670 true; 671 {[{callers, false}], []} -> 672 false; 673 {[], [no_callers]} -> 674 false; 675 _ -> 676 erlang:error(badarg, [Options]) 677 end, 678 sort = case Sort of 679 [] -> 680 acc; 681 [{sort, acc}] -> 682 acc; 683 [{sort, own}] -> 684 own; 685 _ -> 686 erlang:error(badarg, [Options]) 687 end, 688 totals = case Totals of 689 [] -> 690 false; 691 [totals] -> 692 true; 693 [{totals, true}] -> 694 true; 695 [{totals, false}] -> 696 false; 697 _ -> 698 erlang:error(badarg, [Options]) 699 end, 700 details = case {Details, NoDetails} of 701 {[], []} -> 702 true; 703 {[details], []} -> 704 true; 705 {[{details, true}], []} -> 706 true; 707 {[{details, false}], []} -> 708 false; 709 {[], [no_details]} -> 710 false; 711 _ -> 712 erlang:error(badarg, [Options]) 713 end}); 714 _ -> 715 erlang:error(badarg, [Options]) 716 end; 717analyse(Options) -> 718 erlang:error(badarg, [Options]). 719 720 721 722%%---------------- 723%% Debug functions 724%%---------------- 725 726 727 728get_state() -> 729 just_call(#get_state{}). 730 731 732 733save_profile() -> 734 save_profile([]). 735 736save_profile(Option, Value) when is_atom(Option) -> 737 save_profile([{Option, Value}]); 738save_profile(Option, Value) -> 739 erlang:error(badarg, [Option, Value]). 740 741save_profile(Option) when is_atom(Option) -> 742 save_profile([Option]); 743save_profile(Options) when is_list(Options) -> 744 case getopts(Options, [file]) of 745 {[File], []} -> 746 call(#save_profile{file = case File of 747 [] -> 748 ?PROFILE_FILE; 749 [{file, F}] -> 750 F; 751 _ -> 752 erlang:error(badarg, [Options]) 753 end}); 754 _ -> 755 erlang:error(badarg, [Options]) 756 end; 757save_profile(Options) -> 758 erlang:error(badarg, [Options]). 759 760 761 762load_profile() -> 763 load_profile([]). 764 765load_profile(Option, Value) when is_atom(Option) -> 766 load_profile([{Option, Value}]); 767load_profile(Option, Value) -> 768 erlang:error(badarg, [Option, Value]). 769 770load_profile(Option) when is_atom(Option) -> 771 load_profile([Option]); 772load_profile(Options) when is_list(Options) -> 773 case getopts(Options, [file]) of 774 {[File], []} -> 775 call(#load_profile{file = case File of 776 [] -> 777 ?PROFILE_FILE; 778 [{file, F}] -> 779 F; 780 _ -> 781 erlang:error(badarg, [Options]) 782 end}); 783 _ -> 784 erlang:error(badarg, [Options]) 785 end; 786load_profile(Options) -> 787 erlang:error(badarg, [Options]). 788 789 790 791code_change() -> 792 just_call('$code_change'). 793 794 795 796%%%---------------------------------------------------------------------- 797%%% ETS table record definitions 798%%% The field 'id' must be first in these records; 799%%% it is the common ets table index field. 800%%%---------------------------------------------------------------------- 801 802-record(clocks, { 803 id, 804 cnt = 0, % Number of calls 805 own = 0, % Own time (wall clock) 806 acc = 0}). % Accumulated time : own + subfunctions (wall clock) 807 808-record(proc, { 809 id, 810 parent, 811 spawned_as, % Spawned MFArgs 812 init_log = [], % List of first calls, head is newest 813 init_cnt = 2}). % First calls counter, counts down to 0 814 815-record(misc, {id, 816 data}). 817 818 819 820%% Analysis summary record 821-record(funcstat, { 822 callers_sum, % #clocks{id = {Pid, Caller, Func}} 823 called_sum, % #clocks{id = {Pid, Caller, Func}} 824 callers = [], % [#clocks{}, ...] 825 called = []}). % [#clocks{}, ...] 826 827 828 829%%%---------------------------------------------------------------------- 830%%% ?FPROF_SERVER 831%%%---------------------------------------------------------------------- 832 833%%%------------------- 834%%% Exported functions 835%%%------------------- 836 837-spec start() -> {'ok', Pid} | {'error', {'already_started', Pid}} when 838 Pid :: pid(). 839 840%% Start server process 841start() -> 842 spawn_3step( 843 fun () -> 844 try register(?FPROF_SERVER, self()) of 845 true -> 846 process_flag(trap_exit, true), 847 {{ok, self()}, loop} 848 catch 849 error:badarg -> 850 {{error, {already_started, whereis(?FPROF_SERVER)}}, 851 already_started} 852 end 853 end, 854 fun (X) -> 855 X 856 end, 857 fun (loop) -> 858 put(trace_state, idle), 859 put(profile_state, {idle, undefined}), 860 put(pending_stop, []), 861 server_loop([]); 862 (already_started) -> 863 ok 864 end). 865 866 867-spec stop() -> 'ok'. 868 869%% Stop server process 870stop() -> 871 stop(normal). 872 873-spec stop(Reason) -> 'ok' when 874 Reason :: term(). 875 876stop(kill) -> 877 case whereis(?FPROF_SERVER) of 878 undefined -> 879 ok; 880 Pid -> 881 exit(Pid, kill), 882 ok 883 end; 884stop(Reason) -> 885 just_call(#stop{reason = Reason}), 886 ok. 887 888 889 890%%%------------------------ 891%%% Client helper functions 892%%%------------------------ 893 894%% Send request to server process and return the server's reply. 895%% First start server if it ain't started. 896call(Request) -> 897 case whereis(?FPROF_SERVER) of 898 undefined -> 899 _ = start(), 900 just_call(Request); 901 Server -> 902 just_call(Server, Request) 903 end. 904 905%% Send request to server process, and return the server's reply. 906%% Returns {'EXIT', Pid, Reason} if the server dies during the 907%% call, or if it wasn't started. 908just_call(Request) -> 909 just_call(whereis(?FPROF_SERVER), Request). 910 911just_call(undefined, _) -> 912 {'EXIT', ?FPROF_SERVER, noproc}; 913just_call(Pid, Request) -> 914 Mref = erlang:monitor(process, Pid), 915 receive 916 {'DOWN', Mref, _, _, Reason} -> 917 {'EXIT', Pid, Reason} 918 after 0 -> 919 Tag = {Mref, self()}, 920 {T, Demonitor} = case Request of 921 #stop{} -> 922 {?FPROF_SERVER_TIMEOUT, false}; 923 _ -> 924 {0, true} 925 end, 926 %% io:format("~p request: ~p~n", [?MODULE, Request]), 927 catch Pid ! {?FPROF_SERVER, Tag, Request}, 928 receive 929 {?FPROF_SERVER, Mref, Reply} -> 930 case Demonitor of 931 true -> erlang:demonitor(Mref); 932 false -> ok 933 end, 934 receive {'DOWN', Mref, _, _, _} -> ok after T -> ok end, 935 Reply; 936 {'DOWN', Mref, _, _, Reason} -> 937 receive {?FPROF_SERVER, Mref, _} -> ok after T -> ok end, 938 {'EXIT', Pid, Reason} 939 after ?FPROF_SERVER_TIMEOUT -> 940 timeout 941 end 942 end. 943 944 945 946%%%------------------------ 947%%% Server helper functions 948%%%------------------------ 949 950%% Return the reply to the client's request. 951reply({Mref, Pid}, Reply) when is_reference(Mref), is_pid(Pid) -> 952 catch Pid ! {?FPROF_SERVER, Mref, Reply}, 953 ok. 954 955 956 957server_loop(State) -> 958 receive 959 {?FPROF_SERVER, {Mref, Pid} = Tag, '$code_change'} 960 when is_reference(Mref), is_pid(Pid) -> 961 reply(Tag, ok), 962 ?MODULE:'$code_change'(State); 963 {?FPROF_SERVER, {Mref, Pid} = Tag, Request} 964 when is_reference(Mref), is_pid(Pid) -> 965 server_loop(handle_req(Request, Tag, State)); 966 Other -> 967 server_loop(handle_other(Other, State)) 968 end. 969 970%-export. 971'$code_change'(State) -> 972 case lists:keysearch(time, 1, module_info(compile)) of 973 {value, {time, {Y, M, D, HH, MM, SS}}} -> 974 io:format("~n~w: code change to compile time " 975 ++"~4..0w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w~n", 976 [?MODULE, Y, M, D, HH, MM, SS]); 977 false -> 978 ok 979 end, 980 server_loop(State). 981 982 983 984%% Server help function that stops the server iff the 985%% sub state machines are in proper states. Sends the reply 986%% to all waiting clients. 987try_pending_stop(State) -> 988 case {get(trace_state), get(profile_state), get(pending_stop)} of 989 {idle, {idle, _}, [_|_] = PendingStop} -> 990 Reason = get(stop_reason), 991 Reply = result(Reason), 992 lists:foreach( 993 fun (Tag) -> 994 reply(Tag, Reply) 995 end, 996 PendingStop), 997 exit(Reason); 998 _ -> 999 State 1000 end. 1001 1002%%------------------ 1003%% Server handle_req 1004%%------------------ 1005 1006handle_req(#trace_start{procs = Procs, 1007 mode = Mode, 1008 type = file, 1009 dest = Filename}, Tag, State) -> 1010 case {get(trace_state), get(pending_stop)} of 1011 {idle, []} -> 1012 trace_off(), 1013 Port = open_dbg_trace_port(file, Filename), 1014 case trace_on(Procs, Port, Mode) of 1015 ok -> 1016 put(trace_state, running), 1017 put(trace_type, file), 1018 put(trace_pid, Port), 1019 reply(Tag, ok), 1020 State; 1021 Error -> 1022 reply(Tag, Error), 1023 State 1024 end; 1025 _ -> 1026 reply(Tag, {error, already_tracing}), 1027 State 1028 end; 1029handle_req(#trace_start{procs = Procs, 1030 mode = Mode, 1031 type = tracer, 1032 dest = Tracer}, Tag, State) -> 1033 case {get(trace_state), get(pending_stop)} of 1034 {idle, []} -> 1035 trace_off(), 1036 case trace_on(Procs, Tracer, Mode) of 1037 ok -> 1038 put(trace_state, running), 1039 put(trace_type, tracer), 1040 put(trace_pid, Tracer), 1041 reply(Tag, ok), 1042 State; 1043 Error -> 1044 reply(Tag, Error), 1045 State 1046 end; 1047 _ -> 1048 reply(Tag, {error, already_tracing}), 1049 State 1050 end; 1051 1052handle_req(#trace_stop{}, Tag, State) -> 1053 case get(trace_state) of 1054 running -> 1055 TracePid = get(trace_pid), 1056 trace_off(), 1057 case erase(trace_type) of 1058 file -> 1059 catch erlang:port_close(TracePid), 1060 put(trace_state, stopping), 1061 put(trace_tag, Tag), 1062 State; 1063 tracer -> 1064 erase(trace_pid), 1065 put(trace_state, idle), 1066 case {get(profile_state), get(profile_type), 1067 get(profile_pid)} of 1068 {running, tracer, TracePid} -> 1069 exit(TracePid, normal), 1070 put(profile_tag, Tag), 1071 State; 1072 _ -> 1073 reply(Tag, ok), 1074 try_pending_stop(State) 1075 end 1076 end; 1077 _ -> 1078 reply(Tag, {error, not_tracing}), 1079 State 1080 end; 1081 1082handle_req(#profile{src = Filename, 1083 group_leader = GroupLeader, 1084 dump = Dump, 1085 flags = Flags}, Tag, State) -> 1086 case {get(profile_state), get(pending_stop)} of 1087 {{idle, _}, []} -> 1088 case ensure_open(Dump, [write | Flags]) of 1089 {already_open, DumpPid} -> 1090 put(profile_dump, DumpPid), 1091 put(profile_close_dump, false); 1092 {ok, DumpPid} -> 1093 put(profile_dump, DumpPid), 1094 put(profile_close_dump, true); 1095 {error, _} = Error -> 1096 reply(Tag, Error), 1097 State 1098 end, 1099 Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]), 1100 Pid = spawn_link_dbg_trace_client(Filename, Table, 1101 GroupLeader, 1102 get(profile_dump)), 1103 put(profile_state, running), 1104 put(profile_type, file), 1105 put(profile_pid, Pid), 1106 put(profile_tag, Tag), 1107 put(profile_table, Table), 1108 State; 1109 _ -> 1110 reply(Tag, {error, already_profiling}), 1111 State 1112 end; 1113 1114handle_req(#profile_start{group_leader = GroupLeader, 1115 dump = Dump, 1116 flags = Flags}, Tag, State) -> 1117 case {get(profile_state), get(pending_stop)} of 1118 {{idle, _}, []} -> 1119 case ensure_open(Dump, [write | Flags]) of 1120 {already_open, DumpPid} -> 1121 put(profile_dump, DumpPid), 1122 put(profile_close_dump, false); 1123 {ok, DumpPid} -> 1124 put(profile_dump, DumpPid), 1125 put(profile_close_dump, true); 1126 {error, _} = Error -> 1127 reply(Tag, Error), 1128 State 1129 end, 1130 Table = ets:new(?MODULE, [set, public, {keypos, #clocks.id}]), 1131 Pid = spawn_link_trace_client(Table, GroupLeader, 1132 get(profile_dump)), 1133 put(profile_state, running), 1134 put(profile_type, tracer), 1135 put(profile_pid, Pid), 1136 put(profile_table, Table), 1137 reply(Tag, {ok, Pid}), 1138 State; 1139 _ -> 1140 reply(Tag, {error, already_profiling}), 1141 State 1142 end; 1143 1144handle_req(#profile_stop{}, Tag, State) -> 1145 case {get(profile_state), get(profile_type)} of 1146 {running, tracer} -> 1147 ProfilePid = get(profile_pid), 1148 case {get(trace_state), get(trace_type), get(trace_pid)} of 1149 {running, tracer, ProfilePid} -> 1150 trace_off(), 1151 erase(trace_type), 1152 erase(trace_pid), 1153 put(trace_state, idle); 1154 _ -> 1155 ok 1156 end, 1157 exit(ProfilePid, normal), 1158 put(profile_tag, Tag), 1159 State; 1160 {running, file} -> 1161 reply(Tag, {error, profiling_file}), 1162 State; 1163 {_, _} -> 1164 reply(Tag, {error, not_profiling}), 1165 State 1166 end; 1167 1168handle_req(#analyse{dest = Dest, 1169 flags = Flags} = Request, Tag, State) -> 1170 case get(profile_state) of 1171 {idle, undefined} -> 1172 reply(Tag, {error, no_profile}), 1173 State; 1174 {idle, _} -> 1175 case ensure_open(Dest, [write | Flags]) of 1176 {error, _} = Error -> 1177 reply(Tag, Error), 1178 State; 1179 {DestState, DestPid} -> 1180 ProfileTable = get(profile_table), 1181 reply(Tag, 1182 spawn_3step( 1183 fun() -> 1184 do_analyse(ProfileTable, 1185 Request#analyse{dest = DestPid}) 1186 end, 1187 fun(Result) -> 1188 {Result,finish} 1189 end, 1190 fun(finish) -> 1191 ok 1192 end)), 1193 case DestState of 1194 already_open -> 1195 ok; 1196 ok -> 1197 ok = file:close(DestPid) 1198 end, 1199 State 1200 end; 1201 _ -> 1202 reply(Tag, {error, profiling}), 1203 State 1204 end; 1205 1206handle_req(#stop{reason = Reason}, Tag, State) -> 1207 PendingStop = get(pending_stop), 1208 case PendingStop of 1209 [] -> 1210 put(stop_reason, Reason); 1211 _ -> 1212 ok 1213 end, 1214 put(pending_stop, [Tag | PendingStop]), 1215 try_pending_stop(State); 1216 1217%%---------------------- 1218%% Server debug requests 1219%%---------------------- 1220 1221handle_req(#get_state{}, Tag, State) -> 1222 reply(Tag, {ok, get()}), 1223 State; 1224 1225handle_req(#save_profile{file = File}, Tag, State) -> 1226 case get(profile_state) of 1227 {idle, undefined} -> 1228 reply(Tag, {error, no_profile}); 1229 {idle, _} -> 1230 reply(Tag, ets:tab2file(get(profile_table), File)), 1231 State; 1232 _ -> 1233 reply(Tag, {error, profiling}), 1234 State 1235 end; 1236 1237handle_req(#load_profile{file = File}, Tag, State) -> 1238 case get(profile_state) of 1239 {idle, Result} -> 1240 case ets:file2tab(File) of 1241 {ok, Table} -> 1242 put(profile_state, {idle, ok}), 1243 case Result of 1244 {error, no_profile} -> 1245 ets:delete(put(profile_table, Table)); 1246 _ -> 1247 put(profile_table, Table) 1248 end, 1249 reply(Tag, ok), 1250 State; 1251 Error -> 1252 reply(Tag, Error), 1253 State 1254 end; 1255 _ -> 1256 reply(Tag, {error, profiling}), 1257 State 1258 end; 1259 1260 1261 1262handle_req(Request, Tag, State) -> 1263 io:format("~n~p:handle_req, unknown request - ~p~n", 1264 [?MODULE, Request]), 1265 reply(Tag, {error, unknown_request}), 1266 State. 1267 1268%%-------------------- 1269%% Server handle_other 1270%%-------------------- 1271 1272handle_other({'EXIT', Pid, Reason} = Other, State) when is_pid(Pid); is_port(Pid) -> 1273 case {get(trace_state), get(trace_pid)} of 1274 {running, Pid} -> 1275 trace_off(), 1276 io:format("~n~p:handle_other, unexpected ~p (trace_pid)~n", 1277 [?MODULE, Other]), 1278 put(trace_state, idle), 1279 erase(trace_type), 1280 erase(trace_pid), 1281 try_pending_stop(State); 1282 {stopping, Pid} -> 1283 put(trace_state, idle), 1284 erase(trace_pid), 1285 reply(erase(trace_tag), result(Reason)), 1286 try_pending_stop(State); 1287 _ -> 1288 case {get(profile_state), get(profile_pid)} of 1289 {running, Pid} -> 1290 Result = result(Reason), 1291 put(profile_state, {idle, Result}), 1292 erase(profile_type), 1293 erase(profile_pid), 1294 case erase(profile_close_dump) of 1295 true -> 1296 file:close(erase(profile_dump)); 1297 false -> 1298 erase(profile_dump) 1299 end, 1300 reply(erase(profile_tag), Result), 1301 try_pending_stop(State); 1302 _ -> 1303 io:format("~n~p:handle_other, unexpected ~p~n", 1304 [?MODULE, Other]), 1305 State 1306 end 1307 end; 1308 1309handle_other(Other, State) -> 1310 io:format("~p:handle_other, unknown - ~p", 1311 [?MODULE, Other]), 1312 State. 1313 1314 1315 1316%%%---------------------------------------------------------------------- 1317%%% Internal functions 1318%%%---------------------------------------------------------------------- 1319 1320result(normal) -> 1321 ok; 1322result(Reason) -> 1323 {error, Reason}. 1324 1325ensure_open(Pid, _Options) when is_pid(Pid) -> 1326 {already_open, Pid}; 1327ensure_open([], _Options) -> 1328 {already_open, undefined}; 1329ensure_open(Filename, Options) when is_atom(Filename); is_list(Filename) -> 1330 file:open(Filename, [{encoding, utf8} | Options]). 1331 1332%%%--------------------------------- 1333%%% Fairly generic utility functions 1334%%%--------------------------------- 1335 1336 1337 1338%% getopts(List, Options)) -> {DecodedOptions, RestOptions} 1339%% 1340%% List = [Option] 1341%% Options = [OptionTag] 1342%% Option = OptionTag | OptionTuple 1343%% OptionTuple = tuple(), element(1, OptionTuple) == OptionTag 1344%% OptionTag = term() 1345%% OptionValue = term() 1346%% DecodedOptions = [OptionList] 1347%% OptionList = [Option] 1348%% RestOptions = [Option] 1349%% 1350%% Searches List for options with tags defined in Options. 1351%% Returns DecodedOptions containing one OptionList per 1352%% OptionTag in Options, and RestOptions which contains 1353%% all terms from List not matching any OptionTag. 1354%% 1355%% All returned lists preserve the order from Options and List. 1356%% 1357%% An example: 1358%% getopts([{f, 1}, e, {d, 2}, {c, 3, 4}, {b, 5}, a, b], 1359%% [a, b, c, d]) -> 1360%% {[[a], [{b, 5}, b],[{c, 3, 4}], [{d, 2}]], 1361%% [{f, 1}, e]} 1362%% 1363getopts(List, Options) when is_list(List), is_list(Options) -> 1364 getopts_1(Options, List, []). 1365 1366getopts_1([], List, Result) -> 1367 {lists:reverse(Result), List}; 1368getopts_1([Option | Options], List, Result) -> 1369 {Optvals, Remaining} = getopts_2(List, Option, [], []), 1370 getopts_1(Options, Remaining, [Optvals | Result]). 1371 1372getopts_2([], _Option, Result, Remaining) -> 1373 {lists:reverse(Result), lists:reverse(Remaining)}; 1374getopts_2([Option | Tail], Option, Result, Remaining) -> 1375 getopts_2(Tail, Option, [Option | Result], Remaining); 1376getopts_2([Optval | Tail], Option, Result, Remaining) 1377 when element(1, Optval) =:= Option -> 1378 getopts_2(Tail, Option, [Optval | Result], Remaining); 1379getopts_2([Other | Tail], Option, Result, Remaining) -> 1380 getopts_2(Tail, Option, Result, [Other | Remaining]). 1381 1382%% setopts(Options) -> List 1383%% 1384%% The reverse of getopts, almost. 1385%% Re-creates (approximately) List from DecodedOptions in 1386%% getopts/2 above. The original order is not preserved, 1387%% but rather the order from Options. 1388%% 1389%% An example: 1390%% setopts([[a], [{b,5}, b], [{c, 3, 4}], [{d,2}]]) -> 1391%% [a, {b, 5}, b, {c, 3, 4}, {d, 2}] 1392%% 1393%% And a more generic example: 1394%% {D, R} = getopts(L, O), 1395%% L2 = setopts(D) ++ R 1396%% L2 will contain exactly the same terms as L, but not in the same order. 1397%% 1398setopts(Options) when is_list(Options) -> 1399 lists:append(Options). 1400 1401 1402 1403spawn_3step(FunPrelude, FunAck, FunBody) -> 1404 spawn_3step(spawn, FunPrelude, FunAck, FunBody). 1405 1406spawn_link_3step(FunPrelude, FunAck, FunBody) -> 1407 spawn_3step(spawn_link, FunPrelude, FunAck, FunBody). 1408 1409spawn_3step(Spawn, FunPrelude, FunAck, FunBody) 1410 when Spawn =:= spawn; Spawn =:= spawn_link -> 1411 Parent = self(), 1412 Ref = make_ref(), 1413 Child = 1414 erlang:Spawn( 1415 fun() -> 1416 Ack = FunPrelude(), 1417 catch Parent ! {self(), Ref, Ack}, 1418 MRef = erlang:monitor(process, Parent), 1419 receive 1420 {Parent, Ref, Go} -> 1421 erlang:demonitor(MRef, [flush]), 1422 FunBody(Go); 1423 {'DOWN', MRef, _, _, _} -> 1424 ok 1425 end 1426 end), 1427 MRef = erlang:monitor(process, Child), 1428 receive 1429 {Child, Ref, Ack} -> 1430 erlang:demonitor(MRef, [flush]), 1431 try FunAck(Ack) of 1432 {Result, Go} -> 1433 catch Child ! {Parent, Ref, Go}, 1434 Result 1435 catch 1436 Class:Reason:Stacktrace -> 1437 catch exit(Child, kill), 1438 erlang:raise(Class, Reason, Stacktrace) 1439 end; 1440 {'DOWN', MRef, _, _, Reason} -> 1441 receive {Child, Ref, _Ack} -> ok after 0 -> ok end, 1442 case Spawn of 1443 spawn_link -> 1444 receive {'EXIT', Reason} -> ok after 0 -> ok end; 1445 spawn -> 1446 ok 1447 end, 1448 exit(Reason) 1449 end. 1450 1451 1452 1453%%%--------------------------------- 1454%%% Trace message handling functions 1455%%%--------------------------------- 1456 1457trace_off() -> 1458 try erlang:trace_delivered(all) of 1459 Ref -> receive {trace_delivered, all, Ref} -> ok end 1460 catch 1461 error:undef -> ok 1462 end, 1463 try erlang:trace(all, false, [all, cpu_timestamp]) 1464 catch 1465 error:badarg -> erlang:trace(all, false, [all]) 1466 end, 1467 erlang:trace_pattern(on_load, false, [local]), 1468 erlang:trace_pattern({'_', '_', '_'}, false, [local]), 1469 ok. 1470 1471 1472 1473trace_on(Procs, Tracer, {V, CT}) -> 1474 case case CT of 1475 cpu_time -> 1476 try erlang:trace(all, true, [cpu_timestamp]) of _ -> ok 1477 catch 1478 error:badarg -> {error, not_supported} 1479 end; 1480 wallclock -> ok 1481 end 1482 of ok -> 1483 MatchSpec = [{'_', [], [{message, {{cp, {caller}}}}]}], 1484 erlang:trace_pattern(on_load, MatchSpec, [local]), 1485 erlang:trace_pattern({'_', '_', '_'}, MatchSpec, [local]), 1486 lists:foreach( 1487 fun (P) -> 1488 erlang:trace(P, true, [{tracer, Tracer} | trace_flags(V)]) 1489 end, 1490 Procs), 1491 ok; 1492 Error -> 1493 Error 1494 end. 1495 1496 1497 1498trace_flags(normal) -> 1499 [call, return_to, 1500 running, procs, garbage_collection, 1501 arity, timestamp, set_on_spawn]; 1502trace_flags(verbose) -> 1503 [call, return_to, 1504 send, 'receive', 1505 running, procs, garbage_collection, 1506 timestamp, set_on_spawn]. 1507 1508 1509 1510%%%------------------------------------- 1511%%% Tracer process functions, for 1512%%% the 'dbg' tracer and for a lookalike 1513%%%------------------------------------- 1514 1515open_dbg_trace_port(Type, Spec) -> 1516 Fun = dbg:trace_port(Type, Spec), 1517 Fun(). 1518 1519 1520 1521spawn_link_dbg_trace_client(File, Table, GroupLeader, Dump) -> 1522 case dbg:trace_client(file, File, 1523 {fun handler/2, 1524 {init, GroupLeader, Table, Dump}}) of 1525 Pid when is_pid(Pid) -> 1526 link(Pid), 1527 Pid; 1528 Other -> 1529 exit(Other) 1530 end. 1531 1532 1533 1534 1535spawn_link_trace_client(Table, GroupLeader, Dump) -> 1536 Parent = self(), 1537 spawn_link_3step( 1538 fun() -> 1539 process_flag(trap_exit, true), 1540 {self(),go} 1541 end, 1542 fun(Ack) -> 1543 Ack 1544 end, 1545 fun(go) -> 1546 Init = {init, GroupLeader, Table, Dump}, 1547 tracer_loop(Parent, fun handler/2, Init) 1548 end). 1549 1550tracer_loop(Parent, Handler, State) -> 1551 receive 1552 Trace when element(1, Trace) =:= trace -> 1553 tracer_loop(Parent, Handler, Handler(Trace, State)); 1554 Trace when element(1, Trace) =:= trace_ts -> 1555 tracer_loop(Parent, Handler, Handler(Trace, State)); 1556 {'EXIT', Parent, Reason} -> 1557 _ = handler(end_of_trace, State), 1558 exit(Reason); 1559 _ -> 1560 tracer_loop(Parent, Handler, State) 1561 end. 1562 1563 1564 1565%%%--------------------------------- 1566%%% Trace message handling functions 1567%%%--------------------------------- 1568 1569handler(end_of_trace, {init, GroupLeader, Table, Dump}) -> 1570 dump(Dump, start_of_trace), 1571 dump(Dump, end_of_trace), 1572 info(GroupLeader, Dump, "Empty trace!~n", []), 1573 end_of_trace(Table, undefined), 1574 done; 1575handler(end_of_trace, {error, Reason, _, GroupLeader, Dump}) -> 1576 info(GroupLeader, Dump, "~nEnd of erroneous trace!~n", []), 1577 exit(Reason); 1578handler(end_of_trace, {_, TS, GroupLeader, Table, Dump}) -> 1579 dump(Dump, end_of_trace), 1580 info(GroupLeader, Dump, "~nEnd of trace!~n", []), 1581 end_of_trace(Table, TS), 1582 done; 1583handler(Trace, {init, GroupLeader, Table, Dump}) -> 1584 dump(Dump, start_of_trace), 1585 info(GroupLeader, Dump, "Reading trace data...~n", []), 1586 try trace_handler(Trace, Table, GroupLeader, Dump) of 1587 TS -> 1588 ets:insert(Table, #misc{id = first_ts, data = TS}), 1589 ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}), 1590 {1, TS, GroupLeader, Table, Dump} 1591 catch 1592 Error -> 1593 dump(Dump, {error, Error}), 1594 end_of_trace(Table, undefined), 1595 {error, Error, 1, GroupLeader, Dump} 1596 end; 1597%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of 1598%% {'EXIT', Reason} -> 1599%% dump(Dump, {error, Reason}), 1600%% end_of_trace(Table, undefined), 1601%% {error, Reason, 1, GroupLeader, Dump}; 1602%% TS -> 1603%% ets:insert(Table, #misc{id = first_ts, data = TS}), 1604%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, 1}}), 1605%% {1, TS, GroupLeader, Table, Dump} 1606%% end; 1607handler(_, {error, Reason, M, GroupLeader, Dump}) -> 1608 N = M+1, 1609 info_dots(GroupLeader, Dump, N), 1610 {error, Reason, N, GroupLeader, Dump}; 1611handler(Trace, {M, TS0, GroupLeader, Table, Dump}) -> 1612 N = M+1, 1613 info_dots(GroupLeader, Dump, N), 1614 try trace_handler(Trace, Table, GroupLeader, Dump) of 1615 TS -> 1616 ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}), 1617 {N, TS, GroupLeader, Table, Dump} 1618 catch 1619 Error -> 1620 dump(Dump, {error, Error}), 1621 end_of_trace(Table, TS0), 1622 {error, Error, N, GroupLeader, Dump} 1623 end. 1624%% case catch trace_handler(Trace, Table, GroupLeader, Dump) of 1625%% {'EXIT', Reason} -> 1626%% dump(Dump, {error, Reason}), 1627%% end_of_trace(Table, TS0), 1628%% {error, Reason, N, GroupLeader, Dump}; 1629%% TS -> 1630%% ets:insert(Table, #misc{id = last_ts_n, data = {TS, N}}), 1631%% {N, TS, GroupLeader, Table, Dump} 1632%% end. 1633 1634 1635 1636end_of_trace(Table, TS) -> 1637 %% 1638 %% Close all process stacks, as if the processes exited. 1639 %% 1640 Procs = get(), 1641 put(table, Table), 1642 ?dbg(2, "get() -> ~p~n", [Procs]), 1643 _ = lists:map(fun ({Pid, _}) when is_pid(Pid) -> 1644 trace_exit(Table, Pid, TS) 1645 end, Procs), 1646 _ = erase(), 1647 ok. 1648 1649 1650 1651info_dots(GroupLeader, GroupLeader, _) -> 1652 ok; 1653info_dots(GroupLeader, _, N) -> 1654 if (N rem 100000) =:= 0 -> 1655 io:format(GroupLeader, ",~n", []); 1656 (N rem 50000) =:= 0 -> 1657 io:format(GroupLeader, ".~n", []); 1658 (N rem 1000) =:= 0 -> 1659 io:put_chars(GroupLeader, "."); 1660 true -> 1661 ok 1662 end. 1663 1664info_suspect_call(GroupLeader, GroupLeader, _, _) -> 1665 ok; 1666info_suspect_call(GroupLeader, _, Func, Pid) -> 1667 io:format(GroupLeader, 1668 "~nWarning: ~tp called in ~p - trace may become corrupt!~n", 1669 parsify([Func, Pid])). 1670 1671info(GroupLeader, GroupLeader, _, _) -> 1672 ok; 1673info(GroupLeader, _, Format, List) -> 1674 io:format(GroupLeader, Format, List). 1675 1676dump_stack(undefined, _, _) -> 1677 false; 1678dump_stack(Dump, Stack, Term) -> 1679 {Depth, _D} = 1680 case Stack of 1681 undefined -> 1682 {0, 0}; 1683 _ -> 1684 case length(Stack) of 1685 0 -> 1686 {0, 0}; 1687 N -> 1688 {N, length(hd(Stack))} 1689 end 1690 end, 1691 io:format(Dump, "~s~tp.~n", [lists:duplicate(Depth, " "), parsify(Term)]), 1692 true. 1693 1694dump(undefined, _) -> 1695 false; 1696dump(Dump, Term) -> 1697 io:format(Dump, "~tp.~n", [parsify(Term)]), 1698 true. 1699 1700 1701 1702%%%---------------------------------- 1703%%% Profiling state machine functions 1704%%%---------------------------------- 1705 1706 1707 1708trace_handler({trace_ts, Pid, call, _MFA, _TS} = Trace, 1709 _Table, _, Dump) -> 1710 Stack = get(Pid), 1711 dump_stack(Dump, Stack, Trace), 1712 throw({incorrect_trace_data, ?MODULE, ?LINE, 1713 [Trace, Stack]}); 1714trace_handler({trace_ts, Pid, call, {_M, _F, Arity} = Func, 1715 {cp, CP}, TS} = Trace, 1716 Table, GroupLeader, Dump) 1717 when is_integer(Arity) -> 1718 dump_stack(Dump, get(Pid), Trace), 1719 case Func of 1720 {erlang, trace, 3} -> 1721 info_suspect_call(GroupLeader, Dump, Func, Pid); 1722 {erlang, trace_pattern, 3} -> 1723 info_suspect_call(GroupLeader, Dump, Func, Pid); 1724 _ -> 1725 ok 1726 end, 1727 trace_call(Table, Pid, Func, TS, CP), 1728 TS; 1729trace_handler({trace_ts, Pid, call, {_M, _F, Args} = MFArgs, 1730 {cp, CP}, TS} = Trace, 1731 Table, _, Dump) 1732 when is_list(Args) -> 1733 dump_stack(Dump, get(Pid), Trace), 1734 Func = mfarity(MFArgs), 1735 trace_call(Table, Pid, Func, TS, CP), 1736 TS; 1737%% 1738%% return_to 1739trace_handler({trace_ts, Pid, return_to, undefined, TS} = Trace, 1740 Table, _, Dump) -> 1741 dump_stack(Dump, get(Pid), Trace), 1742 trace_return_to(Table, Pid, undefined, TS), 1743 TS; 1744trace_handler({trace_ts, Pid, return_to, {_M, _F, Arity} = Func, TS} = Trace, 1745 Table, _, Dump) 1746 when is_integer(Arity) -> 1747 dump_stack(Dump, get(Pid), Trace), 1748 trace_return_to(Table, Pid, Func, TS), 1749 TS; 1750trace_handler({trace_ts, Pid, return_to, {_M, _F, Args} = MFArgs, TS} = Trace, 1751 Table, _, Dump) 1752 when is_list(Args) -> 1753 dump_stack(Dump, get(Pid), Trace), 1754 Func = mfarity(MFArgs), 1755 trace_return_to(Table, Pid, Func, TS), 1756 TS; 1757%% 1758%% spawn, only needed (and reliable) prior to 19.0 1759trace_handler({trace_ts, Pid, spawn, Child, MFArgs, TS} = Trace, 1760 Table, _, Dump) -> 1761 dump_stack(Dump, get(Pid), Trace), 1762 trace_spawn(Table, Child, MFArgs, TS, Pid), 1763 TS; 1764%% 1765%% spawned, added in 19.0 1766trace_handler({trace_ts, Pid, spawned, Parent, MFArgs, TS} = Trace, 1767 Table, _, Dump) -> 1768 dump_stack(Dump, get(Pid), Trace), 1769 trace_spawn(Table, Pid, MFArgs, TS, Parent), 1770 TS; 1771%% 1772%% exit 1773trace_handler({trace_ts, Pid, exit, _Reason, TS} = Trace, 1774 Table, _, Dump) -> 1775 dump_stack(Dump, get(Pid), Trace), 1776 trace_exit(Table, Pid, TS), 1777 TS; 1778%% 1779%% out 1780trace_handler({trace_ts, Pid, out, 0, TS} = Trace, 1781 Table, _, Dump) -> 1782 dump_stack(Dump, get(Pid), Trace), 1783 trace_out(Table, Pid, undefined, TS), 1784 TS; 1785trace_handler({trace_ts, Pid, out, {_M, _F, Arity} = Func, TS} = Trace, 1786 Table, _, Dump) 1787 when is_integer(Arity) -> 1788 dump_stack(Dump, get(Pid), Trace), 1789 trace_out(Table, Pid, Func, TS), 1790 TS; 1791trace_handler({trace_ts, Pid, out, {_M, _F, Args} = MFArgs, TS} = Trace, 1792 Table, _, Dump) 1793 when is_list(Args) -> 1794 dump_stack(Dump, get(Pid), Trace), 1795 Func = mfarity(MFArgs), 1796 trace_out(Table, Pid, Func, TS), 1797 TS; 1798%% 1799%% in 1800trace_handler({trace_ts, Pid, in, 0, TS} = Trace, 1801 Table, _, Dump) -> 1802 dump_stack(Dump, get(Pid), Trace), 1803 trace_in(Table, Pid, undefined, TS), 1804 TS; 1805trace_handler({trace_ts, Pid, in, {_M, _F, Arity} = Func, TS} = Trace, 1806 Table, _, Dump) 1807 when is_integer(Arity) -> 1808 dump_stack(Dump, get(Pid), Trace), 1809 trace_in(Table, Pid, Func, TS), 1810 TS; 1811trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace, 1812 Table, _, Dump) 1813 when is_list(Args) -> 1814 dump_stack(Dump, get(Pid), Trace), 1815 Func = mfarity(MFArgs), 1816 trace_in(Table, Pid, Func, TS), 1817 TS; 1818%% 1819%% gc_start 1820trace_handler({trace_ts, Pid, gc_minor_start, _Func, TS} = Trace, Table, _, Dump) -> 1821 dump_stack(Dump, get(Pid), Trace), 1822 trace_gc_start(Table, Pid, TS), 1823 TS; 1824 1825trace_handler({trace_ts, Pid, gc_major_start, _Func, TS} = Trace, Table, _, Dump) -> 1826 dump_stack(Dump, get(Pid), Trace), 1827 trace_gc_start(Table, Pid, TS), 1828 TS; 1829 1830trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace, Table, _, Dump) -> 1831 dump_stack(Dump, get(Pid), Trace), 1832 trace_gc_start(Table, Pid, TS), 1833 TS; 1834 1835%% 1836%% gc_end 1837trace_handler({trace_ts, Pid, gc_minor_end, _Func, TS} = Trace, Table, _, Dump) -> 1838 dump_stack(Dump, get(Pid), Trace), 1839 trace_gc_end(Table, Pid, TS), 1840 TS; 1841 1842trace_handler({trace_ts, Pid, gc_major_end, _Func, TS} = Trace, Table, _, Dump) -> 1843 dump_stack(Dump, get(Pid), Trace), 1844 trace_gc_end(Table, Pid, TS), 1845 TS; 1846 1847trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace, Table, _, Dump) -> 1848 dump_stack(Dump, get(Pid), Trace), 1849 trace_gc_end(Table, Pid, TS), 1850 TS; 1851 1852%% 1853%% link 1854trace_handler({trace_ts, Pid, link, _OtherPid, TS} = Trace, 1855 _Table, _, Dump) -> 1856 dump_stack(Dump, get(Pid), Trace), 1857 TS; 1858%% 1859%% unlink 1860trace_handler({trace_ts, Pid, unlink, _OtherPid, TS} = Trace, 1861 _Table, _, Dump) -> 1862 dump_stack(Dump, get(Pid), Trace), 1863 TS; 1864%% 1865%% getting_linked 1866trace_handler({trace_ts, Pid, getting_linked, _OtherPid, TS} = Trace, 1867 _Table, _, Dump) -> 1868 dump_stack(Dump, get(Pid), Trace), 1869 TS; 1870%% 1871%% getting_unlinked 1872trace_handler({trace_ts, Pid, getting_unlinked, _OtherPid, TS} = Trace, 1873 _Table, _, Dump) -> 1874 dump_stack(Dump, get(Pid), Trace), 1875 TS; 1876%% 1877%% register 1878trace_handler({trace_ts, Pid, register, _Name, TS} = Trace, 1879 _Table, _, Dump) -> 1880 dump_stack(Dump, get(Pid), Trace), 1881 TS; 1882%% 1883%% unregister 1884trace_handler({trace_ts, Pid, unregister, _Name, TS} = Trace, 1885 _Table, _, Dump) -> 1886 dump_stack(Dump, get(Pid), Trace), 1887 TS; 1888%% 1889%% send 1890trace_handler({trace_ts, Pid, send, _OtherPid, _Msg, TS} = Trace, 1891 _Table, _, Dump) -> 1892 dump_stack(Dump, get(Pid), Trace), 1893 TS; 1894%% 1895%% send_to_non_existing_process 1896trace_handler({trace_ts, Pid, send_to_non_existing_process, _OtherPid, _Msg, TS} = Trace, 1897 _Table, _, Dump) -> 1898 dump_stack(Dump, get(Pid), Trace), 1899 TS; 1900%% 1901%% 'receive' 1902trace_handler({trace_ts, Pid, 'receive', _Msg, TS} = Trace, 1903 _Table, _, Dump) -> 1904 dump_stack(Dump, get(Pid), Trace), 1905 TS; 1906%% 1907%% Others 1908trace_handler(Trace, _Table, _, Dump) -> 1909 dump(Dump, Trace), 1910 throw({incorrect_trace_data, ?MODULE, ?LINE, [Trace]}). 1911 1912 1913 1914%% The call stack 1915%% -------------- 1916%% 1917%% The call stack can be modeled as a tree, with each level in the tree 1918%% corresponding to a real (non-tail recursive) stack entry, 1919%% and the nodes within a level corresponding to tail recursive 1920%% calls on that real stack depth. 1921%% 1922%% Example: 1923%% a() -> 1924%% b(). 1925%% b() -> 1926%% c(), 1927%% d(). 1928%% c() -> ok. 1929%% d() -> 1930%% e(), 1931%% c(). 1932%% e() -> 1933%% f(). 1934%% f() -> ok. 1935%% 1936%% During the execution the call tree would be, for each call and return_to: 1937%% 1938%% a() b() c() ->b d() e() f() ->d c() ->a 1939%% 1940%% a a a a a a a a a a 1941%% | | | |\ |\ |\ |\ /|\ 1942%% b b b b d b d b d b d b d c 1943%% | | /| 1944%% c e e f 1945%% 1946%% The call tree is in this code represented as a two level list, 1947%% which for the biggest tree (5 nodes) in the example above would be: 1948%% [[{f, _}, {e, _}], [{d, _}, {b, _}], [{a, _}]] 1949%% where the undefined fields are timestamps of the calls to the 1950%% functions, and the function name fields are really 1951%% {Module, Function, Arity} tuples. 1952%% 1953%% Since tail recursive calls can form an infinite loop, cycles 1954%% within a tail recursive level must be collapsed or else the 1955%% stack (tree) size may grow towards infinity. 1956 1957 1958 1959trace_call(Table, Pid, Func, TS, CP) -> 1960 Stack = get_stack(Pid), 1961 ?dbg(0, "trace_call(~p, ~p, ~p, ~p)~n~p~n", 1962 [Pid, Func, TS, CP, Stack]), 1963 {Proc,InitCnt} = 1964 case ets:lookup(Table, Pid) of 1965 [#proc{init_cnt = N} = P] -> 1966 {P,N}; 1967 [] -> 1968 {undefined,0} 1969 end, 1970 case Stack of 1971 [] -> 1972 init_log(Table, Proc, Func), 1973 OldStack = 1974 if CP =:= undefined -> 1975 Stack; 1976 true -> 1977 [[{CP, TS}]] 1978 end, 1979 put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack)); 1980 [[{Func, FirstInTS}]] when InitCnt=:=2 -> 1981 %% First call on this process. Take the timestamp for first 1982 %% time the process was scheduled in. 1983 init_log(Table, Proc, Func), 1984 OldStack = 1985 if CP =:= undefined -> 1986 []; 1987 true -> 1988 [[{CP, FirstInTS}]] 1989 end, 1990 put(Pid, trace_call_push(Table, Pid, Func, FirstInTS, OldStack)); 1991 [[{suspend, _} | _] | _] -> 1992 throw({inconsistent_trace_data, ?MODULE, ?LINE, 1993 [Pid, Func, TS, CP, Stack]}); 1994 [[{garbage_collect, _} | _] | _] -> 1995 throw({inconsistent_trace_data, ?MODULE, ?LINE, 1996 [Pid, Func, TS, CP, Stack]}); 1997 [[{CP, _} | _], [{CP, _} | _] | _] -> 1998 %% This is a difficult case - current function becomes 1999 %% new stack top but is already pushed. It might be that 2000 %% this call is actually tail recursive, or maybe not. 2001 %% Assume tail recursive to not build the stack infinitely 2002 %% and fix the problem at the next call after a return to 2003 %% this level. 2004 %% 2005 %% This can be viewed as collapsing a very short stack 2006 %% recursive stack cykle. 2007 init_log(Table, Proc, Func), 2008 put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack)); 2009 [[{CP, _} | _] | _] -> 2010 %% Current function becomes new stack top -> stack push 2011 init_log(Table, Proc, Func), 2012 put(Pid, trace_call_push(Table, Pid, Func, TS, Stack)); 2013 [_, [{CP, _} | _] | _] -> 2014 %% Stack top unchanged -> no push == tail recursive call 2015 init_log(Table, Proc, Func), 2016 put(Pid, trace_call_shove(Table, Pid, Func, TS, Stack)); 2017 [[{Func0, _} | _], [{Func0, _} | _], [{CP, _} | _] | _] -> 2018 %% Artificial case that only should happen when 2019 %% stack recursive short cycle collapsing has been done, 2020 %% otherwise CP should not occur so far from the stack front. 2021 %% 2022 %% It is a tail recursive call but fix the stack first. 2023 init_log(Table, Proc, Func), 2024 put(Pid, 2025 trace_call_shove(Table, Pid, Func, TS, 2026 trace_return_to_int(Table, Pid, Func0, TS, 2027 Stack))); 2028 [[{_, TS0} | _] = Level0] -> 2029 %% Current function known, but not stack top 2030 %% -> assume tail recursive call 2031 init_log(Table, Proc, Func), 2032 OldStack = 2033 if CP =:= undefined -> 2034 Stack; 2035 true -> 2036 [Level0, [{CP, TS0}]] 2037 end, 2038 put(Pid, trace_call_shove(Table, Pid, Func, TS, OldStack)); 2039 [_ | _] -> 2040 %% Weird case when the stack is seriously f***ed up. 2041 %% CP is not at stack top nor at previous stack top, 2042 %% which is impossible, if we had a correct stack view. 2043 OldStack = 2044 if CP =:= undefined -> 2045 %% Assume that CP is unknown because it is 2046 %% the stack bottom for the process, and that 2047 %% the whole call stack is invalid. Waste it. 2048 trace_return_to_int(Table, Pid, CP, TS, Stack); 2049 true -> 2050 %% Assume that we have collapsed a tail recursive 2051 %% call stack cykle too many. Introduce CP in 2052 %% the current tail recursive level so it at least 2053 %% gets charged for something. 2054 init_log(Table, Proc, CP), 2055 trace_call_shove(Table, Pid, CP, TS, Stack) 2056 end, 2057 %% Regard this call as a stack push. 2058 init_log(Table, Pid, Func), % will lookup Pid in Table 2059 put(Pid, trace_call_push(Table, Pid, Func, TS, OldStack)) 2060 end, 2061 ok. 2062 2063%% Normal stack push 2064trace_call_push(Table, Pid, Func, TS, Stack) -> 2065 case Stack of 2066 [] -> 2067 ok; 2068 [_ | _] -> 2069 trace_clock(Table, Pid, TS, Stack, #clocks.own) 2070 end, 2071 NewStack = [[{Func, TS}] | Stack], 2072 trace_clock(Table, Pid, 1, NewStack, #clocks.cnt), 2073 NewStack. 2074 2075%% Tail recursive stack push 2076trace_call_shove(Table, Pid, Func, TS, Stack) -> 2077 trace_clock(Table, Pid, TS, Stack, #clocks.own), 2078 [[_ | NewLevel0] | NewStack1] = 2079 case Stack of 2080 [] -> 2081 [[{Func, TS}]]; 2082 [Level0 | Stack1] -> 2083 [trace_call_collapse([{Func, TS} | Level0]) | Stack1] 2084 end, 2085 NewStack = [[{Func, TS} | NewLevel0] | NewStack1], 2086 trace_clock(Table, Pid, 1, NewStack, #clocks.cnt), 2087 NewStack. 2088 2089%% Collapse tail recursive call stack cycles to prevent them from 2090%% growing to infinite length. 2091trace_call_collapse([]) -> 2092 []; 2093trace_call_collapse([_] = Stack) -> 2094 Stack; 2095trace_call_collapse([_, _] = Stack) -> 2096 Stack; 2097trace_call_collapse([_ | Stack1] = Stack) -> 2098 trace_call_collapse_1(Stack, Stack1, 1). 2099 2100%% Find some other instance of the current function in the call stack 2101%% and try if that instance may be used as stack top instead. 2102trace_call_collapse_1(Stack, [], _) -> 2103 Stack; 2104trace_call_collapse_1([{Func0, _} | _] = Stack, [{Func0, _} | S1] = S, N) -> 2105 case trace_call_collapse_2(Stack, S, N) of 2106 true -> 2107 S; 2108 false -> 2109 trace_call_collapse_1(Stack, S1, N+1) 2110 end; 2111trace_call_collapse_1(Stack, [_ | S1], N) -> 2112 trace_call_collapse_1(Stack, S1, N+1). 2113 2114%% Check if all caller/called pairs in the perhaps to be collapsed 2115%% stack segment (at the front) are present in the rest of the stack, 2116%% and also in the same order. 2117trace_call_collapse_2(_, _, 0) -> 2118 true; 2119trace_call_collapse_2([{Func1, _} | [{Func2, _} | _] = Stack2], 2120 [{Func1, _} | [{Func2, _} | _] = S2], 2121 N) -> 2122 trace_call_collapse_2(Stack2, S2, N-1); 2123trace_call_collapse_2([{Func1, _} | _], [{Func1, _} | _], _N) -> 2124 false; 2125trace_call_collapse_2(_Stack, [_], _N) -> 2126 false; 2127trace_call_collapse_2(Stack, [_ | S], N) -> 2128 trace_call_collapse_2(Stack, S, N); 2129trace_call_collapse_2(_Stack, [], _N) -> 2130 false. 2131 2132 2133 2134trace_return_to(Table, Pid, Func, TS) -> 2135 Stack = get_stack(Pid), 2136 ?dbg(0, "trace_return_to(~p, ~p, ~p)~n~p~n", 2137 [Pid, Func, TS, Stack]), 2138 case Stack of 2139 [[{suspend, _} | _] | _] -> 2140 throw({inconsistent_trace_data, ?MODULE, ?LINE, 2141 [Pid, Func, TS, Stack]}); 2142 [[{garbage_collect, _} | _] | _] -> 2143 throw({inconsistent_trace_data, ?MODULE, ?LINE, 2144 [Pid, Func, TS, Stack]}); 2145 [_ | _] -> 2146 put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack)); 2147 [] -> 2148 put(Pid, trace_return_to_int(Table, Pid, Func, TS, Stack)) 2149 end, 2150 ok. 2151 2152trace_return_to_int(Table, Pid, Func, TS, Stack) -> 2153 %% The old stack must be sent to trace_clock, so 2154 %% the function we just returned from is charged with 2155 %% own time. 2156 trace_clock(Table, Pid, TS, Stack, #clocks.own), 2157 case trace_return_to_2(Table, Pid, Func, TS, Stack) of 2158 {undefined, _} -> 2159 [[{Func, TS}] | Stack]; 2160 {[[{Func, _} | Level0] | Stack1], _} -> 2161 [[{Func, TS} | Level0] | Stack1]; 2162 {NewStack, _} -> 2163 NewStack 2164 end. 2165 2166%% A list of charged functions is passed around to assure that 2167%% any function is charged with ACC time only once - the first time 2168%% it is encountered. The function trace_return_to_1 is called only 2169%% for the front of a tail recursive level, and if the front 2170%% does not match the returned-to function, trace_return_to_2 2171%% is called for all functions within the tail recursive level. 2172%% 2173%% Charging is done in reverse order, i.e from stack rear to front. 2174 2175%% Search the call stack until the returned-to function is found at 2176%% a tail recursive level's front, and charge it with ACC time. 2177trace_return_to_1(_, _, undefined, _, []) -> 2178 {[], []}; 2179trace_return_to_1(_, _, _, _, []) -> 2180 {undefined, []}; 2181trace_return_to_1(Table, Pid, Func, TS, 2182 [[{Func, _} | Level0] | Stack1] = Stack) -> 2183 %% Match at front of tail recursive level 2184 Charged = trace_return_to_3([Level0 | Stack1], []), 2185 case lists:member(Func, Charged) of 2186 false -> 2187 trace_clock(Table, Pid, TS, Stack, #clocks.acc), 2188 {Stack, [Func | Charged]}; 2189 true -> 2190 {Stack, Charged} 2191 end; 2192trace_return_to_1(Table, Pid, Func, TS, Stack) -> 2193 trace_return_to_2(Table, Pid, Func, TS, Stack). 2194 2195%% Charge all functions within one tail recursive level, 2196%% from rear to front, with ACC time. 2197trace_return_to_2(Table, Pid, Func, TS, [] = Stack) -> 2198 trace_return_to_1(Table, Pid, Func, TS, Stack); 2199trace_return_to_2(Table, Pid, Func, TS, [[] | Stack1]) -> 2200 trace_return_to_1(Table, Pid, Func, TS, Stack1); 2201trace_return_to_2(Table, Pid, Func, TS, 2202 [[{Func0, _} | Level1] | Stack1] = Stack) -> 2203 case trace_return_to_2(Table, Pid, Func, TS, [Level1 | Stack1]) of 2204 {undefined, _} = R -> 2205 R; 2206 {NewStack, Charged} = R -> 2207 case lists:member(Func0, Charged) of 2208 false -> 2209 trace_clock(Table, Pid, TS, Stack, #clocks.acc), 2210 {NewStack, [Func0 | Charged]}; 2211 true -> 2212 R 2213 end 2214 end. 2215 2216%% Return a flat list of all function names in the given stack 2217trace_return_to_3([], R) -> 2218 R; 2219trace_return_to_3([[] | Stack1], R) -> 2220 trace_return_to_3(Stack1, R); 2221trace_return_to_3([[{Func0, _} | Level0] | Stack1], R) -> 2222 trace_return_to_3([Level0 | Stack1], [Func0 | R]). 2223 2224 2225 2226trace_spawn(Table, Pid, MFArgs, TS, Parent) -> 2227 Stack = get(Pid), 2228 ?dbg(0, "trace_spawn(~p, ~p, ~p, ~p)~n~p~n", 2229 [Pid, MFArgs, TS, Parent, Stack]), 2230 case Stack of 2231 undefined -> 2232 {M,F,Args} = MFArgs, 2233 OldStack = [[{{M,F,length(Args)},TS}]], 2234 put(Pid, trace_call_push(Table, Pid, suspend, TS, OldStack)), 2235 ets:insert(Table, #proc{id = Pid, parent = Parent, 2236 spawned_as = MFArgs}); 2237 _ -> 2238 %% In 19.0 we get both a spawn and spawned event, 2239 %% however we do not know the order so we just ignore 2240 %% the second event that comes 2241 ok 2242 end. 2243 2244 2245 2246trace_exit(Table, Pid, TS) -> 2247 Stack = erase(Pid), 2248 ?dbg(0, "trace_exit(~p, ~p)~n~p~n", [Pid, TS, Stack]), 2249 case Stack of 2250 undefined -> 2251 ok; 2252 [] -> 2253 ok; 2254 [_ | _] = Stack -> 2255 _ = trace_return_to_int(Table, Pid, undefined, TS, Stack), 2256 ok 2257 end, 2258 ok. 2259 2260 2261 2262trace_out(Table, Pid, Func, TS) -> 2263 Stack = get_stack(Pid), 2264 ?dbg(0, "trace_out(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]), 2265 case Stack of 2266 [] -> 2267 put(Pid, trace_call_push(Table, Pid, suspend, TS, 2268 case Func of 2269 undefined -> []; 2270 _ -> 2271 [[{Func,TS}]] 2272 end)); 2273 [[{suspend,_}] | _] -> 2274 %% No stats update for a suspend on suspend 2275 put(Pid, [[{suspend,TS}] | Stack]); 2276 [_ | _] -> 2277 put(Pid, trace_call_push(Table, Pid, suspend, TS, Stack)) 2278 end. 2279 2280 2281 2282trace_in(Table, Pid, Func, TS) -> 2283 Stack = get(Pid), 2284 ?dbg(0, "trace_in(~p, ~p, ~p)~n~p~n", [Pid, Func, TS, Stack]), 2285 case Stack of 2286 undefined -> 2287 %% First activity on a process which existed at the time 2288 %% the fprof trace was started. 2289 put(Pid, [[{Func,TS}]]); 2290 [] -> 2291 put(Pid, [[{Func,TS}]]); 2292 [[{suspend, _}]] -> 2293 put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack)); 2294 [[{suspend,_}] | [[{suspend,_}] | _]=NewStack] -> 2295 %% No stats update for a suspend on suspend 2296 put(Pid, NewStack); 2297 [[{suspend, _}] | [[{Func1, _} | _] | _]] -> 2298 %% This is a new process (suspend and Func1 was inserted 2299 %% by trace_spawn) or any process that has just been 2300 %% scheduled out and now back in. 2301 put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack)); 2302 _ -> 2303 throw({inconsistent_trace_data, ?MODULE, ?LINE, 2304 [Pid, Func, TS, Stack]}) 2305 end. 2306 2307 2308 2309trace_gc_start(Table, Pid, TS) -> 2310 Stack = get_stack(Pid), 2311 ?dbg(0, "trace_gc_start(~p, ~p)~n~p~n", [Pid, TS, Stack]), 2312 put(Pid, trace_call_push(Table, Pid, garbage_collect, TS, Stack)). 2313 2314 2315 2316trace_gc_end(Table, Pid, TS) -> 2317 Stack = get(Pid), 2318 ?dbg(0, "trace_gc_end(~p, ~p)~n~p~n", [Pid, TS, Stack]), 2319 case Stack of 2320 undefined -> 2321 put(Pid, []); 2322 [] -> 2323 ok; 2324 [[{garbage_collect, _}]] -> 2325 put(Pid, trace_return_to_int(Table, Pid, undefined, TS, Stack)); 2326 [[{garbage_collect, _}], [{Func1, _} | _] | _] -> 2327 put(Pid, trace_return_to_int(Table, Pid, Func1, TS, Stack)); 2328 _ -> 2329 throw({inconsistent_trace_data, ?MODULE, ?LINE, 2330 [Pid, TS, Stack]}) 2331 end. 2332 2333 2334 2335%%%----------------------------------------- 2336%%% Statistics calculating support functions 2337%%%----------------------------------------- 2338 2339 2340 2341get_stack(Id) -> 2342 case get(Id) of 2343 undefined -> 2344 []; 2345 Stack -> 2346 Stack 2347 end. 2348 2349 2350 2351mfarity({M, F, Args}) when is_list(Args) -> 2352 {M, F, length(Args)}; 2353mfarity(MFA) -> 2354 MFA. 2355 2356 2357 2358init_log(_Table, _Proc, suspend) -> 2359 ok; 2360init_log(_Table, _Proc, void) -> 2361 ok; 2362init_log(_Table, undefined, _Entry) -> 2363 ok; 2364init_log(_Table, #proc{init_cnt = 0}, _Entry) -> 2365 ok; 2366init_log(Table, #proc{init_cnt = N, init_log = L} = Proc, Entry) -> 2367 ets:insert(Table, Proc#proc{init_cnt = N-1, init_log = [Entry | L]}); 2368init_log(Table, Id, Entry) -> 2369 Proc = 2370 case ets:lookup(Table, Id) of 2371 [P] -> P; 2372 [] -> undefined 2373 end, 2374 init_log(Table,Proc,Entry). 2375 2376 2377trace_clock(_Table, _Pid, _T, 2378 [[{suspend, _}], [{suspend, _}] | _]=_Stack, _Clock) -> 2379 ?dbg(9, "trace_clock(Table, ~w, ~w, ~w, ~w)~n", 2380 [_Pid, _T, _Stack, _Clock]), 2381 ok; 2382trace_clock(Table, Pid, T, 2383 [[{garbage_collect, TS0}], [{suspend, _}]], Clock) -> 2384 trace_clock_1(Table, Pid, T, TS0, undefined, garbage_collect, Clock); 2385trace_clock(Table, Pid, T, 2386 [[{garbage_collect, TS0}], [{suspend, _}], [{Func2, _} | _] | _], 2387 Clock) -> 2388 trace_clock_1(Table, Pid, T, TS0, Func2, garbage_collect, Clock); 2389trace_clock(Table, Pid, T, [[{Func0, TS0}, {Func1, _} | _] | _], Clock) -> 2390 trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock); 2391trace_clock(Table, Pid, T, [[{Func0, TS0}], [{Func1, _} | _] | _], Clock) -> 2392 trace_clock_1(Table, Pid, T, TS0, Func1, Func0, Clock); 2393trace_clock(Table, Pid, T, [[{Func0, TS0}]], Clock) -> 2394 trace_clock_1(Table, Pid, T, TS0, undefined, Func0, Clock); 2395trace_clock(_, _, _, [], _) -> 2396 ok. 2397 2398trace_clock_1(Table, Pid, _, _, Caller, suspend, #clocks.own) -> 2399 clock_add(Table, {Pid, Caller, suspend}, #clocks.own, 0); 2400trace_clock_1(Table, Pid, T, TS, Caller, Func, Clock) -> 2401 clock_add(Table, {Pid, Caller, Func}, Clock, 2402 if is_integer(T) -> 2403 T; 2404 true -> 2405 ts_sub(T, TS) 2406 end). 2407 2408clock_add(Table, Id, Clock, T) -> 2409 ?dbg(1, "clock_add(Table, ~w, ~w, ~w)~n", [Id, Clock, T]), 2410 try ets:update_counter(Table, Id, {Clock, T}), ok 2411 catch 2412 error:badarg -> 2413 ets:insert(Table, #clocks{id = Id}), 2414 X = ets:update_counter(Table, Id, {Clock, T}), 2415 if X >= 0 -> ok; 2416 true -> ?dbg(0, "Negative counter value ~p ~p ~p ~p~n", 2417 [X, Id, Clock, T]) 2418 end, 2419 ok 2420 end. 2421 2422clocks_add(Table, #clocks{id = Id} = Clocks) -> 2423 ?dbg(1, "clocks_add(Table, ~w)~n", [Clocks]), 2424 case ets:lookup(Table, Id) of 2425 [Clocks0] -> 2426 ets:insert(Table, clocks_sum(Clocks, Clocks0, Id)); 2427 [] -> 2428 ets:insert(Table, Clocks) 2429 end. 2430 2431 2432 2433clocks_sum(#clocks{id = _Id1, 2434 cnt = Cnt1, 2435 own = Own1, 2436 acc = Acc1}, 2437 #clocks{id = _Id2, 2438 cnt = Cnt2, 2439 own = Own2, 2440 acc = Acc2}, 2441 Id) -> 2442 #clocks{id = Id, 2443 cnt = Cnt1 + Cnt2, 2444 own = Own1 + Own2, 2445 acc = Acc1 + Acc2}. 2446 2447 2448 2449ts_sub({A, B, C} = _T, {A0, B0, C0} = _T0) -> 2450 X = ((((A-A0)*1000000) + (B-B0))*1000000) + C - C0, 2451 if X >= 0 -> ok; 2452 true -> ?dbg(9, "Negative counter value ~p ~p ~p~n", 2453 [X, _T, _T0]) 2454 end, 2455 X; 2456ts_sub(_, _) -> 2457 undefined. 2458 2459 2460 2461%%%-------------------------------- 2462%%% Profile data analysis functions 2463%%%-------------------------------- 2464 2465 2466 2467do_analyse(Table, Analyse) -> 2468 ?dbg(5, "do_analyse_1(~p, ~p)~n", [Table, Analyse]), 2469 Result = 2470 try do_analyse_1(Table, Analyse) 2471 catch 2472 Error -> Error 2473 end, 2474 ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), 2475 Result. 2476 2477-dialyzer({no_improper_lists, do_analyse_1/2}). 2478 2479do_analyse_1(Table, 2480 #analyse{group_leader = GroupLeader, 2481 dest = Io, 2482 cols = Cols0, 2483 callers = PrintCallers, 2484 sort = Sort, 2485 totals = PrintTotals, 2486 details = PrintDetails} = _Analyse) -> 2487 Waste = 11, 2488 MinCols = Waste + 12, %% We need Width >= 1 2489 Cols = if Cols0 < MinCols -> MinCols; true -> Cols0 end, 2490 Width = (Cols-Waste) div 12, 2491 FnameWidth = Cols - Waste - 5*Width, 2492 Dest = {Io, [FnameWidth, Width, 2*Width, 2*Width]}, 2493 SortElement = case Sort of 2494 own -> 2495 #clocks.own; 2496 acc -> 2497 #clocks.acc 2498 end, 2499 %% 2500 %% Clean out the process dictionary before the next step 2501 %% 2502 _Erase = erase(), 2503 ?dbg(2, "erase() -> ~p~n", [_Erase]), 2504 %% 2505 %% Process the collected data and spread it to 3 places: 2506 %% * Per {process, caller, func}. Stored in the process dictionary. 2507 %% * Sum per process. Stored in an ets table. 2508 %% * Extra info per process. Stored in another ets table. 2509 %% 2510 io:format(GroupLeader, "Processing data...~n", []), 2511 PidTable = ets:new(?MODULE, [set, private, {keypos, #clocks.id}]), 2512 ProcTable = ets:new(?MODULE, [set, private, {keypos, #proc.id}]), 2513 ets_select_foreach( 2514 Table, [{'_', [], ['$_']}], 100, 2515 fun (#clocks{id = {Pid, Caller, Func}} = Clocks) -> 2516 case PrintDetails of 2517 true -> 2518 funcstat_pd(Pid, Caller, Func, Clocks), 2519 clocks_add(PidTable, Clocks#clocks{id = Pid}); 2520 false -> 2521 ok 2522 end, 2523 clocks_add(PidTable, Clocks#clocks{id = totals}), 2524 case PrintTotals of 2525 true -> 2526 funcstat_pd(totals, Caller, Func, Clocks); 2527 false -> 2528 ok 2529 end; 2530 (#proc{} = Proc) -> 2531 ets:insert(ProcTable, Proc); 2532 (#misc{} = Misc) -> 2533 ets:insert(ProcTable, Misc) 2534 end), 2535 ?dbg(3, "get() -> ~p~n", [get()]), 2536 {FirstTS, LastTS, _TraceCnt} = 2537 case {ets:lookup(ProcTable, first_ts), 2538 ets:lookup(ProcTable, last_ts_n)} of 2539 {[#misc{data = FTS}], [#misc{data = {LTS, TC}}]} 2540 when FTS =/= undefined, LTS =/= undefined -> 2541 {FTS, LTS, TC}; 2542 _ -> 2543 throw({error,empty_trace}) 2544 end, 2545 Totals0 = 2546 case ets:lookup(PidTable, totals) of 2547 [T0] -> 2548 ets:delete(PidTable, totals), 2549 T0; 2550 _ -> 2551 throw({error,empty_trace}) 2552 end, 2553 Totals = Totals0#clocks{acc = ts_sub(LastTS, FirstTS)}, 2554 ?dbg(3, "Totals0 = ~p~n", [Totals0]), 2555 ?dbg(3, "PidTable = ~p~n", [ets:tab2list(PidTable)]), 2556 ?dbg(3, "ProcTable = ~p~n", [ets:tab2list(ProcTable)]), 2557 ?dbg(4, "Totals = ~p~n", [Totals]), 2558 %% 2559 %% Reorganize the process dictionary by Pid. 2560 %% 2561 lists:foreach( 2562 fun ({{Pid, _Func}, Funcstat}) -> 2563 put(Pid, [Funcstat | case get(Pid) of 2564 undefined -> []; 2565 Other -> Other 2566 end]) 2567 end, 2568 erase()), 2569 ?dbg(4, "get() -> ~p~n", [get()]), 2570 %% 2571 %% Sort the processes 2572 %% 2573 PidSorted = 2574 postsort_r( 2575 lists:sort( 2576 ets:select(PidTable, 2577 [{'_', [], [[{element, #clocks.own, '$_'} | '$_']]}]))), 2578 ?dbg(4, "PidSorted = ~p~n", [PidSorted]), 2579 %% 2580 %% Print the functions per process 2581 %% 2582 io:format(GroupLeader, "Creating output...~n", []), 2583 println(Dest, "%% ", [], "Analysis results:", ""), 2584 println(Dest, "{ ", analysis_options, ",", ""), 2585 println(Dest, " [{", {callers, PrintCallers}, "},", ""), 2586 println(Dest, " {", {sort, Sort}, "},", ""), 2587 println(Dest, " {", {totals, PrintTotals}, "},", ""), 2588 println(Dest, " {", {details, PrintDetails}, "}]}.", ""), 2589 println(Dest), 2590 lists:foreach( 2591 fun ({#clocks{} = Clocks, ProcOrPid, FuncstatList}) -> 2592 println(Dest, "% ", head, "", ""), 2593 case ProcOrPid of 2594 #proc{} -> 2595 println(Dest, "[{ ", Clocks, "},", "%%"), 2596 print_proc(Dest, ProcOrPid); 2597 totals -> 2598 println(Dest, "[{ ", Clocks, "}].", "%%%"); 2599 _ when is_pid(ProcOrPid) -> 2600 println(Dest, "[{ ", Clocks, "}].", "%%") 2601 end, 2602 println(Dest), 2603 lists:foreach( 2604 fun (#funcstat{callers_sum = CallersSum, 2605% called_sum = CalledSum, 2606 callers = Callers, 2607 called = Called}) -> 2608 case {PrintCallers, Callers} of 2609% {true, []} -> 2610% ok; 2611 {true, _} -> 2612 print_callers(Dest, Callers), 2613 println(Dest, " { ", CallersSum, "},", "%"), 2614 print_called(Dest, Called), 2615 println(Dest); 2616 {false, _} -> 2617 println(Dest, "{ ", CallersSum, "}.", "") 2618 end, 2619 ok 2620 end, 2621 %% Sort the functions within the process, 2622 %% and the callers and called within the function. 2623 funcstat_sort_r(FuncstatList, SortElement)), 2624 println(Dest) 2625 end, 2626 %% Look up the processes in sorted order 2627 lists:map( 2628 fun (#clocks{id = Pid} = Clocks) -> 2629 Proc = case ets:lookup(ProcTable, Pid) of 2630 [] -> Pid; 2631 [ProcX] -> ProcX 2632 end, 2633 FuncstatList = 2634 case get(Pid) of 2635 undefined -> 2636 []; 2637 FL -> 2638 FL 2639 end, 2640 {Clocks, Proc, FuncstatList} 2641 end, 2642 case PrintDetails of 2643 true -> 2644 [Totals | PidSorted]; 2645 false -> 2646 [Totals] 2647 end)), 2648 %% 2649 %% Cleanup 2650 %% 2651 ets:delete(PidTable), 2652 ets:delete(ProcTable), 2653 io:format(GroupLeader, "Done!~n", []), 2654 ok. 2655 2656 2657 2658%%---------------------------- 2659%% Analysis printout functions 2660%%---------------------------- 2661 2662 2663 2664print_proc({undefined, _}, _) -> 2665 ok; 2666print_proc(Dest, 2667 #proc{id = _Pid, 2668 parent = Parent, 2669 spawned_as = SpawnedAs, 2670 init_log = InitLog}) -> 2671 case {Parent, SpawnedAs, InitLog} of 2672 {undefined, undefined, []} -> 2673 println(Dest, " ", [], "].", ""); 2674 {_, undefined, []} -> 2675 println(Dest, " { ", {spawned_by, parsify(Parent)}, "}].", ""); 2676 _ -> 2677 println(Dest, " { ", {spawned_by, parsify(Parent)}, "},", ""), 2678 case {SpawnedAs, InitLog} of 2679 {_, []} -> 2680 println(Dest, " { ", 2681 {spawned_as, SpawnedAs}, 2682 "}].", ""); 2683 {undefined, _} -> 2684 println(Dest, " { ", 2685 {initial_calls, lists:reverse(InitLog)}, 2686 "}].", ""); 2687 _ -> 2688 println(Dest, " { ", 2689 {spawned_as, SpawnedAs}, 2690 "},", ""), 2691 println(Dest, " { ", 2692 {initial_calls, lists:reverse(InitLog)}, 2693 "}].", "") 2694 end 2695 end. 2696 2697 2698 2699print_callers(Dest, []) -> 2700 println(Dest, "{[", [], "],", ""); 2701print_callers(Dest, [Clocks]) -> 2702 println(Dest, "{[{", Clocks, "}],", ""); 2703print_callers(Dest, [Clocks | Tail]) -> 2704 println(Dest, "{[{", Clocks, "},", ""), 2705 print_callers_1(Dest, Tail). 2706 2707print_callers_1(Dest, [Clocks]) -> 2708 println(Dest, " {", Clocks, "}],", ""); 2709print_callers_1(Dest, [Clocks | Tail]) -> 2710 println(Dest, " {", Clocks, "},", ""), 2711 print_callers_1(Dest, Tail). 2712 2713 2714 2715print_func(Dest, Clocks) -> 2716 println(Dest, " { ", Clocks, "},", "%"). 2717 2718 2719 2720print_called(Dest, []) -> 2721 println(Dest, " [", [], "]}.", ""); 2722print_called(Dest, [Clocks]) -> 2723 println(Dest, " [{", Clocks, "}]}.", ""); 2724print_called(Dest, [Clocks | Tail]) -> 2725 println(Dest, " [{", Clocks, "},", ""), 2726 print_called_1(Dest, Tail). 2727 2728print_called_1(Dest, [Clocks]) -> 2729 println(Dest, " {", Clocks, "}]}.", ""); 2730print_called_1(Dest, [Clocks | Tail]) -> 2731 println(Dest, " {", Clocks, "},", ""), 2732 print_called_1(Dest, Tail). 2733 2734 2735 2736println({undefined, _}) -> 2737 ok; 2738println({Io, _}) -> 2739 io:nl(Io). 2740 2741println({undefined, _}, _Head, 2742 _, 2743 _Tail, _Comment) -> 2744 ok; 2745println({Io, [W1, W2, W3, W4]}, Head, 2746 #clocks{id = Pid, cnt = Cnt, acc = _, own = Own}, 2747 Tail, Comment) when is_pid(Pid) -> 2748 io:put_chars(Io, 2749 [pad(Head, $ , 3), 2750 flat_format(parsify(Pid), $,, W1), 2751 flat_format(Cnt, $,, W2, right), 2752 flat_format(undefined, $,, W3, right), 2753 flat_format(Own*0.001, [], W4-1, right), 2754 pad(Tail, $ , 4), 2755 pad($ , Comment, 4), 2756 io_lib:nl()]); 2757println({Io, [W1, W2, W3, W4]}, Head, 2758 #clocks{id = {_M, _F, _A} = Func, cnt = Cnt, acc = Acc, own = Own}, 2759 Tail, Comment) -> 2760 io:put_chars(Io, 2761 [pad(Head, $ , 3), 2762 flat_format(Func, $,, W1), 2763 flat_format(Cnt, $,, W2, right), 2764 flat_format(Acc*0.001, $,, W3, right), 2765 flat_format(Own*0.001, [], W4-1, right), 2766 pad(Tail, $ , 4), 2767 pad($ , Comment, 4), 2768 io_lib:nl()]); 2769println({Io, [W1, W2, W3, W4]}, Head, 2770 #clocks{id = Id, cnt = Cnt, acc = Acc, own = Own}, 2771 Tail, Comment) -> 2772 io:put_chars(Io, 2773 [pad(Head, $ , 3), 2774 flat_format(parsify(Id), $,, W1), 2775 flat_format(Cnt, $,, W2, right), 2776 flat_format(Acc*0.001, $,, W3, right), 2777 flat_format(Own*0.001, [], W4-1, right), 2778 pad(Tail, $ , 4), 2779 pad($ , Comment, 4), 2780 io_lib:nl()]); 2781println({Io, [W1, W2, W3, W4]}, Head, 2782 head, 2783 Tail, Comment) -> 2784 io:put_chars(Io, 2785 [pad(Head, $ , 3), 2786 pad(" ", $ , W1), 2787 pad($ , " CNT ", W2), 2788 pad($ , " ACC ", W3), 2789 pad($ , " OWN", W4-1), 2790 pad(Tail, $ , 4), 2791 pad($ , Comment, 4), 2792 io_lib:nl()]); 2793println({Io, _}, Head, 2794 [], 2795 Tail, Comment) -> 2796 io:format(Io, "~s~ts~ts~n", 2797 [pad(Head, $ , 3), Tail, Comment]); 2798println({Io, _}, Head, 2799 {Tag, Term}, 2800 Tail, Comment) -> 2801 io:format(Io, "~s~tp, ~tp~ts~ts~n", 2802 [pad(Head, $ , 3), parsify(Tag), parsify(Term), Tail, Comment]); 2803println({Io, _}, Head, 2804 Term, 2805 Tail, Comment) -> 2806 io:format(Io, "~s~tp~ts~ts~n", 2807 [pad(Head, $ , 3), parsify(Term), Tail, Comment]). 2808 2809 2810 2811%%%-------------------------- 2812%%% Sorting support functions 2813%%%-------------------------- 2814 2815 2816%% Add a Clocks record to the callers and called funcstat records 2817%% in the process dictionary. 2818%% 2819funcstat_pd(Pid, Func1, Func0, Clocks) -> 2820 put({Pid, Func0}, 2821 case get({Pid, Func0}) of 2822 undefined -> 2823 #funcstat{callers_sum = Clocks#clocks{id = Func0}, 2824 called_sum = #clocks{id = Func0}, 2825 callers = [Clocks#clocks{id = Func1}]}; 2826 #funcstat{callers_sum = CallersSum, 2827 callers = Callers} = FuncstatCallers -> 2828 FuncstatCallers#funcstat{ 2829 callers_sum = clocks_sum(CallersSum, Clocks, Func0), 2830 callers = insert_call(Clocks, Func1, Callers)} 2831 end), 2832 put({Pid, Func1}, 2833 case get({Pid, Func1}) of 2834 undefined -> 2835 #funcstat{callers_sum = #clocks{id = Func1}, 2836 called_sum = Clocks#clocks{id = Func1}, 2837 called = [Clocks#clocks{id = Func0}]}; 2838 #funcstat{called_sum = CalledSum, 2839 called = Called} = FuncstatCalled -> 2840 FuncstatCalled#funcstat{ 2841 called_sum = clocks_sum(CalledSum, Clocks, Func1), 2842 called = insert_call(Clocks, Func0, Called)} 2843 end). 2844 2845insert_call(Clocks, Func, ClocksList) -> 2846 insert_call(Clocks, Func, ClocksList, []). 2847 2848insert_call(Clocks, Func, [#clocks{id = Func} = C | T], Acc) -> 2849 [clocks_sum(C, Clocks, Func) | T ++ Acc]; 2850insert_call(Clocks, Func, [H | T], Acc) -> 2851 insert_call(Clocks, Func, T, [H | Acc]); 2852insert_call(Clocks, Func, [], Acc) -> 2853 [Clocks#clocks{id = Func} | Acc]. 2854 2855 2856 2857%% Sort a list of funcstat records, 2858%% and sort the callers and called lists within the funcstat record. 2859funcstat_sort_r(FuncstatList, Element) -> 2860 funcstat_sort_r_1(FuncstatList, Element, []). 2861 2862-dialyzer({no_improper_lists, funcstat_sort_r_1/3}). 2863 2864funcstat_sort_r_1([], _, R) -> 2865 postsort_r(lists:sort(R)); 2866funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, 2867 callers = Callers, 2868 called = Called} = Funcstat 2869 | L], 2870 Element, 2871 R) -> 2872 funcstat_sort_r_1(L, 2873 Element, 2874 [[element(Element, Clocks) 2875 |Funcstat#funcstat{ 2876 callers = clocks_sort_r(Callers, Element), 2877 called = clocks_sort_r(Called, Element)}] 2878 | R]). 2879 2880 2881 2882%% Sort a list of clocks records. 2883clocks_sort_r(L, E) -> 2884 clocks_sort_r_1(L, E, []). 2885 2886-dialyzer({no_improper_lists, clocks_sort_r_1/3}). 2887 2888clocks_sort_r_1([], _, R) -> 2889 postsort_r(lists:sort(R)); 2890clocks_sort_r_1([#clocks{} = C | L], E, R) -> 2891 clocks_sort_r_1(L, E, [[element(E, C)|C] | R]). 2892 2893 2894%% Take a list of terms with sort headers and strip the headers. 2895postsort_r(L) -> 2896 postsort_r(L, []). 2897 2898postsort_r([], R) -> 2899 R; 2900postsort_r([[_|C] | L], R) -> 2901 postsort_r(L, [C | R]). 2902 2903 2904 2905%%%---------------------------------------------------------------------- 2906%%% Fairly generic support functions 2907%%% 2908 2909%% Standard format and flatten. 2910flat_format(F, Trailer) when is_float(F) -> 2911 lists:flatten([io_lib:format("~.3f", [F]), Trailer]); 2912flat_format(W, Trailer) -> 2913 lists:flatten([io_lib:format("~tp", [W]), Trailer]). 2914 2915%% Format, flatten, and pad. 2916flat_format(Term, Trailer, Width) -> 2917 flat_format(Term, Trailer, Width, left). 2918 2919flat_format(Term, Trailer, Width, left) -> 2920 flat_format(Term, Trailer, Width, {left, $ }); 2921flat_format(Term, Trailer, Width, {left, Filler}) -> 2922 pad(flat_format(Term, Trailer), Filler, Width); 2923flat_format(Term, Trailer, Width, right) -> 2924 flat_format(Term, Trailer, Width, {right, $ }); 2925flat_format(Term, Trailer, Width, {right, Filler}) -> 2926 pad(Filler, flat_format(Term, Trailer), Width). 2927 2928 2929 2930%% Left pad a string using a given char. 2931pad(Char, L, Size) when is_integer(Char), is_list(L), is_integer(Size) -> 2932 List = lists:flatten(L), 2933 Length = length(List), 2934 if Length >= Size -> 2935 List; 2936 true -> 2937 lists:append(lists:duplicate(Size - Length, Char), List) 2938 end; 2939%% Right pad a string using a given char. 2940pad(L, Char, Size) when is_list(L), is_integer(Char), is_integer(Size) -> 2941 List = lists:flatten(L), 2942 Length = length(List), 2943 if Length >= Size -> 2944 List; 2945 true -> 2946 lists:append(List, lists:duplicate(Size - Length, Char)) 2947 end. 2948 2949 2950 2951ets_select_foreach(Table, MatchSpec, Limit, Fun) -> 2952 ets:safe_fixtable(Table, true), 2953 ets_select_foreach_1(ets:select(Table, MatchSpec, Limit), Fun). 2954 2955ets_select_foreach_1('$end_of_table', _) -> 2956 ok; 2957ets_select_foreach_1({Matches, Continuation}, Fun) -> 2958 ?dbg(2, "Matches = ~p~n", [Matches]), 2959 lists:foreach(Fun, Matches), 2960 ets_select_foreach_1(ets:select(Continuation), Fun). 2961 2962 2963 2964%% Converts the parts of a deep term that are not parasable when printed 2965%% with io:format() into their string representation. 2966parsify([]) -> 2967 []; 2968parsify([Hd | Tl]) -> 2969 [parsify(Hd) | parsify(Tl)]; 2970parsify({A, B}) -> 2971 {parsify(A), parsify(B)}; 2972parsify({A, B, C}) -> 2973 {parsify(A), parsify(B), parsify(C)}; 2974parsify(Tuple) when is_tuple(Tuple) -> 2975 list_to_tuple(parsify(tuple_to_list(Tuple))); 2976parsify(Map) when is_map(Map) -> 2977 maps:from_list(parsify(maps:to_list(Map))); 2978parsify(Pid) when is_pid(Pid) -> 2979 erlang:pid_to_list(Pid); 2980parsify(Port) when is_port(Port) -> 2981 erlang:port_to_list(Port); 2982parsify(Ref) when is_reference(Ref) -> 2983 erlang:ref_to_list(Ref); 2984parsify(Fun) when is_function(Fun) -> 2985 erlang:fun_to_list(Fun); 2986parsify(Term) -> 2987 Term. 2988 2989 2990 2991%% A simple loop construct. 2992%% 2993%% Calls 'Fun' with argument 'Start' first and then repeatedly with 2994%% its returned value (state) until 'Fun' returns 'Stop'. Then 2995%% the last state value that was not 'Stop' is returned. 2996 2997% iterate(Start, Done, Fun) when is_function(Fun) -> 2998% iterate(Start, Done, Fun, Start). 2999 3000% iterate(Done, Done, Fun, I) -> 3001% I; 3002% iterate(I, Done, Fun, _) -> 3003% iterate(Fun(I), Done, Fun, I). 3004