| OLD | NEW |
| 1 #! /usr/bin/env perl | 1 #! /usr/bin/env perl |
| 2 | 2 |
| 3 # Copyright (c) 1998-2007, Google Inc. | 3 # Copyright (c) 1998-2007, Google Inc. |
| 4 # All rights reserved. | 4 # All rights reserved. |
| 5 # | 5 # |
| 6 # Redistribution and use in source and binary forms, with or without | 6 # Redistribution and use in source and binary forms, with or without |
| 7 # modification, are permitted provided that the following conditions are | 7 # modification, are permitted provided that the following conditions are |
| 8 # met: | 8 # met: |
| 9 # | 9 # |
| 10 # * Redistributions of source code must retain the above copyright | 10 # * Redistributions of source code must retain the above copyright |
| (...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 65 # Generates disassembly listing of all routines with at least one | 65 # Generates disassembly listing of all routines with at least one |
| 66 # sample that match the --disasm=<regexp> pattern. The listing is | 66 # sample that match the --disasm=<regexp> pattern. The listing is |
| 67 # annotated with the flat and cumulative sample counts at each PC value. | 67 # annotated with the flat and cumulative sample counts at each PC value. |
| 68 # | 68 # |
| 69 # TODO: Use color to indicate files? | 69 # TODO: Use color to indicate files? |
| 70 | 70 |
| 71 use strict; | 71 use strict; |
| 72 use warnings; | 72 use warnings; |
| 73 use Getopt::Long; | 73 use Getopt::Long; |
| 74 | 74 |
| 75 my $PPROF_VERSION = "2.0"; | 75 my $PPROF_VERSION = "1.7"; |
| 76 | 76 |
| 77 # These are the object tools we use which can come from a | 77 # These are the object tools we use which can come from a |
| 78 # user-specified location using --tools, from the PPROF_TOOLS | 78 # user-specified location using --tools, from the PPROF_TOOLS |
| 79 # environment variable, or from the environment. | 79 # environment variable, or from the environment. |
| 80 my %obj_tool_map = ( | 80 my %obj_tool_map = ( |
| 81 "objdump" => "objdump", | 81 "objdump" => "objdump", |
| 82 "nm" => "nm", | 82 "nm" => "nm", |
| 83 "addr2line" => "addr2line", | 83 "addr2line" => "addr2line", |
| 84 "c++filt" => "c++filt", | 84 "c++filt" => "c++filt", |
| 85 ## ConfigureObjTools may add architecture-specific entries: | 85 ## ConfigureObjTools may add architecture-specific entries: |
| 86 #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables | 86 #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables |
| 87 #"addr2line_pdb" => "addr2line-pdb", # ditto | 87 #"addr2line_pdb" => "addr2line-pdb", # ditto |
| 88 #"otool" => "otool", # equivalent of objdump on OS X | 88 #"otool" => "otool", # equivalent of objdump on OS X |
| 89 ); | 89 ); |
| 90 # NOTE: these are lists, so you can put in commandline flags if you want. | 90 my $DOT = "dot"; # leave non-absolute, since it may be in /usr/local |
| 91 my @DOT = ("dot"); # leave non-absolute, since it may be in /usr/local | 91 my $GV = "gv"; |
| 92 my @GV = ("gv"); | 92 my $EVINCE = "evince"; # could also be xpdf or perhaps acroread |
| 93 my @EVINCE = ("evince"); # could also be xpdf or perhaps acroread | 93 my $KCACHEGRIND = "kcachegrind"; |
| 94 my @KCACHEGRIND = ("kcachegrind"); | 94 my $PS2PDF = "ps2pdf"; |
| 95 my @PS2PDF = ("ps2pdf"); | |
| 96 # These are used for dynamic profiles | 95 # These are used for dynamic profiles |
| 97 my @URL_FETCHER = ("curl", "-s"); | 96 my $URL_FETCHER = "curl -s"; |
| 98 | 97 |
| 99 # These are the web pages that servers need to support for dynamic profiles | 98 # These are the web pages that servers need to support for dynamic profiles |
| 100 my $HEAP_PAGE = "/pprof/heap"; | 99 my $HEAP_PAGE = "/pprof/heap"; |
| 101 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" | 100 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" |
| 102 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param | 101 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param |
| 103 # ?seconds=#&event=x&period=n | 102 # ?seconds=#&event=x&period=n |
| 104 my $GROWTH_PAGE = "/pprof/growth"; | 103 my $GROWTH_PAGE = "/pprof/growth"; |
| 105 my $CONTENTION_PAGE = "/pprof/contention"; | 104 my $CONTENTION_PAGE = "/pprof/contention"; |
| 106 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter | 105 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter |
| 107 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; | 106 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; |
| 108 my $CENSUSPROFILE_PAGE = "/pprof/censusprofile(?:\\?.*)?"; # must support cgi-pa
ram | 107 my $CENSUSPROFILE_PAGE = "/pprof/censusprofile"; # must support "?seconds=#" |
| 109 # "?seconds=#", | |
| 110 # "?tags_regexp=#" and | |
| 111 # "?type=#". | |
| 112 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST | 108 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST |
| 113 my $PROGRAM_NAME_PAGE = "/pprof/cmdline"; | 109 my $PROGRAM_NAME_PAGE = "/pprof/cmdline"; |
| 114 | 110 |
| 115 # These are the web pages that can be named on the command line. | 111 # These are the web pages that can be named on the command line. |
| 116 # All the alternatives must begin with /. | 112 # All the alternatives must begin with /. |
| 117 my $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" . | 113 my $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" . |
| 118 "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" . | 114 "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" . |
| 119 "$FILTEREDPROFILE_PAGE|$CENSUSPROFILE_PAGE)"; | 115 "$FILTEREDPROFILE_PAGE|$CENSUSPROFILE_PAGE)"; |
| 120 | 116 |
| 121 # default binary name | 117 # default binary name |
| (...skipping 31 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 153 pprof [options] <profile> | 149 pprof [options] <profile> |
| 154 <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE | 150 <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE |
| 155 | 151 |
| 156 Each name can be: | 152 Each name can be: |
| 157 /path/to/profile - a path to a profile file | 153 /path/to/profile - a path to a profile file |
| 158 host:port[/<service>] - a location of a service to get profile from | 154 host:port[/<service>] - a location of a service to get profile from |
| 159 | 155 |
| 160 The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, | 156 The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, |
| 161 $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, | 157 $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, |
| 162 $CENSUSPROFILE_PAGE, or /pprof/filteredprofile. | 158 $CENSUSPROFILE_PAGE, or /pprof/filteredprofile. |
| 163 For instance: | 159 For instance: "pprof http://myserver.com:80$HEAP_PAGE". |
| 164 pprof http://myserver.com:80$HEAP_PAGE | |
| 165 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin
g). | 160 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin
g). |
| 166 pprof --symbols <program> | 161 pprof --symbols <program> |
| 167 Maps addresses to symbol names. In this mode, stdin should be a | 162 Maps addresses to symbol names. In this mode, stdin should be a |
| 168 list of library mappings, in the same format as is found in the heap- | 163 list of library mappings, in the same format as is found in the heap- |
| 169 and cpu-profile files (this loosely matches that of /proc/self/maps | 164 and cpu-profile files (this loosely matches that of /proc/self/maps |
| 170 on linux), followed by a list of hex addresses to map, one per line. | 165 on linux), followed by a list of hex addresses to map, one per line. |
| 171 | 166 |
| 172 For more help with querying remote servers, including how to add the | 167 For more help with querying remote servers, including how to add the |
| 173 necessary server-side support code, see this filename (or one like it): | 168 necessary server-side support code, see this filename (or one like it): |
| 174 | 169 |
| 175 /usr/doc/gperftools-$PPROF_VERSION/pprof_remote_servers.html | 170 /usr/doc/google-perftools-$PPROF_VERSION/pprof_remote_servers.html |
| 176 | 171 |
| 177 Options: | 172 Options: |
| 178 --cum Sort by cumulative data | 173 --cum Sort by cumulative data |
| 179 --base=<base> Subtract <base> from <profile> before display | 174 --base=<base> Subtract <base> from <profile> before display |
| 180 --interactive Run in interactive mode (interactive "help" gives help) [
default] | 175 --interactive Run in interactive mode (interactive "help" gives help) [
default] |
| 181 --seconds=<n> Length of time for dynamic profiles [default=30 secs] | 176 --seconds=<n> Length of time for dynamic profiles [default=30 secs] |
| 182 --add_lib=<file> Read additional symbols and line info from the given libr
ary | 177 --add_lib=<file> Read additional symbols and line info from the given libr
ary |
| 183 --lib_prefix=<dir> Comma separated list of library path prefixes | 178 --lib_prefix=<dir> Comma separated list of library path prefixes |
| 184 | 179 |
| 185 Reporting Granularity: | 180 Reporting Granularity: |
| (...skipping 77 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 263 Outputs one line per procedure for localhost:1234 | 258 Outputs one line per procedure for localhost:1234 |
| 264 pprof --raw localhost:1234 > ./local.raw | 259 pprof --raw localhost:1234 > ./local.raw |
| 265 pprof --text ./local.raw | 260 pprof --text ./local.raw |
| 266 Fetches a remote profile for later analysis and then | 261 Fetches a remote profile for later analysis and then |
| 267 analyzes it in text mode. | 262 analyzes it in text mode. |
| 268 EOF | 263 EOF |
| 269 } | 264 } |
| 270 | 265 |
| 271 sub version_string { | 266 sub version_string { |
| 272 return <<EOF | 267 return <<EOF |
| 273 pprof (part of gperftools $PPROF_VERSION) | 268 pprof (part of google-perftools $PPROF_VERSION) |
| 274 | 269 |
| 275 Copyright 1998-2007 Google Inc. | 270 Copyright 1998-2007 Google Inc. |
| 276 | 271 |
| 277 This is BSD licensed software; see the source for copying conditions | 272 This is BSD licensed software; see the source for copying conditions |
| 278 and license information. | 273 and license information. |
| 279 There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A | 274 There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A |
| 280 PARTICULAR PURPOSE. | 275 PARTICULAR PURPOSE. |
| 281 EOF | 276 EOF |
| 282 } | 277 } |
| 283 | 278 |
| (...skipping 211 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 495 RunUnitTests(); | 490 RunUnitTests(); |
| 496 # Should not return | 491 # Should not return |
| 497 exit(1); | 492 exit(1); |
| 498 } | 493 } |
| 499 | 494 |
| 500 # Binary name and profile arguments list | 495 # Binary name and profile arguments list |
| 501 $main::prog = ""; | 496 $main::prog = ""; |
| 502 @main::pfile_args = (); | 497 @main::pfile_args = (); |
| 503 | 498 |
| 504 # Remote profiling without a binary (using $SYMBOL_PAGE instead) | 499 # Remote profiling without a binary (using $SYMBOL_PAGE instead) |
| 505 if (@ARGV > 0) { | 500 if (IsProfileURL($ARGV[0])) { |
| 506 if (IsProfileURL($ARGV[0])) { | 501 $main::use_symbol_page = 1; |
| 507 $main::use_symbol_page = 1; | 502 } elsif (IsSymbolizedProfileFile($ARGV[0])) { |
| 508 } elsif (IsSymbolizedProfileFile($ARGV[0])) { | 503 $main::use_symbolized_profile = 1; |
| 509 $main::use_symbolized_profile = 1; | 504 $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file |
| 510 $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file | |
| 511 } | |
| 512 } | 505 } |
| 513 | 506 |
| 514 if ($main::use_symbol_page || $main::use_symbolized_profile) { | 507 if ($main::use_symbol_page || $main::use_symbolized_profile) { |
| 515 # We don't need a binary! | 508 # We don't need a binary! |
| 516 my %disabled = ('--lines' => $main::opt_lines, | 509 my %disabled = ('--lines' => $main::opt_lines, |
| 517 '--disasm' => $main::opt_disasm); | 510 '--disasm' => $main::opt_disasm); |
| 518 for my $option (keys %disabled) { | 511 for my $option (keys %disabled) { |
| 519 usage("$option cannot be used without a binary") if $disabled{$option}; | 512 usage("$option cannot be used without a binary") if $disabled{$option}; |
| 520 } | 513 } |
| 521 # Set $main::prog later... | 514 # Set $main::prog later... |
| (...skipping 23 matching lines...) Expand all Loading... |
| 545 if ($main::use_symbol_page) { | 538 if ($main::use_symbol_page) { |
| 546 unless (IsProfileURL($main::pfile_args[0])) { | 539 unless (IsProfileURL($main::pfile_args[0])) { |
| 547 error("The first profile should be a remote form to use $SYMBOL_PAGE\n"); | 540 error("The first profile should be a remote form to use $SYMBOL_PAGE\n"); |
| 548 } | 541 } |
| 549 CheckSymbolPage(); | 542 CheckSymbolPage(); |
| 550 $main::prog = FetchProgramName(); | 543 $main::prog = FetchProgramName(); |
| 551 } elsif (!$main::use_symbolized_profile) { # may not need objtools! | 544 } elsif (!$main::use_symbolized_profile) { # may not need objtools! |
| 552 ConfigureObjTools($main::prog) | 545 ConfigureObjTools($main::prog) |
| 553 } | 546 } |
| 554 | 547 |
| 555 # Break the opt_lib_prefix into the prefix_list array | 548 # Break the opt_list_prefix into the prefix_list array |
| 556 @prefix_list = split (',', $main::opt_lib_prefix); | 549 @prefix_list = split (',', $main::opt_lib_prefix); |
| 557 | 550 |
| 558 # Remove trailing / from the prefixes, in the list to prevent | 551 # Remove trailing / from the prefixes, in the list to prevent |
| 559 # searching things like /my/path//lib/mylib.so | 552 # searching things like /my/path//lib/mylib.so |
| 560 foreach (@prefix_list) { | 553 foreach (@prefix_list) { |
| 561 s|/+$||; | 554 s|/+$||; |
| 562 } | 555 } |
| 563 } | 556 } |
| 564 | 557 |
| 565 sub Main() { | 558 sub Main() { |
| (...skipping 77 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 643 | 636 |
| 644 # Get derived profiles | 637 # Get derived profiles |
| 645 my $flat = FlatProfile($reduced); | 638 my $flat = FlatProfile($reduced); |
| 646 my $cumulative = CumulativeProfile($reduced); | 639 my $cumulative = CumulativeProfile($reduced); |
| 647 | 640 |
| 648 # Print | 641 # Print |
| 649 if (!$main::opt_interactive) { | 642 if (!$main::opt_interactive) { |
| 650 if ($main::opt_disasm) { | 643 if ($main::opt_disasm) { |
| 651 PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm); | 644 PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm); |
| 652 } elsif ($main::opt_list) { | 645 } elsif ($main::opt_list) { |
| 653 PrintListing($total, $libs, $flat, $cumulative, $main::opt_list, 0); | 646 PrintListing($libs, $flat, $cumulative, $main::opt_list); |
| 654 } elsif ($main::opt_text) { | 647 } elsif ($main::opt_text) { |
| 655 # Make sure the output is empty when have nothing to report | 648 # Make sure the output is empty when have nothing to report |
| 656 # (only matters when --heapcheck is given but we must be | 649 # (only matters when --heapcheck is given but we must be |
| 657 # compatible with old branches that did not pass --heapcheck always): | 650 # compatible with old branches that did not pass --heapcheck always): |
| 658 if ($total != 0) { | 651 if ($total != 0) { |
| 659 printf("Total: %s %s\n", Unparse($total), Units()); | 652 printf("Total: %s %s\n", Unparse($total), Units()); |
| 660 } | 653 } |
| 661 PrintText($symbols, $flat, $cumulative, -1); | 654 PrintText($symbols, $flat, $cumulative, -1); |
| 662 } elsif ($main::opt_raw) { | 655 } elsif ($main::opt_raw) { |
| 663 PrintSymbolizedProfile($symbols, $profile, $main::prog); | 656 PrintSymbolizedProfile($symbols, $profile, $main::prog); |
| 664 } elsif ($main::opt_callgrind) { | 657 } elsif ($main::opt_callgrind) { |
| 665 PrintCallgrind($calls); | 658 PrintCallgrind($calls); |
| 666 } else { | 659 } else { |
| 667 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total))
{ | 660 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total))
{ |
| 668 if ($main::opt_gv) { | 661 if ($main::opt_gv) { |
| 669 RunGV(TempName($main::next_tmpfile, "ps"), ""); | 662 RunGV(TempName($main::next_tmpfile, "ps"), ""); |
| 670 } elsif ($main::opt_evince) { | 663 } elsif ($main::opt_evince) { |
| 671 RunEvince(TempName($main::next_tmpfile, "pdf"), ""); | 664 » RunEvince(TempName($main::next_tmpfile, "pdf"), ""); |
| 672 } elsif ($main::opt_web) { | 665 } elsif ($main::opt_web) { |
| 673 my $tmp = TempName($main::next_tmpfile, "svg"); | 666 my $tmp = TempName($main::next_tmpfile, "svg"); |
| 674 RunWeb($tmp); | 667 RunWeb($tmp); |
| 675 # The command we run might hand the file name off | 668 # The command we run might hand the file name off |
| 676 # to an already running browser instance and then exit. | 669 # to an already running browser instance and then exit. |
| 677 # Normally, we'd remove $tmp on exit (right now), | 670 # Normally, we'd remove $tmp on exit (right now), |
| 678 # but fork a child to remove $tmp a little later, so that the | 671 # but fork a child to remove $tmp a little later, so that the |
| 679 # browser has time to load it first. | 672 # browser has time to load it first. |
| 680 delete $main::tempnames{$tmp}; | 673 delete $main::tempnames{$tmp}; |
| 681 if (fork() == 0) { | 674 if (fork() == 0) { |
| (...skipping 28 matching lines...) Expand all Loading... |
| 710 if (-e '/lib/libtermcap.so.2') { | 703 if (-e '/lib/libtermcap.so.2') { |
| 711 return 0; # libtermcap exists, so readline should be okay | 704 return 0; # libtermcap exists, so readline should be okay |
| 712 } else { | 705 } else { |
| 713 return 1; | 706 return 1; |
| 714 } | 707 } |
| 715 } | 708 } |
| 716 | 709 |
| 717 sub RunGV { | 710 sub RunGV { |
| 718 my $fname = shift; | 711 my $fname = shift; |
| 719 my $bg = shift; # "" or " &" if we should run in background | 712 my $bg = shift; # "" or " &" if we should run in background |
| 720 if (!system(ShellEscape(@GV, "--version") . " >$dev_null 2>&1")) { | 713 if (!system("$GV --version >$dev_null 2>&1")) { |
| 721 # Options using double dash are supported by this gv version. | 714 # Options using double dash are supported by this gv version. |
| 722 # Also, turn on noantialias to better handle bug in gv for | 715 # Also, turn on noantialias to better handle bug in gv for |
| 723 # postscript files with large dimensions. | 716 # postscript files with large dimensions. |
| 724 # TODO: Maybe we should not pass the --noantialias flag | 717 # TODO: Maybe we should not pass the --noantialias flag |
| 725 # if the gv version is known to work properly without the flag. | 718 # if the gv version is known to work properly without the flag. |
| 726 system(ShellEscape(@GV, "--scale=$main::opt_scale", "--noantialias", $fname) | 719 system("$GV --scale=$main::opt_scale --noantialias " . $fname . $bg); |
| 727 . $bg); | |
| 728 } else { | 720 } else { |
| 729 # Old gv version - only supports options that use single dash. | 721 # Old gv version - only supports options that use single dash. |
| 730 print STDERR ShellEscape(@GV, "-scale", $main::opt_scale) . "\n"; | 722 print STDERR "$GV -scale $main::opt_scale\n"; |
| 731 system(ShellEscape(@GV, "-scale", "$main::opt_scale", $fname) . $bg); | 723 system("$GV -scale $main::opt_scale " . $fname . $bg); |
| 732 } | 724 } |
| 733 } | 725 } |
| 734 | 726 |
| 735 sub RunEvince { | 727 sub RunEvince { |
| 736 my $fname = shift; | 728 my $fname = shift; |
| 737 my $bg = shift; # "" or " &" if we should run in background | 729 my $bg = shift; # "" or " &" if we should run in background |
| 738 system(ShellEscape(@EVINCE, $fname) . $bg); | 730 system("$EVINCE " . $fname . $bg); |
| 739 } | 731 } |
| 740 | 732 |
| 741 sub RunWeb { | 733 sub RunWeb { |
| 742 my $fname = shift; | 734 my $fname = shift; |
| 743 print STDERR "Loading web page file:///$fname\n"; | 735 print STDERR "Loading web page file:///$fname\n"; |
| 744 | 736 |
| 745 if (`uname` =~ /Darwin/) { | 737 if (`uname` =~ /Darwin/) { |
| 746 # OS X: open will use standard preference for SVG files. | 738 # OS X: open will use standard preference for SVG files. |
| 747 system("/usr/bin/open", $fname); | 739 system("/usr/bin/open", $fname); |
| 748 return; | 740 return; |
| (...skipping 13 matching lines...) Expand all Loading... |
| 762 return; | 754 return; |
| 763 } | 755 } |
| 764 } | 756 } |
| 765 | 757 |
| 766 print STDERR "Could not load web browser.\n"; | 758 print STDERR "Could not load web browser.\n"; |
| 767 } | 759 } |
| 768 | 760 |
| 769 sub RunKcachegrind { | 761 sub RunKcachegrind { |
| 770 my $fname = shift; | 762 my $fname = shift; |
| 771 my $bg = shift; # "" or " &" if we should run in background | 763 my $bg = shift; # "" or " &" if we should run in background |
| 772 print STDERR "Starting '@KCACHEGRIND " . $fname . $bg . "'\n"; | 764 print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n"; |
| 773 system(ShellEscape(@KCACHEGRIND, $fname) . $bg); | 765 system("$KCACHEGRIND " . $fname . $bg); |
| 774 } | 766 } |
| 775 | 767 |
| 776 | 768 |
| 777 ##### Interactive helper routines ##### | 769 ##### Interactive helper routines ##### |
| 778 | 770 |
| 779 sub InteractiveMode { | 771 sub InteractiveMode { |
| 780 $| = 1; # Make output unbuffered for interactive mode | 772 $| = 1; # Make output unbuffered for interactive mode |
| 781 my ($orig_profile, $symbols, $libs, $total) = @_; | 773 my ($orig_profile, $symbols, $libs, $total) = @_; |
| 782 | 774 |
| 783 print STDERR "Welcome to pprof! For help, type 'help'.\n"; | 775 print STDERR "Welcome to pprof! For help, type 'help'.\n"; |
| (...skipping 56 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 840 | 832 |
| 841 if (m/^\s*(text|top)(\d*)\s*(.*)/) { | 833 if (m/^\s*(text|top)(\d*)\s*(.*)/) { |
| 842 $main::opt_text = 1; | 834 $main::opt_text = 1; |
| 843 | 835 |
| 844 my $line_limit = ($2 ne "") ? int($2) : 10; | 836 my $line_limit = ($2 ne "") ? int($2) : 10; |
| 845 | 837 |
| 846 my $routine; | 838 my $routine; |
| 847 my $ignore; | 839 my $ignore; |
| 848 ($routine, $ignore) = ParseInteractiveArgs($3); | 840 ($routine, $ignore) = ParseInteractiveArgs($3); |
| 849 | 841 |
| 850 my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); | 842 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); |
| 851 my $reduced = ReduceProfile($symbols, $profile); | 843 my $reduced = ReduceProfile($symbols, $profile); |
| 852 | 844 |
| 853 # Get derived profiles | 845 # Get derived profiles |
| 854 my $flat = FlatProfile($reduced); | 846 my $flat = FlatProfile($reduced); |
| 855 my $cumulative = CumulativeProfile($reduced); | 847 my $cumulative = CumulativeProfile($reduced); |
| 856 | 848 |
| 857 PrintText($symbols, $flat, $cumulative, $line_limit); | 849 PrintText($symbols, $flat, $cumulative, $line_limit); |
| 858 return 1; | 850 return 1; |
| 859 } | 851 } |
| 860 if (m/^\s*callgrind\s*([^ \n]*)/) { | 852 if (m/^\s*callgrind\s*([^ \n]*)/) { |
| 861 $main::opt_callgrind = 1; | 853 $main::opt_callgrind = 1; |
| 862 | 854 |
| 863 # Get derived profiles | 855 # Get derived profiles |
| 864 my $calls = ExtractCalls($symbols, $orig_profile); | 856 my $calls = ExtractCalls($symbols, $orig_profile); |
| 865 my $filename = $1; | 857 my $filename = $1; |
| 866 if ( $1 eq '' ) { | 858 if ( $1 eq '' ) { |
| 867 $filename = TempName($main::next_tmpfile, "callgrind"); | 859 $filename = TempName($main::next_tmpfile, "callgrind"); |
| 868 } | 860 } |
| 869 PrintCallgrind($calls, $filename); | 861 PrintCallgrind($calls, $filename); |
| 870 if ( $1 eq '' ) { | 862 if ( $1 eq '' ) { |
| 871 RunKcachegrind($filename, " & "); | 863 RunKcachegrind($filename, " & "); |
| 872 $main::next_tmpfile++; | 864 $main::next_tmpfile++; |
| 873 } | 865 } |
| 874 | 866 |
| 875 return 1; | 867 return 1; |
| 876 } | 868 } |
| 877 if (m/^\s*(web)?list\s*(.+)/) { | 869 if (m/^\s*list\s*(.+)/) { |
| 878 my $html = (defined($1) && ($1 eq "web")); | |
| 879 $main::opt_list = 1; | 870 $main::opt_list = 1; |
| 880 | 871 |
| 881 my $routine; | 872 my $routine; |
| 882 my $ignore; | 873 my $ignore; |
| 883 ($routine, $ignore) = ParseInteractiveArgs($2); | 874 ($routine, $ignore) = ParseInteractiveArgs($1); |
| 884 | 875 |
| 885 my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); | 876 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); |
| 886 my $reduced = ReduceProfile($symbols, $profile); | 877 my $reduced = ReduceProfile($symbols, $profile); |
| 887 | 878 |
| 888 # Get derived profiles | 879 # Get derived profiles |
| 889 my $flat = FlatProfile($reduced); | 880 my $flat = FlatProfile($reduced); |
| 890 my $cumulative = CumulativeProfile($reduced); | 881 my $cumulative = CumulativeProfile($reduced); |
| 891 | 882 |
| 892 PrintListing($total, $libs, $flat, $cumulative, $routine, $html); | 883 PrintListing($libs, $flat, $cumulative, $routine); |
| 893 return 1; | 884 return 1; |
| 894 } | 885 } |
| 895 if (m/^\s*disasm\s*(.+)/) { | 886 if (m/^\s*disasm\s*(.+)/) { |
| 896 $main::opt_disasm = 1; | 887 $main::opt_disasm = 1; |
| 897 | 888 |
| 898 my $routine; | 889 my $routine; |
| 899 my $ignore; | 890 my $ignore; |
| 900 ($routine, $ignore) = ParseInteractiveArgs($1); | 891 ($routine, $ignore) = ParseInteractiveArgs($1); |
| 901 | 892 |
| 902 # Process current profile to account for various settings | 893 # Process current profile to account for various settings |
| 903 my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); | 894 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); |
| 904 my $reduced = ReduceProfile($symbols, $profile); | 895 my $reduced = ReduceProfile($symbols, $profile); |
| 905 | 896 |
| 906 # Get derived profiles | 897 # Get derived profiles |
| 907 my $flat = FlatProfile($reduced); | 898 my $flat = FlatProfile($reduced); |
| 908 my $cumulative = CumulativeProfile($reduced); | 899 my $cumulative = CumulativeProfile($reduced); |
| 909 | 900 |
| 910 PrintDisassembly($libs, $flat, $cumulative, $routine); | 901 PrintDisassembly($libs, $flat, $cumulative, $routine); |
| 911 return 1; | 902 return 1; |
| 912 } | 903 } |
| 913 if (m/^\s*(gv|web|evince)\s*(.*)/) { | 904 if (m/^\s*(gv|web|evince)\s*(.*)/) { |
| 914 $main::opt_gv = 0; | 905 $main::opt_gv = 0; |
| 915 $main::opt_evince = 0; | 906 $main::opt_evince = 0; |
| 916 $main::opt_web = 0; | 907 $main::opt_web = 0; |
| 917 if ($1 eq "gv") { | 908 if ($1 eq "gv") { |
| 918 $main::opt_gv = 1; | 909 $main::opt_gv = 1; |
| 919 } elsif ($1 eq "evince") { | 910 } elsif ($1 eq "evince") { |
| 920 $main::opt_evince = 1; | 911 $main::opt_evince = 1; |
| 921 } elsif ($1 eq "web") { | 912 } elsif ($1 eq "web") { |
| 922 $main::opt_web = 1; | 913 $main::opt_web = 1; |
| 923 } | 914 } |
| 924 | 915 |
| 925 my $focus; | 916 my $focus; |
| 926 my $ignore; | 917 my $ignore; |
| 927 ($focus, $ignore) = ParseInteractiveArgs($2); | 918 ($focus, $ignore) = ParseInteractiveArgs($2); |
| 928 | 919 |
| 929 # Process current profile to account for various settings | 920 # Process current profile to account for various settings |
| 930 my $profile = ProcessProfile($total, $orig_profile, $symbols, | 921 my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore); |
| 931 $focus, $ignore); | |
| 932 my $reduced = ReduceProfile($symbols, $profile); | 922 my $reduced = ReduceProfile($symbols, $profile); |
| 933 | 923 |
| 934 # Get derived profiles | 924 # Get derived profiles |
| 935 my $flat = FlatProfile($reduced); | 925 my $flat = FlatProfile($reduced); |
| 936 my $cumulative = CumulativeProfile($reduced); | 926 my $cumulative = CumulativeProfile($reduced); |
| 937 | 927 |
| 938 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { | 928 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { |
| 939 if ($main::opt_gv) { | 929 if ($main::opt_gv) { |
| 940 RunGV(TempName($main::next_tmpfile, "ps"), " &"); | 930 RunGV(TempName($main::next_tmpfile, "ps"), " &"); |
| 941 } elsif ($main::opt_evince) { | 931 } elsif ($main::opt_evince) { |
| 942 RunEvince(TempName($main::next_tmpfile, "pdf"), " &"); | 932 RunEvince(TempName($main::next_tmpfile, "pdf"), " &"); |
| 943 } elsif ($main::opt_web) { | 933 } elsif ($main::opt_web) { |
| 944 RunWeb(TempName($main::next_tmpfile, "svg")); | 934 RunWeb(TempName($main::next_tmpfile, "svg")); |
| 945 } | 935 } |
| 946 $main::next_tmpfile++; | 936 $main::next_tmpfile++; |
| 947 } | 937 } |
| 948 return 1; | 938 return 1; |
| 949 } | 939 } |
| 950 if (m/^\s*$/) { | 940 if (m/^\s*$/) { |
| 951 return 1; | 941 return 1; |
| 952 } | 942 } |
| 953 print STDERR "Unknown command: try 'help'.\n"; | 943 print STDERR "Unknown command: try 'help'.\n"; |
| 954 return 1; | 944 return 1; |
| 955 } | 945 } |
| 956 | 946 |
| 957 | 947 |
| 958 sub ProcessProfile { | 948 sub ProcessProfile { |
| 959 my $total_count = shift; | |
| 960 my $orig_profile = shift; | 949 my $orig_profile = shift; |
| 961 my $symbols = shift; | 950 my $symbols = shift; |
| 962 my $focus = shift; | 951 my $focus = shift; |
| 963 my $ignore = shift; | 952 my $ignore = shift; |
| 964 | 953 |
| 965 # Process current profile to account for various settings | 954 # Process current profile to account for various settings |
| 966 my $profile = $orig_profile; | 955 my $profile = $orig_profile; |
| 956 my $total_count = TotalProfile($profile); |
| 967 printf("Total: %s %s\n", Unparse($total_count), Units()); | 957 printf("Total: %s %s\n", Unparse($total_count), Units()); |
| 968 if ($focus ne '') { | 958 if ($focus ne '') { |
| 969 $profile = FocusProfile($symbols, $profile, $focus); | 959 $profile = FocusProfile($symbols, $profile, $focus); |
| 970 my $focus_count = TotalProfile($profile); | 960 my $focus_count = TotalProfile($profile); |
| 971 printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n", | 961 printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n", |
| 972 $focus, | 962 $focus, |
| 973 Unparse($focus_count), Units(), | 963 Unparse($focus_count), Units(), |
| 974 Unparse($total_count), ($focus_count*100.0) / $total_count); | 964 Unparse($total_count), ($focus_count*100.0) / $total_count); |
| 975 } | 965 } |
| 976 if ($ignore ne '') { | 966 if ($ignore ne '') { |
| (...skipping 26 matching lines...) Expand all Loading... |
| 1003 web [focus] [-ignore1] [-ignore2] | 993 web [focus] [-ignore1] [-ignore2] |
| 1004 Like GV, but displays profile in your web browser instead of using | 994 Like GV, but displays profile in your web browser instead of using |
| 1005 Ghostview. Works best if your web browser is already running. | 995 Ghostview. Works best if your web browser is already running. |
| 1006 To change the browser that gets used: | 996 To change the browser that gets used: |
| 1007 On Linux, set the /etc/alternatives/gnome-www-browser symlink. | 997 On Linux, set the /etc/alternatives/gnome-www-browser symlink. |
| 1008 On OS X, change the Finder association for SVG files. | 998 On OS X, change the Finder association for SVG files. |
| 1009 | 999 |
| 1010 list [routine_regexp] [-ignore1] [-ignore2] | 1000 list [routine_regexp] [-ignore1] [-ignore2] |
| 1011 Show source listing of routines whose names match "routine_regexp" | 1001 Show source listing of routines whose names match "routine_regexp" |
| 1012 | 1002 |
| 1013 weblist [routine_regexp] [-ignore1] [-ignore2] | |
| 1014 Displays a source listing of routines whose names match "routine_regexp" | |
| 1015 in a web browser. You can click on source lines to view the | |
| 1016 corresponding disassembly. | |
| 1017 | |
| 1018 top [--cum] [-ignore1] [-ignore2] | 1003 top [--cum] [-ignore1] [-ignore2] |
| 1019 top20 [--cum] [-ignore1] [-ignore2] | 1004 top20 [--cum] [-ignore1] [-ignore2] |
| 1020 top37 [--cum] [-ignore1] [-ignore2] | 1005 top37 [--cum] [-ignore1] [-ignore2] |
| 1021 Show top lines ordered by flat profile count, or cumulative count | 1006 Show top lines ordered by flat profile count, or cumulative count |
| 1022 if --cum is specified. If a number is present after 'top', the | 1007 if --cum is specified. If a number is present after 'top', the |
| 1023 top K routines will be shown (defaults to showing the top 10) | 1008 top K routines will be shown (defaults to showing the top 10) |
| 1024 | 1009 |
| 1025 disasm [routine_regexp] [-ignore1] [-ignore2] | 1010 disasm [routine_regexp] [-ignore1] [-ignore2] |
| 1026 Show disassembly of routines whose names match "routine_regexp", | 1011 Show disassembly of routines whose names match "routine_regexp", |
| 1027 annotated with sample counts. | 1012 annotated with sample counts. |
| 1028 | 1013 |
| 1029 callgrind | 1014 callgrind |
| 1030 callgrind [filename] | 1015 callgrind [filename] |
| 1031 Generates callgrind file. If no filename is given, kcachegrind is called. | 1016 Generates callgrind file. If no filename is given, kcachegrind is called. |
| 1032 | 1017 |
| 1033 help - This listing | 1018 help - This listing |
| 1034 quit or ^D - End pprof | 1019 quit or ^D - End pprof |
| 1035 | 1020 |
| 1036 For commands that accept optional -ignore tags, samples where any routine in | 1021 For commands that accept optional -ignore tags, samples where any routine in |
| 1037 the stack trace matches the regular expression in any of the -ignore | 1022 the stack trace matches the regular expression in any of the -ignore |
| 1038 parameters will be ignored. | 1023 parameters will be ignored. |
| 1039 | 1024 |
| 1040 Further pprof details are available at this location (or one similar): | 1025 Further pprof details are available at this location (or one similar): |
| 1041 | 1026 |
| 1042 /usr/doc/gperftools-$PPROF_VERSION/cpu_profiler.html | 1027 /usr/doc/google-perftools-$PPROF_VERSION/cpu_profiler.html |
| 1043 /usr/doc/gperftools-$PPROF_VERSION/heap_profiler.html | 1028 /usr/doc/google-perftools-$PPROF_VERSION/heap_profiler.html |
| 1044 | 1029 |
| 1045 ENDOFHELP | 1030 ENDOFHELP |
| 1046 } | 1031 } |
| 1047 sub ParseInteractiveArgs { | 1032 sub ParseInteractiveArgs { |
| 1048 my $args = shift; | 1033 my $args = shift; |
| 1049 my $focus = ""; | 1034 my $focus = ""; |
| 1050 my $ignore = ""; | 1035 my $ignore = ""; |
| 1051 my @x = split(/ +/, $args); | 1036 my @x = split(/ +/, $args); |
| 1052 foreach $a (@x) { | 1037 foreach $a (@x) { |
| 1053 if ($a =~ m/^(--|-)lines$/) { | 1038 if ($a =~ m/^(--|-)lines$/) { |
| (...skipping 129 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1183 if ($f != 0 || $c != 0) { | 1168 if ($f != 0 || $c != 0) { |
| 1184 printf("%8s %6s %6s %8s %6s %s\n", | 1169 printf("%8s %6s %6s %8s %6s %s\n", |
| 1185 Unparse($f), | 1170 Unparse($f), |
| 1186 Percent($f, $total), | 1171 Percent($f, $total), |
| 1187 Percent($running_sum, $total), | 1172 Percent($running_sum, $total), |
| 1188 Unparse($c), | 1173 Unparse($c), |
| 1189 Percent($c, $total), | 1174 Percent($c, $total), |
| 1190 $sym); | 1175 $sym); |
| 1191 } | 1176 } |
| 1192 $lines++; | 1177 $lines++; |
| 1193 last if ($line_limit >= 0 && $lines >= $line_limit); | 1178 last if ($line_limit >= 0 && $lines > $line_limit); |
| 1194 } | |
| 1195 } | |
| 1196 | |
| 1197 # Callgrind format has a compression for repeated function and file | |
| 1198 # names. You show the name the first time, and just use its number | |
| 1199 # subsequently. This can cut down the file to about a third or a | |
| 1200 # quarter of its uncompressed size. $key and $val are the key/value | |
| 1201 # pair that would normally be printed by callgrind; $map is a map from | |
| 1202 # value to number. | |
| 1203 sub CompressedCGName { | |
| 1204 my($key, $val, $map) = @_; | |
| 1205 my $idx = $map->{$val}; | |
| 1206 # For very short keys, providing an index hurts rather than helps. | |
| 1207 if (length($val) <= 3) { | |
| 1208 return "$key=$val\n"; | |
| 1209 } elsif (defined($idx)) { | |
| 1210 return "$key=($idx)\n"; | |
| 1211 } else { | |
| 1212 # scalar(keys $map) gives the number of items in the map. | |
| 1213 $idx = scalar(keys(%{$map})) + 1; | |
| 1214 $map->{$val} = $idx; | |
| 1215 return "$key=($idx) $val\n"; | |
| 1216 } | 1179 } |
| 1217 } | 1180 } |
| 1218 | 1181 |
| 1219 # Print the call graph in a way that's suiteable for callgrind. | 1182 # Print the call graph in a way that's suiteable for callgrind. |
| 1220 sub PrintCallgrind { | 1183 sub PrintCallgrind { |
| 1221 my $calls = shift; | 1184 my $calls = shift; |
| 1222 my $filename; | 1185 my $filename; |
| 1223 my %filename_to_index_map; | |
| 1224 my %fnname_to_index_map; | |
| 1225 | |
| 1226 if ($main::opt_interactive) { | 1186 if ($main::opt_interactive) { |
| 1227 $filename = shift; | 1187 $filename = shift; |
| 1228 print STDERR "Writing callgrind file to '$filename'.\n" | 1188 print STDERR "Writing callgrind file to '$filename'.\n" |
| 1229 } else { | 1189 } else { |
| 1230 $filename = "&STDOUT"; | 1190 $filename = "&STDOUT"; |
| 1231 } | 1191 } |
| 1232 open(CG, ">$filename"); | 1192 open(CG, ">".$filename ); |
| 1233 printf CG ("events: Hits\n\n"); | 1193 printf CG ("events: Hits\n\n"); |
| 1234 foreach my $call ( map { $_->[0] } | 1194 foreach my $call ( map { $_->[0] } |
| 1235 sort { $a->[1] cmp $b ->[1] || | 1195 sort { $a->[1] cmp $b ->[1] || |
| 1236 $a->[2] <=> $b->[2] } | 1196 $a->[2] <=> $b->[2] } |
| 1237 map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; | 1197 map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; |
| 1238 [$_, $1, $2] } | 1198 [$_, $1, $2] } |
| 1239 keys %$calls ) { | 1199 keys %$calls ) { |
| 1240 my $count = int($calls->{$call}); | 1200 my $count = int($calls->{$call}); |
| 1241 $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; | 1201 $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; |
| 1242 my ( $caller_file, $caller_line, $caller_function, | 1202 my ( $caller_file, $caller_line, $caller_function, |
| 1243 $callee_file, $callee_line, $callee_function ) = | 1203 $callee_file, $callee_line, $callee_function ) = |
| 1244 ( $1, $2, $3, $5, $6, $7 ); | 1204 ( $1, $2, $3, $5, $6, $7 ); |
| 1245 | 1205 |
| 1246 # TODO(csilvers): for better compression, collect all the | 1206 |
| 1247 # caller/callee_files and functions first, before printing | 1207 printf CG ("fl=$caller_file\nfn=$caller_function\n"); |
| 1248 # anything, and only compress those referenced more than once. | |
| 1249 printf CG CompressedCGName("fl", $caller_file, \%filename_to_index_map); | |
| 1250 printf CG CompressedCGName("fn", $caller_function, \%fnname_to_index_map); | |
| 1251 if (defined $6) { | 1208 if (defined $6) { |
| 1252 printf CG CompressedCGName("cfl", $callee_file, \%filename_to_index_map); | 1209 printf CG ("cfl=$callee_file\n"); |
| 1253 printf CG CompressedCGName("cfn", $callee_function, \%fnname_to_index_map)
; | 1210 printf CG ("cfn=$callee_function\n"); |
| 1254 printf CG ("calls=$count $callee_line\n"); | 1211 printf CG ("calls=$count $callee_line\n"); |
| 1255 } | 1212 } |
| 1256 printf CG ("$caller_line $count\n\n"); | 1213 printf CG ("$caller_line $count\n\n"); |
| 1257 } | 1214 } |
| 1258 } | 1215 } |
| 1259 | 1216 |
| 1260 # Print disassembly for all all routines that match $main::opt_disasm | 1217 # Print disassembly for all all routines that match $main::opt_disasm |
| 1261 sub PrintDisassembly { | 1218 sub PrintDisassembly { |
| 1262 my $libs = shift; | 1219 my $libs = shift; |
| 1263 my $flat = shift; | 1220 my $flat = shift; |
| (...skipping 28 matching lines...) Expand all Loading... |
| 1292 # [start_address, filename, linenumber, instruction, limit_address] | 1249 # [start_address, filename, linenumber, instruction, limit_address] |
| 1293 # E.g., | 1250 # E.g., |
| 1294 # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] | 1251 # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] |
| 1295 sub Disassemble { | 1252 sub Disassemble { |
| 1296 my $prog = shift; | 1253 my $prog = shift; |
| 1297 my $offset = shift; | 1254 my $offset = shift; |
| 1298 my $start_addr = shift; | 1255 my $start_addr = shift; |
| 1299 my $end_addr = shift; | 1256 my $end_addr = shift; |
| 1300 | 1257 |
| 1301 my $objdump = $obj_tool_map{"objdump"}; | 1258 my $objdump = $obj_tool_map{"objdump"}; |
| 1302 my $cmd = ShellEscape($objdump, "-C", "-d", "-l", "--no-show-raw-insn", | 1259 my $cmd = sprintf("$objdump -C -d -l --no-show-raw-insn " . |
| 1303 "--start-address=0x$start_addr", | 1260 "--start-address=0x$start_addr " . |
| 1304 "--stop-address=0x$end_addr", $prog); | 1261 "--stop-address=0x$end_addr $prog"); |
| 1305 open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); | 1262 open(OBJDUMP, "$cmd |") || error("$objdump: $!\n"); |
| 1306 my @result = (); | 1263 my @result = (); |
| 1307 my $filename = ""; | 1264 my $filename = ""; |
| 1308 my $linenumber = -1; | 1265 my $linenumber = -1; |
| 1309 my $last = ["", "", "", ""]; | 1266 my $last = ["", "", "", ""]; |
| 1310 while (<OBJDUMP>) { | 1267 while (<OBJDUMP>) { |
| 1311 s/\r//g; # turn windows-looking lines into unix-looking lines | 1268 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 1312 chop; | 1269 chop; |
| 1313 if (m|\s*([^:\s]+):(\d+)\s*$|) { | 1270 if (m|\s*([^:\s]+):(\d+)\s*$|) { |
| 1314 # Location line of the form: | 1271 # Location line of the form: |
| 1315 # <filename>:<linenumber> | 1272 # <filename>:<linenumber> |
| (...skipping 42 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1358 print(($symbols->{$pc}->[0] || "??") . "\n"); | 1315 print(($symbols->{$pc}->[0] || "??") . "\n"); |
| 1359 } | 1316 } |
| 1360 } | 1317 } |
| 1361 | 1318 |
| 1362 | 1319 |
| 1363 # For sorting functions by name | 1320 # For sorting functions by name |
| 1364 sub ByName { | 1321 sub ByName { |
| 1365 return ShortFunctionName($a) cmp ShortFunctionName($b); | 1322 return ShortFunctionName($a) cmp ShortFunctionName($b); |
| 1366 } | 1323 } |
| 1367 | 1324 |
| 1368 # Print source-listing for all all routines that match $list_opts | 1325 # Print source-listing for all all routines that match $main::opt_list |
| 1369 sub PrintListing { | 1326 sub PrintListing { |
| 1370 my $total = shift; | |
| 1371 my $libs = shift; | 1327 my $libs = shift; |
| 1372 my $flat = shift; | 1328 my $flat = shift; |
| 1373 my $cumulative = shift; | 1329 my $cumulative = shift; |
| 1374 my $list_opts = shift; | 1330 my $list_opts = shift; |
| 1375 my $html = shift; | |
| 1376 | 1331 |
| 1377 my $output = \*STDOUT; | |
| 1378 my $fname = ""; | |
| 1379 | |
| 1380 if ($html) { | |
| 1381 # Arrange to write the output to a temporary file | |
| 1382 $fname = TempName($main::next_tmpfile, "html"); | |
| 1383 $main::next_tmpfile++; | |
| 1384 if (!open(TEMP, ">$fname")) { | |
| 1385 print STDERR "$fname: $!\n"; | |
| 1386 return; | |
| 1387 } | |
| 1388 $output = \*TEMP; | |
| 1389 print $output HtmlListingHeader(); | |
| 1390 printf $output ("<div class=\"legend\">%s<br>Total: %s %s</div>\n", | |
| 1391 $main::prog, Unparse($total), Units()); | |
| 1392 } | |
| 1393 | |
| 1394 my $listed = 0; | |
| 1395 foreach my $lib (@{$libs}) { | 1332 foreach my $lib (@{$libs}) { |
| 1396 my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts); | 1333 my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts); |
| 1397 my $offset = AddressSub($lib->[1], $lib->[3]); | 1334 my $offset = AddressSub($lib->[1], $lib->[3]); |
| 1398 foreach my $routine (sort ByName keys(%{$symbol_table})) { | 1335 foreach my $routine (sort ByName keys(%{$symbol_table})) { |
| 1399 # Print if there are any samples in this routine | 1336 # Print if there are any samples in this routine |
| 1400 my $start_addr = $symbol_table->{$routine}->[0]; | 1337 my $start_addr = $symbol_table->{$routine}->[0]; |
| 1401 my $end_addr = $symbol_table->{$routine}->[1]; | 1338 my $end_addr = $symbol_table->{$routine}->[1]; |
| 1402 my $length = hex(AddressSub($end_addr, $start_addr)); | 1339 my $length = hex(AddressSub($end_addr, $start_addr)); |
| 1403 my $addr = AddressAdd($start_addr, $offset); | 1340 my $addr = AddressAdd($start_addr, $offset); |
| 1404 for (my $i = 0; $i < $length; $i++) { | 1341 for (my $i = 0; $i < $length; $i++) { |
| 1405 if (defined($cumulative->{$addr})) { | 1342 if (defined($cumulative->{$addr})) { |
| 1406 $listed += PrintSource( | 1343 PrintSource($lib->[0], $offset, |
| 1407 $lib->[0], $offset, | 1344 $routine, $flat, $cumulative, |
| 1408 $routine, $flat, $cumulative, | 1345 $start_addr, $end_addr); |
| 1409 $start_addr, $end_addr, | |
| 1410 $html, | |
| 1411 $output); | |
| 1412 last; | 1346 last; |
| 1413 } | 1347 } |
| 1414 $addr = AddressInc($addr); | 1348 $addr = AddressInc($addr); |
| 1415 } | 1349 } |
| 1416 } | 1350 } |
| 1417 } | 1351 } |
| 1418 | |
| 1419 if ($html) { | |
| 1420 if ($listed > 0) { | |
| 1421 print $output HtmlListingFooter(); | |
| 1422 close($output); | |
| 1423 RunWeb($fname); | |
| 1424 } else { | |
| 1425 close($output); | |
| 1426 unlink($fname); | |
| 1427 } | |
| 1428 } | |
| 1429 } | |
| 1430 | |
| 1431 sub HtmlListingHeader { | |
| 1432 return <<'EOF'; | |
| 1433 <DOCTYPE html> | |
| 1434 <html> | |
| 1435 <head> | |
| 1436 <title>Pprof listing</title> | |
| 1437 <style type="text/css"> | |
| 1438 body { | |
| 1439 font-family: sans-serif; | |
| 1440 } | |
| 1441 h1 { | |
| 1442 font-size: 1.5em; | |
| 1443 margin-bottom: 4px; | |
| 1444 } | |
| 1445 .legend { | |
| 1446 font-size: 1.25em; | |
| 1447 } | |
| 1448 .line { | |
| 1449 color: #aaaaaa; | |
| 1450 } | |
| 1451 .nop { | |
| 1452 color: #aaaaaa; | |
| 1453 } | |
| 1454 .unimportant { | |
| 1455 color: #cccccc; | |
| 1456 } | |
| 1457 .disasmloc { | |
| 1458 color: #000000; | |
| 1459 } | |
| 1460 .deadsrc { | |
| 1461 cursor: pointer; | |
| 1462 } | |
| 1463 .deadsrc:hover { | |
| 1464 background-color: #eeeeee; | |
| 1465 } | |
| 1466 .livesrc { | |
| 1467 color: #0000ff; | |
| 1468 cursor: pointer; | |
| 1469 } | |
| 1470 .livesrc:hover { | |
| 1471 background-color: #eeeeee; | |
| 1472 } | |
| 1473 .asm { | |
| 1474 color: #008800; | |
| 1475 display: none; | |
| 1476 } | |
| 1477 </style> | |
| 1478 <script type="text/javascript"> | |
| 1479 function pprof_toggle_asm(e) { | |
| 1480 var target; | |
| 1481 if (!e) e = window.event; | |
| 1482 if (e.target) target = e.target; | |
| 1483 else if (e.srcElement) target = e.srcElement; | |
| 1484 | |
| 1485 if (target) { | |
| 1486 var asm = target.nextSibling; | |
| 1487 if (asm && asm.className == "asm") { | |
| 1488 asm.style.display = (asm.style.display == "block" ? "" : "block"); | |
| 1489 e.preventDefault(); | |
| 1490 return false; | |
| 1491 } | |
| 1492 } | |
| 1493 } | |
| 1494 </script> | |
| 1495 </head> | |
| 1496 <body> | |
| 1497 EOF | |
| 1498 } | |
| 1499 | |
| 1500 sub HtmlListingFooter { | |
| 1501 return <<'EOF'; | |
| 1502 </body> | |
| 1503 </html> | |
| 1504 EOF | |
| 1505 } | |
| 1506 | |
| 1507 sub HtmlEscape { | |
| 1508 my $text = shift; | |
| 1509 $text =~ s/&/&/g; | |
| 1510 $text =~ s/</</g; | |
| 1511 $text =~ s/>/>/g; | |
| 1512 return $text; | |
| 1513 } | 1352 } |
| 1514 | 1353 |
| 1515 # Returns the indentation of the line, if it has any non-whitespace | 1354 # Returns the indentation of the line, if it has any non-whitespace |
| 1516 # characters. Otherwise, returns -1. | 1355 # characters. Otherwise, returns -1. |
| 1517 sub Indentation { | 1356 sub Indentation { |
| 1518 my $line = shift; | 1357 my $line = shift; |
| 1519 if (m/^(\s*)\S/) { | 1358 if (m/^(\s*)\S/) { |
| 1520 return length($1); | 1359 return length($1); |
| 1521 } else { | 1360 } else { |
| 1522 return -1; | 1361 return -1; |
| 1523 } | 1362 } |
| 1524 } | 1363 } |
| 1525 | 1364 |
| 1526 # If the symbol table contains inlining info, Disassemble() may tag an | |
| 1527 # instruction with a location inside an inlined function. But for | |
| 1528 # source listings, we prefer to use the location in the function we | |
| 1529 # are listing. So use MapToSymbols() to fetch full location | |
| 1530 # information for each instruction and then pick out the first | |
| 1531 # location from a location list (location list contains callers before | |
| 1532 # callees in case of inlining). | |
| 1533 # | |
| 1534 # After this routine has run, each entry in $instructions contains: | |
| 1535 # [0] start address | |
| 1536 # [1] filename for function we are listing | |
| 1537 # [2] line number for function we are listing | |
| 1538 # [3] disassembly | |
| 1539 # [4] limit address | |
| 1540 # [5] most specific filename (may be different from [1] due to inlining) | |
| 1541 # [6] most specific line number (may be different from [2] due to inlining) | |
| 1542 sub GetTopLevelLineNumbers { | |
| 1543 my ($lib, $offset, $instructions) = @_; | |
| 1544 my $pcs = []; | |
| 1545 for (my $i = 0; $i <= $#{$instructions}; $i++) { | |
| 1546 push(@{$pcs}, $instructions->[$i]->[0]); | |
| 1547 } | |
| 1548 my $symbols = {}; | |
| 1549 MapToSymbols($lib, $offset, $pcs, $symbols); | |
| 1550 for (my $i = 0; $i <= $#{$instructions}; $i++) { | |
| 1551 my $e = $instructions->[$i]; | |
| 1552 push(@{$e}, $e->[1]); | |
| 1553 push(@{$e}, $e->[2]); | |
| 1554 my $addr = $e->[0]; | |
| 1555 my $sym = $symbols->{$addr}; | |
| 1556 if (defined($sym)) { | |
| 1557 if ($#{$sym} >= 2 && $sym->[1] =~ m/^(.*):(\d+)$/) { | |
| 1558 $e->[1] = $1; # File name | |
| 1559 $e->[2] = $2; # Line number | |
| 1560 } | |
| 1561 } | |
| 1562 } | |
| 1563 } | |
| 1564 | |
| 1565 # Print source-listing for one routine | 1365 # Print source-listing for one routine |
| 1566 sub PrintSource { | 1366 sub PrintSource { |
| 1567 my $prog = shift; | 1367 my $prog = shift; |
| 1568 my $offset = shift; | 1368 my $offset = shift; |
| 1569 my $routine = shift; | 1369 my $routine = shift; |
| 1570 my $flat = shift; | 1370 my $flat = shift; |
| 1571 my $cumulative = shift; | 1371 my $cumulative = shift; |
| 1572 my $start_addr = shift; | 1372 my $start_addr = shift; |
| 1573 my $end_addr = shift; | 1373 my $end_addr = shift; |
| 1574 my $html = shift; | |
| 1575 my $output = shift; | |
| 1576 | 1374 |
| 1577 # Disassemble all instructions (just to get line numbers) | 1375 # Disassemble all instructions (just to get line numbers) |
| 1578 my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); | 1376 my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); |
| 1579 GetTopLevelLineNumbers($prog, $offset, \@instructions); | |
| 1580 | 1377 |
| 1581 # Hack 1: assume that the first source file encountered in the | 1378 # Hack 1: assume that the first source file encountered in the |
| 1582 # disassembly contains the routine | 1379 # disassembly contains the routine |
| 1583 my $filename = undef; | 1380 my $filename = undef; |
| 1584 for (my $i = 0; $i <= $#instructions; $i++) { | 1381 for (my $i = 0; $i <= $#instructions; $i++) { |
| 1585 if ($instructions[$i]->[2] >= 0) { | 1382 if ($instructions[$i]->[2] >= 0) { |
| 1586 $filename = $instructions[$i]->[1]; | 1383 $filename = $instructions[$i]->[1]; |
| 1587 last; | 1384 last; |
| 1588 } | 1385 } |
| 1589 } | 1386 } |
| 1590 if (!defined($filename)) { | 1387 if (!defined($filename)) { |
| 1591 print STDERR "no filename found in $routine\n"; | 1388 print STDERR "no filename found in $routine\n"; |
| 1592 return 0; | 1389 return; |
| 1593 } | 1390 } |
| 1594 | 1391 |
| 1595 # Hack 2: assume that the largest line number from $filename is the | 1392 # Hack 2: assume that the largest line number from $filename is the |
| 1596 # end of the procedure. This is typically safe since if P1 contains | 1393 # end of the procedure. This is typically safe since if P1 contains |
| 1597 # an inlined call to P2, then P2 usually occurs earlier in the | 1394 # an inlined call to P2, then P2 usually occurs earlier in the |
| 1598 # source file. If this does not work, we might have to compute a | 1395 # source file. If this does not work, we might have to compute a |
| 1599 # density profile or just print all regions we find. | 1396 # density profile or just print all regions we find. |
| 1600 my $lastline = 0; | 1397 my $lastline = 0; |
| 1601 for (my $i = 0; $i <= $#instructions; $i++) { | 1398 for (my $i = 0; $i <= $#instructions; $i++) { |
| 1602 my $f = $instructions[$i]->[1]; | 1399 my $f = $instructions[$i]->[1]; |
| (...skipping 12 matching lines...) Expand all Loading... |
| 1615 last; | 1412 last; |
| 1616 } | 1413 } |
| 1617 } | 1414 } |
| 1618 | 1415 |
| 1619 # Hack 4: Extend last line forward until its indentation is less than | 1416 # Hack 4: Extend last line forward until its indentation is less than |
| 1620 # the indentation we saw on $firstline | 1417 # the indentation we saw on $firstline |
| 1621 my $oldlastline = $lastline; | 1418 my $oldlastline = $lastline; |
| 1622 { | 1419 { |
| 1623 if (!open(FILE, "<$filename")) { | 1420 if (!open(FILE, "<$filename")) { |
| 1624 print STDERR "$filename: $!\n"; | 1421 print STDERR "$filename: $!\n"; |
| 1625 return 0; | 1422 return; |
| 1626 } | 1423 } |
| 1627 my $l = 0; | 1424 my $l = 0; |
| 1628 my $first_indentation = -1; | 1425 my $first_indentation = -1; |
| 1629 while (<FILE>) { | 1426 while (<FILE>) { |
| 1630 s/\r//g; # turn windows-looking lines into unix-looking lines | 1427 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 1631 $l++; | 1428 $l++; |
| 1632 my $indent = Indentation($_); | 1429 my $indent = Indentation($_); |
| 1633 if ($l >= $firstline) { | 1430 if ($l >= $firstline) { |
| 1634 if ($first_indentation < 0 && $indent >= 0) { | 1431 if ($first_indentation < 0 && $indent >= 0) { |
| 1635 $first_indentation = $indent; | 1432 $first_indentation = $indent; |
| 1636 last if ($first_indentation == 0); | 1433 last if ($first_indentation == 0); |
| 1637 } | 1434 } |
| 1638 } | 1435 } |
| 1639 if ($l >= $lastline && $indent >= 0) { | 1436 if ($l >= $lastline && $indent >= 0) { |
| 1640 if ($indent >= $first_indentation) { | 1437 if ($indent >= $first_indentation) { |
| 1641 $lastline = $l+1; | 1438 $lastline = $l+1; |
| 1642 } else { | 1439 } else { |
| 1643 last; | 1440 last; |
| 1644 } | 1441 } |
| 1645 } | 1442 } |
| 1646 } | 1443 } |
| 1647 close(FILE); | 1444 close(FILE); |
| 1648 } | 1445 } |
| 1649 | 1446 |
| 1650 # Assign all samples to the range $firstline,$lastline, | 1447 # Assign all samples to the range $firstline,$lastline, |
| 1651 # Hack 4: If an instruction does not occur in the range, its samples | 1448 # Hack 4: If an instruction does not occur in the range, its samples |
| 1652 # are moved to the next instruction that occurs in the range. | 1449 # are moved to the next instruction that occurs in the range. |
| 1653 my $samples1 = {}; # Map from line number to flat count | 1450 my $samples1 = {}; |
| 1654 my $samples2 = {}; # Map from line number to cumulative count | 1451 my $samples2 = {}; |
| 1655 my $running1 = 0; # Unassigned flat counts | 1452 my $running1 = 0; # Unassigned flat counts |
| 1656 my $running2 = 0; # Unassigned cumulative counts | 1453 my $running2 = 0; # Unassigned cumulative counts |
| 1657 my $total1 = 0; # Total flat counts | 1454 my $total1 = 0; # Total flat counts |
| 1658 my $total2 = 0; # Total cumulative counts | 1455 my $total2 = 0; # Total cumulative counts |
| 1659 my %disasm = (); # Map from line number to disassembly | |
| 1660 my $running_disasm = ""; # Unassigned disassembly | |
| 1661 my $skip_marker = "---\n"; | |
| 1662 if ($html) { | |
| 1663 $skip_marker = ""; | |
| 1664 for (my $l = $firstline; $l <= $lastline; $l++) { | |
| 1665 $disasm{$l} = ""; | |
| 1666 } | |
| 1667 } | |
| 1668 my $last_dis_filename = ''; | |
| 1669 my $last_dis_linenum = -1; | |
| 1670 my $last_touched_line = -1; # To detect gaps in disassembly for a line | |
| 1671 foreach my $e (@instructions) { | 1456 foreach my $e (@instructions) { |
| 1672 # Add up counts for all address that fall inside this instruction | 1457 # Add up counts for all address that fall inside this instruction |
| 1673 my $c1 = 0; | 1458 my $c1 = 0; |
| 1674 my $c2 = 0; | 1459 my $c2 = 0; |
| 1675 for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { | 1460 for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { |
| 1676 $c1 += GetEntry($flat, $a); | 1461 $c1 += GetEntry($flat, $a); |
| 1677 $c2 += GetEntry($cumulative, $a); | 1462 $c2 += GetEntry($cumulative, $a); |
| 1678 } | 1463 } |
| 1679 | |
| 1680 if ($html) { | |
| 1681 my $dis = sprintf(" %6s %6s \t\t%8s: %s ", | |
| 1682 HtmlPrintNumber($c1), | |
| 1683 HtmlPrintNumber($c2), | |
| 1684 UnparseAddress($offset, $e->[0]), | |
| 1685 CleanDisassembly($e->[3])); | |
| 1686 | |
| 1687 # Append the most specific source line associated with this instruction | |
| 1688 if (length($dis) < 80) { $dis .= (' ' x (80 - length($dis))) }; | |
| 1689 $dis = HtmlEscape($dis); | |
| 1690 my $f = $e->[5]; | |
| 1691 my $l = $e->[6]; | |
| 1692 if ($f ne $last_dis_filename) { | |
| 1693 $dis .= sprintf("<span class=disasmloc>%s:%d</span>", | |
| 1694 HtmlEscape(CleanFileName($f)), $l); | |
| 1695 } elsif ($l ne $last_dis_linenum) { | |
| 1696 # De-emphasize the unchanged file name portion | |
| 1697 $dis .= sprintf("<span class=unimportant>%s</span>" . | |
| 1698 "<span class=disasmloc>:%d</span>", | |
| 1699 HtmlEscape(CleanFileName($f)), $l); | |
| 1700 } else { | |
| 1701 # De-emphasize the entire location | |
| 1702 $dis .= sprintf("<span class=unimportant>%s:%d</span>", | |
| 1703 HtmlEscape(CleanFileName($f)), $l); | |
| 1704 } | |
| 1705 $last_dis_filename = $f; | |
| 1706 $last_dis_linenum = $l; | |
| 1707 $running_disasm .= $dis; | |
| 1708 $running_disasm .= "\n"; | |
| 1709 } | |
| 1710 | |
| 1711 $running1 += $c1; | 1464 $running1 += $c1; |
| 1712 $running2 += $c2; | 1465 $running2 += $c2; |
| 1713 $total1 += $c1; | 1466 $total1 += $c1; |
| 1714 $total2 += $c2; | 1467 $total2 += $c2; |
| 1715 my $file = $e->[1]; | 1468 my $file = $e->[1]; |
| 1716 my $line = $e->[2]; | 1469 my $line = $e->[2]; |
| 1717 if (($file eq $filename) && | 1470 if (($file eq $filename) && |
| 1718 ($line >= $firstline) && | 1471 ($line >= $firstline) && |
| 1719 ($line <= $lastline)) { | 1472 ($line <= $lastline)) { |
| 1720 # Assign all accumulated samples to this line | 1473 # Assign all accumulated samples to this line |
| 1721 AddEntry($samples1, $line, $running1); | 1474 AddEntry($samples1, $line, $running1); |
| 1722 AddEntry($samples2, $line, $running2); | 1475 AddEntry($samples2, $line, $running2); |
| 1723 $running1 = 0; | 1476 $running1 = 0; |
| 1724 $running2 = 0; | 1477 $running2 = 0; |
| 1725 if ($html) { | |
| 1726 if ($line != $last_touched_line && $disasm{$line} ne '') { | |
| 1727 $disasm{$line} .= "\n"; | |
| 1728 } | |
| 1729 $disasm{$line} .= $running_disasm; | |
| 1730 $running_disasm = ''; | |
| 1731 $last_touched_line = $line; | |
| 1732 } | |
| 1733 } | 1478 } |
| 1734 } | 1479 } |
| 1735 | 1480 |
| 1736 # Assign any leftover samples to $lastline | 1481 # Assign any leftover samples to $lastline |
| 1737 AddEntry($samples1, $lastline, $running1); | 1482 AddEntry($samples1, $lastline, $running1); |
| 1738 AddEntry($samples2, $lastline, $running2); | 1483 AddEntry($samples2, $lastline, $running2); |
| 1739 if ($html) { | |
| 1740 if ($lastline != $last_touched_line && $disasm{$lastline} ne '') { | |
| 1741 $disasm{$lastline} .= "\n"; | |
| 1742 } | |
| 1743 $disasm{$lastline} .= $running_disasm; | |
| 1744 } | |
| 1745 | 1484 |
| 1746 if ($html) { | 1485 printf("ROUTINE ====================== %s in %s\n" . |
| 1747 printf $output ( | 1486 "%6s %6s Total %s (flat / cumulative)\n", |
| 1748 "<h1>%s</h1>%s\n<pre onClick=\"pprof_toggle_asm()\">\n" . | 1487 ShortFunctionName($routine), |
| 1749 "Total:%6s %6s (flat / cumulative %s)\n", | 1488 $filename, |
| 1750 HtmlEscape(ShortFunctionName($routine)), | 1489 Units(), |
| 1751 HtmlEscape(CleanFileName($filename)), | 1490 Unparse($total1), |
| 1752 Unparse($total1), | 1491 Unparse($total2)); |
| 1753 Unparse($total2), | |
| 1754 Units()); | |
| 1755 } else { | |
| 1756 printf $output ( | |
| 1757 "ROUTINE ====================== %s in %s\n" . | |
| 1758 "%6s %6s Total %s (flat / cumulative)\n", | |
| 1759 ShortFunctionName($routine), | |
| 1760 CleanFileName($filename), | |
| 1761 Unparse($total1), | |
| 1762 Unparse($total2), | |
| 1763 Units()); | |
| 1764 } | |
| 1765 if (!open(FILE, "<$filename")) { | 1492 if (!open(FILE, "<$filename")) { |
| 1766 print STDERR "$filename: $!\n"; | 1493 print STDERR "$filename: $!\n"; |
| 1767 return 0; | 1494 return; |
| 1768 } | 1495 } |
| 1769 my $l = 0; | 1496 my $l = 0; |
| 1770 while (<FILE>) { | 1497 while (<FILE>) { |
| 1771 s/\r//g; # turn windows-looking lines into unix-looking lines | 1498 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 1772 $l++; | 1499 $l++; |
| 1773 if ($l >= $firstline - 5 && | 1500 if ($l >= $firstline - 5 && |
| 1774 (($l <= $oldlastline + 5) || ($l <= $lastline))) { | 1501 (($l <= $oldlastline + 5) || ($l <= $lastline))) { |
| 1775 chop; | 1502 chop; |
| 1776 my $text = $_; | 1503 my $text = $_; |
| 1777 if ($l == $firstline) { print $output $skip_marker; } | 1504 if ($l == $firstline) { printf("---\n"); } |
| 1778 my $n1 = GetEntry($samples1, $l); | 1505 printf("%6s %6s %4d: %s\n", |
| 1779 my $n2 = GetEntry($samples2, $l); | 1506 UnparseAlt(GetEntry($samples1, $l)), |
| 1780 if ($html) { | 1507 UnparseAlt(GetEntry($samples2, $l)), |
| 1781 # Emit a span that has one of the following classes: | 1508 $l, |
| 1782 # livesrc -- has samples | 1509 $text); |
| 1783 # deadsrc -- has disassembly, but with no samples | 1510 if ($l == $lastline) { printf("---\n"); } |
| 1784 # nop -- has no matching disasembly | |
| 1785 # Also emit an optional span containing disassembly. | |
| 1786 my $dis = $disasm{$l}; | |
| 1787 my $asm = ""; | |
| 1788 if (defined($dis) && $dis ne '') { | |
| 1789 $asm = "<span class=\"asm\">" . $dis . "</span>"; | |
| 1790 } | |
| 1791 my $source_class = (($n1 + $n2 > 0) | |
| 1792 ? "livesrc" | |
| 1793 : (($asm ne "") ? "deadsrc" : "nop")); | |
| 1794 printf $output ( | |
| 1795 "<span class=\"line\">%5d</span> " . | |
| 1796 "<span class=\"%s\">%6s %6s %s</span>%s\n", | |
| 1797 $l, $source_class, | |
| 1798 HtmlPrintNumber($n1), | |
| 1799 HtmlPrintNumber($n2), | |
| 1800 HtmlEscape($text), | |
| 1801 $asm); | |
| 1802 } else { | |
| 1803 printf $output( | |
| 1804 "%6s %6s %4d: %s\n", | |
| 1805 UnparseAlt($n1), | |
| 1806 UnparseAlt($n2), | |
| 1807 $l, | |
| 1808 $text); | |
| 1809 } | |
| 1810 if ($l == $lastline) { print $output $skip_marker; } | |
| 1811 }; | 1511 }; |
| 1812 } | 1512 } |
| 1813 close(FILE); | 1513 close(FILE); |
| 1814 if ($html) { | |
| 1815 print $output "</pre>\n"; | |
| 1816 } | |
| 1817 return 1; | |
| 1818 } | 1514 } |
| 1819 | 1515 |
| 1820 # Return the source line for the specified file/linenumber. | 1516 # Return the source line for the specified file/linenumber. |
| 1821 # Returns undef if not found. | 1517 # Returns undef if not found. |
| 1822 sub SourceLine { | 1518 sub SourceLine { |
| 1823 my $file = shift; | 1519 my $file = shift; |
| 1824 my $line = shift; | 1520 my $line = shift; |
| 1825 | 1521 |
| 1826 # Look in cache | 1522 # Look in cache |
| 1827 if (!defined($main::source_cache{$file})) { | 1523 if (!defined($main::source_cache{$file})) { |
| (...skipping 122 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 1950 printf("%6s %6s %5d: %s", | 1646 printf("%6s %6s %5d: %s", |
| 1951 UnparseAlt($flat_sum{$l}), | 1647 UnparseAlt($flat_sum{$l}), |
| 1952 UnparseAlt($cum_sum{$l}), | 1648 UnparseAlt($cum_sum{$l}), |
| 1953 $l, | 1649 $l, |
| 1954 $line); | 1650 $line); |
| 1955 } | 1651 } |
| 1956 | 1652 |
| 1957 # Print disassembly | 1653 # Print disassembly |
| 1958 for (my $x = $first_inst; $x <= $last_inst; $x++) { | 1654 for (my $x = $first_inst; $x <= $last_inst; $x++) { |
| 1959 my $e = $instructions[$x]; | 1655 my $e = $instructions[$x]; |
| 1656 my $address = $e->[0]; |
| 1657 $address = AddressSub($address, $offset); # Make relative to section |
| 1658 $address =~ s/^0x//; |
| 1659 $address =~ s/^0*//; |
| 1660 |
| 1661 # Trim symbols |
| 1662 my $d = $e->[3]; |
| 1663 while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax) |
| 1664 while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments |
| 1665 |
| 1960 printf("%6s %6s %8s: %6s\n", | 1666 printf("%6s %6s %8s: %6s\n", |
| 1961 UnparseAlt($flat_count[$x]), | 1667 UnparseAlt($flat_count[$x]), |
| 1962 UnparseAlt($cum_count[$x]), | 1668 UnparseAlt($cum_count[$x]), |
| 1963 UnparseAddress($offset, $e->[0]), | 1669 $address, |
| 1964 CleanDisassembly($e->[3])); | 1670 $d); |
| 1965 } | 1671 } |
| 1966 } | 1672 } |
| 1967 } | 1673 } |
| 1968 | 1674 |
| 1969 # Print DOT graph | 1675 # Print DOT graph |
| 1970 sub PrintDot { | 1676 sub PrintDot { |
| 1971 my $prog = shift; | 1677 my $prog = shift; |
| 1972 my $symbols = shift; | 1678 my $symbols = shift; |
| 1973 my $raw = shift; | 1679 my $raw = shift; |
| 1974 my $flat = shift; | 1680 my $flat = shift; |
| (...skipping 25 matching lines...) Expand all Loading... |
| 2000 } | 1706 } |
| 2001 | 1707 |
| 2002 if ($nodelimit > 0 || $edgelimit > 0) { | 1708 if ($nodelimit > 0 || $edgelimit > 0) { |
| 2003 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", | 1709 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", |
| 2004 Unparse($nodelimit), Units(), | 1710 Unparse($nodelimit), Units(), |
| 2005 Unparse($edgelimit), Units()); | 1711 Unparse($edgelimit), Units()); |
| 2006 } | 1712 } |
| 2007 | 1713 |
| 2008 # Open DOT output file | 1714 # Open DOT output file |
| 2009 my $output; | 1715 my $output; |
| 2010 my $escaped_dot = ShellEscape(@DOT); | |
| 2011 my $escaped_ps2pdf = ShellEscape(@PS2PDF); | |
| 2012 if ($main::opt_gv) { | 1716 if ($main::opt_gv) { |
| 2013 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "ps")); | 1717 $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps"); |
| 2014 $output = "| $escaped_dot -Tps2 >$escaped_outfile"; | |
| 2015 } elsif ($main::opt_evince) { | 1718 } elsif ($main::opt_evince) { |
| 2016 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "pdf")); | 1719 $output = "| $DOT -Tps2 | $PS2PDF - " . TempName($main::next_tmpfile, "pdf")
; |
| 2017 $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - $escaped_outfile"; | |
| 2018 } elsif ($main::opt_ps) { | 1720 } elsif ($main::opt_ps) { |
| 2019 $output = "| $escaped_dot -Tps2"; | 1721 $output = "| $DOT -Tps2"; |
| 2020 } elsif ($main::opt_pdf) { | 1722 } elsif ($main::opt_pdf) { |
| 2021 $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - -"; | 1723 $output = "| $DOT -Tps2 | $PS2PDF - -"; |
| 2022 } elsif ($main::opt_web || $main::opt_svg) { | 1724 } elsif ($main::opt_web || $main::opt_svg) { |
| 2023 # We need to post-process the SVG, so write to a temporary file always. | 1725 # We need to post-process the SVG, so write to a temporary file always. |
| 2024 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "svg")); | 1726 $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg"); |
| 2025 $output = "| $escaped_dot -Tsvg >$escaped_outfile"; | |
| 2026 } elsif ($main::opt_gif) { | 1727 } elsif ($main::opt_gif) { |
| 2027 $output = "| $escaped_dot -Tgif"; | 1728 $output = "| $DOT -Tgif"; |
| 2028 } else { | 1729 } else { |
| 2029 $output = ">&STDOUT"; | 1730 $output = ">&STDOUT"; |
| 2030 } | 1731 } |
| 2031 open(DOT, $output) || error("$output: $!\n"); | 1732 open(DOT, $output) || error("$output: $!\n"); |
| 2032 | 1733 |
| 2033 # Title | 1734 # Title |
| 2034 printf DOT ("digraph \"%s; %s %s\" {\n", | 1735 printf DOT ("digraph \"%s; %s %s\" {\n", |
| 2035 $prog, | 1736 $prog, |
| 2036 Unparse($overall_total), | 1737 Unparse($overall_total), |
| 2037 Units()); | 1738 Units()); |
| (...skipping 60 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2098 Percent($f, $local_total), | 1799 Percent($f, $local_total), |
| 2099 $extra, | 1800 $extra, |
| 2100 $fs, | 1801 $fs, |
| 2101 $style, | 1802 $style, |
| 2102 ); | 1803 ); |
| 2103 } | 1804 } |
| 2104 | 1805 |
| 2105 # Get edges and counts per edge | 1806 # Get edges and counts per edge |
| 2106 my %edge = (); | 1807 my %edge = (); |
| 2107 my $n; | 1808 my $n; |
| 2108 my $fullname_to_shortname_map = {}; | |
| 2109 FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map); | |
| 2110 foreach my $k (keys(%{$raw})) { | 1809 foreach my $k (keys(%{$raw})) { |
| 2111 # TODO: omit low %age edges | 1810 # TODO: omit low %age edges |
| 2112 $n = $raw->{$k}; | 1811 $n = $raw->{$k}; |
| 2113 my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); | 1812 my @translated = TranslateStack($symbols, $k); |
| 2114 for (my $i = 1; $i <= $#translated; $i++) { | 1813 for (my $i = 1; $i <= $#translated; $i++) { |
| 2115 my $src = $translated[$i]; | 1814 my $src = $translated[$i]; |
| 2116 my $dst = $translated[$i-1]; | 1815 my $dst = $translated[$i-1]; |
| 2117 #next if ($src eq $dst); # Avoid self-edges? | 1816 #next if ($src eq $dst); # Avoid self-edges? |
| 2118 if (exists($node{$src}) && exists($node{$dst})) { | 1817 if (exists($node{$src}) && exists($node{$dst})) { |
| 2119 my $edge_label = "$src\001$dst"; | 1818 my $edge_label = "$src\001$dst"; |
| 2120 if (!exists($edge{$edge_label})) { | 1819 if (!exists($edge{$edge_label})) { |
| 2121 $edge{$edge_label} = 0; | 1820 $edge{$edge_label} = 0; |
| 2122 } | 1821 } |
| 2123 $edge{$edge_label} += $n; | 1822 $edge{$edge_label} += $n; |
| (...skipping 363 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2487 if(state == 'pan' || state == 'move') { | 2186 if(state == 'pan' || state == 'move') { |
| 2488 // Quit pan mode | 2187 // Quit pan mode |
| 2489 state = ''; | 2188 state = ''; |
| 2490 } | 2189 } |
| 2491 } | 2190 } |
| 2492 | 2191 |
| 2493 ]]></script> | 2192 ]]></script> |
| 2494 EOF | 2193 EOF |
| 2495 } | 2194 } |
| 2496 | 2195 |
| 2497 # Provides a map from fullname to shortname for cases where the | |
| 2498 # shortname is ambiguous. The symlist has both the fullname and | |
| 2499 # shortname for all symbols, which is usually fine, but sometimes -- | |
| 2500 # such as overloaded functions -- two different fullnames can map to | |
| 2501 # the same shortname. In that case, we use the address of the | |
| 2502 # function to disambiguate the two. This function fills in a map that | |
| 2503 # maps fullnames to modified shortnames in such cases. If a fullname | |
| 2504 # is not present in the map, the 'normal' shortname provided by the | |
| 2505 # symlist is the appropriate one to use. | |
| 2506 sub FillFullnameToShortnameMap { | |
| 2507 my $symbols = shift; | |
| 2508 my $fullname_to_shortname_map = shift; | |
| 2509 my $shortnames_seen_once = {}; | |
| 2510 my $shortnames_seen_more_than_once = {}; | |
| 2511 | |
| 2512 foreach my $symlist (values(%{$symbols})) { | |
| 2513 # TODO(csilvers): deal with inlined symbols too. | |
| 2514 my $shortname = $symlist->[0]; | |
| 2515 my $fullname = $symlist->[2]; | |
| 2516 if ($fullname !~ /<[0-9a-fA-F]+>$/) { # fullname doesn't end in an address | |
| 2517 next; # the only collisions we care about are when addresses differ | |
| 2518 } | |
| 2519 if (defined($shortnames_seen_once->{$shortname}) && | |
| 2520 $shortnames_seen_once->{$shortname} ne $fullname) { | |
| 2521 $shortnames_seen_more_than_once->{$shortname} = 1; | |
| 2522 } else { | |
| 2523 $shortnames_seen_once->{$shortname} = $fullname; | |
| 2524 } | |
| 2525 } | |
| 2526 | |
| 2527 foreach my $symlist (values(%{$symbols})) { | |
| 2528 my $shortname = $symlist->[0]; | |
| 2529 my $fullname = $symlist->[2]; | |
| 2530 # TODO(csilvers): take in a list of addresses we care about, and only | |
| 2531 # store in the map if $symlist->[1] is in that list. Saves space. | |
| 2532 next if defined($fullname_to_shortname_map->{$fullname}); | |
| 2533 if (defined($shortnames_seen_more_than_once->{$shortname})) { | |
| 2534 if ($fullname =~ /<0*([^>]*)>$/) { # fullname has address at end of it | |
| 2535 $fullname_to_shortname_map->{$fullname} = "$shortname\@$1"; | |
| 2536 } | |
| 2537 } | |
| 2538 } | |
| 2539 } | |
| 2540 | |
| 2541 # Return a small number that identifies the argument. | 2196 # Return a small number that identifies the argument. |
| 2542 # Multiple calls with the same argument will return the same number. | 2197 # Multiple calls with the same argument will return the same number. |
| 2543 # Calls with different arguments will return different numbers. | 2198 # Calls with different arguments will return different numbers. |
| 2544 sub ShortIdFor { | 2199 sub ShortIdFor { |
| 2545 my $key = shift; | 2200 my $key = shift; |
| 2546 my $id = $main::uniqueid{$key}; | 2201 my $id = $main::uniqueid{$key}; |
| 2547 if (!defined($id)) { | 2202 if (!defined($id)) { |
| 2548 $id = keys(%main::uniqueid) + 1; | 2203 $id = keys(%main::uniqueid) + 1; |
| 2549 $main::uniqueid{$key} = $id; | 2204 $main::uniqueid{$key} = $id; |
| 2550 } | 2205 } |
| 2551 return $id; | 2206 return $id; |
| 2552 } | 2207 } |
| 2553 | 2208 |
| 2554 # Translate a stack of addresses into a stack of symbols | 2209 # Translate a stack of addresses into a stack of symbols |
| 2555 sub TranslateStack { | 2210 sub TranslateStack { |
| 2556 my $symbols = shift; | 2211 my $symbols = shift; |
| 2557 my $fullname_to_shortname_map = shift; | |
| 2558 my $k = shift; | 2212 my $k = shift; |
| 2559 | 2213 |
| 2560 my @addrs = split(/\n/, $k); | 2214 my @addrs = split(/\n/, $k); |
| 2561 my @result = (); | 2215 my @result = (); |
| 2562 for (my $i = 0; $i <= $#addrs; $i++) { | 2216 for (my $i = 0; $i <= $#addrs; $i++) { |
| 2563 my $a = $addrs[$i]; | 2217 my $a = $addrs[$i]; |
| 2564 | 2218 |
| 2565 # Skip large addresses since they sometimes show up as fake entries on RH9 | 2219 # Skip large addresses since they sometimes show up as fake entries on RH9 |
| 2566 if (length($a) > 8 && $a gt "7fffffffffffffff") { | 2220 if (length($a) > 8 && $a gt "7fffffffffffffff") { |
| 2567 next; | 2221 next; |
| (...skipping 11 matching lines...) Expand all Loading... |
| 2579 } | 2233 } |
| 2580 | 2234 |
| 2581 # We can have a sequence of symbols for a particular entry | 2235 # We can have a sequence of symbols for a particular entry |
| 2582 # (more than one symbol in the case of inlining). Callers | 2236 # (more than one symbol in the case of inlining). Callers |
| 2583 # come before callees in symlist, so walk backwards since | 2237 # come before callees in symlist, so walk backwards since |
| 2584 # the translated stack should contain callees before callers. | 2238 # the translated stack should contain callees before callers. |
| 2585 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { | 2239 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { |
| 2586 my $func = $symlist->[$j-2]; | 2240 my $func = $symlist->[$j-2]; |
| 2587 my $fileline = $symlist->[$j-1]; | 2241 my $fileline = $symlist->[$j-1]; |
| 2588 my $fullfunc = $symlist->[$j]; | 2242 my $fullfunc = $symlist->[$j]; |
| 2589 if (defined($fullname_to_shortname_map->{$fullfunc})) { | |
| 2590 $func = $fullname_to_shortname_map->{$fullfunc}; | |
| 2591 } | |
| 2592 if ($j > 2) { | 2243 if ($j > 2) { |
| 2593 $func = "$func (inline)"; | 2244 $func = "$func (inline)"; |
| 2594 } | 2245 } |
| 2595 | 2246 |
| 2596 # Do not merge nodes corresponding to Callback::Run since that | 2247 # Do not merge nodes corresponding to Callback::Run since that |
| 2597 # causes confusing cycles in dot display. Instead, we synthesize | 2248 # causes confusing cycles in dot display. Instead, we synthesize |
| 2598 # a unique name for this frame per caller. | 2249 # a unique name for this frame per caller. |
| 2599 if ($func =~ m/Callback.*::Run$/) { | 2250 if ($func =~ m/Callback.*::Run$/) { |
| 2600 my $caller = ($i > 0) ? $addrs[$i-1] : 0; | 2251 my $caller = ($i > 0) ? $addrs[$i-1] : 0; |
| 2601 $func = "Run#" . ShortIdFor($caller); | 2252 $func = "Run#" . ShortIdFor($caller); |
| (...skipping 66 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2668 # Alternate pretty-printed form: 0 maps to "." | 2319 # Alternate pretty-printed form: 0 maps to "." |
| 2669 sub UnparseAlt { | 2320 sub UnparseAlt { |
| 2670 my $num = shift; | 2321 my $num = shift; |
| 2671 if ($num == 0) { | 2322 if ($num == 0) { |
| 2672 return "."; | 2323 return "."; |
| 2673 } else { | 2324 } else { |
| 2674 return Unparse($num); | 2325 return Unparse($num); |
| 2675 } | 2326 } |
| 2676 } | 2327 } |
| 2677 | 2328 |
| 2678 # Alternate pretty-printed form: 0 maps to "" | |
| 2679 sub HtmlPrintNumber { | |
| 2680 my $num = shift; | |
| 2681 if ($num == 0) { | |
| 2682 return ""; | |
| 2683 } else { | |
| 2684 return Unparse($num); | |
| 2685 } | |
| 2686 } | |
| 2687 | |
| 2688 # Return output units | 2329 # Return output units |
| 2689 sub Units { | 2330 sub Units { |
| 2690 if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { | 2331 if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { |
| 2691 if ($main::opt_inuse_objects || $main::opt_alloc_objects) { | 2332 if ($main::opt_inuse_objects || $main::opt_alloc_objects) { |
| 2692 return "objects"; | 2333 return "objects"; |
| 2693 } else { | 2334 } else { |
| 2694 if ($main::opt_show_bytes) { | 2335 if ($main::opt_show_bytes) { |
| 2695 return "B"; | 2336 return "B"; |
| 2696 } else { | 2337 } else { |
| 2697 return "MB"; | 2338 return "MB"; |
| (...skipping 136 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2834 '::do_malloc_or_cpp_alloc', | 2475 '::do_malloc_or_cpp_alloc', |
| 2835 'DoSampledAllocation', | 2476 'DoSampledAllocation', |
| 2836 'simple_alloc::allocate', | 2477 'simple_alloc::allocate', |
| 2837 '__malloc_alloc_template::allocate', | 2478 '__malloc_alloc_template::allocate', |
| 2838 '__builtin_delete', | 2479 '__builtin_delete', |
| 2839 '__builtin_new', | 2480 '__builtin_new', |
| 2840 '__builtin_vec_delete', | 2481 '__builtin_vec_delete', |
| 2841 '__builtin_vec_new', | 2482 '__builtin_vec_new', |
| 2842 'operator new', | 2483 'operator new', |
| 2843 'operator new[]', | 2484 'operator new[]', |
| 2844 # The entry to our memory-allocation routines on OS X | |
| 2845 'malloc_zone_malloc', | |
| 2846 'malloc_zone_calloc', | |
| 2847 'malloc_zone_valloc', | |
| 2848 'malloc_zone_realloc', | |
| 2849 'malloc_zone_memalign', | |
| 2850 'malloc_zone_free', | |
| 2851 # These mark the beginning/end of our custom sections | 2485 # These mark the beginning/end of our custom sections |
| 2852 '__start_google_malloc', | 2486 '__start_google_malloc', |
| 2853 '__stop_google_malloc', | 2487 '__stop_google_malloc', |
| 2854 '__start_malloc_hook', | 2488 '__start_malloc_hook', |
| 2855 '__stop_malloc_hook') { | 2489 '__stop_malloc_hook') { |
| 2856 $skip{$name} = 1; | 2490 $skip{$name} = 1; |
| 2857 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything | 2491 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything |
| 2858 } | 2492 } |
| 2859 # TODO: Remove TCMalloc once everything has been | 2493 # TODO: Remove TCMalloc once everything has been |
| 2860 # moved into the tcmalloc:: namespace and we have flushed | 2494 # moved into the tcmalloc:: namespace and we have flushed |
| (...skipping 71 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 2932 AddEntry($result, $reduced_path, $count); | 2566 AddEntry($result, $reduced_path, $count); |
| 2933 } | 2567 } |
| 2934 return $result; | 2568 return $result; |
| 2935 } | 2569 } |
| 2936 | 2570 |
| 2937 # Reduce profile to granularity given by user | 2571 # Reduce profile to granularity given by user |
| 2938 sub ReduceProfile { | 2572 sub ReduceProfile { |
| 2939 my $symbols = shift; | 2573 my $symbols = shift; |
| 2940 my $profile = shift; | 2574 my $profile = shift; |
| 2941 my $result = {}; | 2575 my $result = {}; |
| 2942 my $fullname_to_shortname_map = {}; | |
| 2943 FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map); | |
| 2944 foreach my $k (keys(%{$profile})) { | 2576 foreach my $k (keys(%{$profile})) { |
| 2945 my $count = $profile->{$k}; | 2577 my $count = $profile->{$k}; |
| 2946 my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); | 2578 my @translated = TranslateStack($symbols, $k); |
| 2947 my @path = (); | 2579 my @path = (); |
| 2948 my %seen = (); | 2580 my %seen = (); |
| 2949 $seen{''} = 1; # So that empty keys are skipped | 2581 $seen{''} = 1; # So that empty keys are skipped |
| 2950 foreach my $e (@translated) { | 2582 foreach my $e (@translated) { |
| 2951 # To avoid double-counting due to recursion, skip a stack-trace | 2583 # To avoid double-counting due to recursion, skip a stack-trace |
| 2952 # entry if it has already been seen | 2584 # entry if it has already been seen |
| 2953 if (!$seen{$e}) { | 2585 if (!$seen{$e}) { |
| 2954 $seen{$e} = 1; | 2586 $seen{$e} = 1; |
| 2955 push(@path, $e); | 2587 push(@path, $e); |
| 2956 } | 2588 } |
| (...skipping 186 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3143 $pcs->{$pc} = 1; | 2775 $pcs->{$pc} = 1; |
| 3144 push @k, $pc; | 2776 push @k, $pc; |
| 3145 } | 2777 } |
| 3146 AddEntry($profile, (join "\n", @k), $count); | 2778 AddEntry($profile, (join "\n", @k), $count); |
| 3147 } | 2779 } |
| 3148 | 2780 |
| 3149 ##### Code to profile a server dynamically ##### | 2781 ##### Code to profile a server dynamically ##### |
| 3150 | 2782 |
| 3151 sub CheckSymbolPage { | 2783 sub CheckSymbolPage { |
| 3152 my $url = SymbolPageURL(); | 2784 my $url = SymbolPageURL(); |
| 3153 my $command = ShellEscape(@URL_FETCHER, $url); | 2785 open(SYMBOL, "$URL_FETCHER '$url' |"); |
| 3154 open(SYMBOL, "$command |") or error($command); | |
| 3155 my $line = <SYMBOL>; | 2786 my $line = <SYMBOL>; |
| 3156 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines | 2787 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines |
| 3157 close(SYMBOL); | 2788 close(SYMBOL); |
| 3158 unless (defined($line)) { | 2789 unless (defined($line)) { |
| 3159 error("$url doesn't exist\n"); | 2790 error("$url doesn't exist\n"); |
| 3160 } | 2791 } |
| 3161 | 2792 |
| 3162 if ($line =~ /^num_symbols:\s+(\d+)$/) { | 2793 if ($line =~ /^num_symbols:\s+(\d+)$/) { |
| 3163 if ($1 == 0) { | 2794 if ($1 == 0) { |
| 3164 error("Stripped binary. No symbols available.\n"); | 2795 error("Stripped binary. No symbols available.\n"); |
| (...skipping 36 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3201 | 2832 |
| 3202 # We fetch symbols from the first profile argument. | 2833 # We fetch symbols from the first profile argument. |
| 3203 sub SymbolPageURL { | 2834 sub SymbolPageURL { |
| 3204 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); | 2835 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); |
| 3205 return "$baseURL$SYMBOL_PAGE"; | 2836 return "$baseURL$SYMBOL_PAGE"; |
| 3206 } | 2837 } |
| 3207 | 2838 |
| 3208 sub FetchProgramName() { | 2839 sub FetchProgramName() { |
| 3209 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); | 2840 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); |
| 3210 my $url = "$baseURL$PROGRAM_NAME_PAGE"; | 2841 my $url = "$baseURL$PROGRAM_NAME_PAGE"; |
| 3211 my $command_line = ShellEscape(@URL_FETCHER, $url); | 2842 my $command_line = "$URL_FETCHER '$url'"; |
| 3212 open(CMDLINE, "$command_line |") or error($command_line); | 2843 open(CMDLINE, "$command_line |") or error($command_line); |
| 3213 my $cmdline = <CMDLINE>; | 2844 my $cmdline = <CMDLINE>; |
| 3214 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines | 2845 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines |
| 3215 close(CMDLINE); | 2846 close(CMDLINE); |
| 3216 error("Failed to get program name from $url\n") unless defined($cmdline); | 2847 error("Failed to get program name from $url\n") unless defined($cmdline); |
| 3217 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. | 2848 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. |
| 3218 $cmdline =~ s!\n!!g; # Remove LFs. | 2849 $cmdline =~ s!\n!!g; # Remove LFs. |
| 3219 return $cmdline; | 2850 return $cmdline; |
| 3220 } | 2851 } |
| 3221 | 2852 |
| 3222 # Gee, curl's -L (--location) option isn't reliable at least | 2853 # Gee, curl's -L (--location) option isn't reliable at least |
| 3223 # with its 7.12.3 version. Curl will forget to post data if | 2854 # with its 7.12.3 version. Curl will forget to post data if |
| 3224 # there is a redirection. This function is a workaround for | 2855 # there is a redirection. This function is a workaround for |
| 3225 # curl. Redirection happens on borg hosts. | 2856 # curl. Redirection happens on borg hosts. |
| 3226 sub ResolveRedirectionForCurl { | 2857 sub ResolveRedirectionForCurl { |
| 3227 my $url = shift; | 2858 my $url = shift; |
| 3228 my $command_line = ShellEscape(@URL_FETCHER, "--head", $url); | 2859 my $command_line = "$URL_FETCHER --head '$url'"; |
| 3229 open(CMDLINE, "$command_line |") or error($command_line); | 2860 open(CMDLINE, "$command_line |") or error($command_line); |
| 3230 while (<CMDLINE>) { | 2861 while (<CMDLINE>) { |
| 3231 s/\r//g; # turn windows-looking lines into unix-looking lines | 2862 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 3232 if (/^Location: (.*)/) { | 2863 if (/^Location: (.*)/) { |
| 3233 $url = $1; | 2864 $url = $1; |
| 3234 } | 2865 } |
| 3235 } | 2866 } |
| 3236 close(CMDLINE); | 2867 close(CMDLINE); |
| 3237 return $url; | 2868 return $url; |
| 3238 } | 2869 } |
| 3239 | 2870 |
| 3240 # Add a timeout flat to URL_FETCHER. Returns a new list. | 2871 # Add a timeout flat to URL_FETCHER |
| 3241 sub AddFetchTimeout { | 2872 sub AddFetchTimeout { |
| 2873 my $fetcher = shift; |
| 3242 my $timeout = shift; | 2874 my $timeout = shift; |
| 3243 my @fetcher = shift; | |
| 3244 if (defined($timeout)) { | 2875 if (defined($timeout)) { |
| 3245 if (join(" ", @fetcher) =~ m/\bcurl -s/) { | 2876 if ($fetcher =~ m/\bcurl -s/) { |
| 3246 push(@fetcher, "--max-time", sprintf("%d", $timeout)); | 2877 $fetcher .= sprintf(" --max-time %d", $timeout); |
| 3247 } elsif (join(" ", @fetcher) =~ m/\brpcget\b/) { | 2878 } elsif ($fetcher =~ m/\brpcget\b/) { |
| 3248 push(@fetcher, sprintf("--deadline=%d", $timeout)); | 2879 $fetcher .= sprintf(" --deadline=%d", $timeout); |
| 3249 } | 2880 } |
| 3250 } | 2881 } |
| 3251 return @fetcher; | 2882 return $fetcher; |
| 3252 } | 2883 } |
| 3253 | 2884 |
| 3254 # Reads a symbol map from the file handle name given as $1, returning | 2885 # Reads a symbol map from the file handle name given as $1, returning |
| 3255 # the resulting symbol map. Also processes variables relating to symbols. | 2886 # the resulting symbol map. Also processes variables relating to symbols. |
| 3256 # Currently, the only variable processed is 'binary=<value>' which updates | 2887 # Currently, the only variable processed is 'binary=<value>' which updates |
| 3257 # $main::prog to have the correct program name. | 2888 # $main::prog to have the correct program name. |
| 3258 sub ReadSymbols { | 2889 sub ReadSymbols { |
| 3259 my $in = shift; | 2890 my $in = shift; |
| 3260 my $map = {}; | 2891 my $map = {}; |
| 3261 while (<$in>) { | 2892 while (<$in>) { |
| (...skipping 39 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3301 if (!defined($symbol_map)) { | 2932 if (!defined($symbol_map)) { |
| 3302 my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); | 2933 my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); |
| 3303 | 2934 |
| 3304 open(POSTFILE, ">$main::tmpfile_sym"); | 2935 open(POSTFILE, ">$main::tmpfile_sym"); |
| 3305 print POSTFILE $post_data; | 2936 print POSTFILE $post_data; |
| 3306 close(POSTFILE); | 2937 close(POSTFILE); |
| 3307 | 2938 |
| 3308 my $url = SymbolPageURL(); | 2939 my $url = SymbolPageURL(); |
| 3309 | 2940 |
| 3310 my $command_line; | 2941 my $command_line; |
| 3311 if (join(" ", @URL_FETCHER) =~ m/\bcurl -s/) { | 2942 if ($URL_FETCHER =~ m/\bcurl -s/) { |
| 3312 $url = ResolveRedirectionForCurl($url); | 2943 $url = ResolveRedirectionForCurl($url); |
| 3313 $command_line = ShellEscape(@URL_FETCHER, "-d", "\@$main::tmpfile_sym", | 2944 $command_line = "$URL_FETCHER -d '\@$main::tmpfile_sym' '$url'"; |
| 3314 $url); | |
| 3315 } else { | 2945 } else { |
| 3316 $command_line = (ShellEscape(@URL_FETCHER, "--post", $url) | 2946 $command_line = "$URL_FETCHER --post '$url' < '$main::tmpfile_sym'"; |
| 3317 . " < " . ShellEscape($main::tmpfile_sym)); | |
| 3318 } | 2947 } |
| 3319 # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols. | 2948 # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols. |
| 3320 my $escaped_cppfilt = ShellEscape($obj_tool_map{"c++filt"}); | 2949 my $cppfilt = $obj_tool_map{"c++filt"}; |
| 3321 open(SYMBOL, "$command_line | $escaped_cppfilt |") or error($command_line); | 2950 open(SYMBOL, "$command_line | $cppfilt |") or error($command_line); |
| 3322 $symbol_map = ReadSymbols(*SYMBOL{IO}); | 2951 $symbol_map = ReadSymbols(*SYMBOL{IO}); |
| 3323 close(SYMBOL); | 2952 close(SYMBOL); |
| 3324 } | 2953 } |
| 3325 | 2954 |
| 3326 my $symbols = {}; | 2955 my $symbols = {}; |
| 3327 foreach my $pc (@pcs) { | 2956 foreach my $pc (@pcs) { |
| 3328 my $fullname; | 2957 my $fullname; |
| 3329 # For 64 bits binaries, symbols are extracted with 8 leading zeroes. | 2958 # For 64 bits binaries, symbols are extracted with 8 leading zeroes. |
| 3330 # Then /symbol reads the long symbols in as uint64, and outputs | 2959 # Then /symbol reads the long symbols in as uint64, and outputs |
| 3331 # the result with a "0x%08llx" format which get rid of the zeroes. | 2960 # the result with a "0x%08llx" format which get rid of the zeroes. |
| 3332 # By removing all the leading zeroes in both $pc and the symbols from | 2961 # By removing all the leading zeroes in both $pc and the symbols from |
| 3333 # /symbol, the symbols match and are retrievable from the map. | 2962 # /symbol, the symbols match and are retrievable from the map. |
| 3334 my $shortpc = $pc; | 2963 my $shortpc = $pc; |
| 3335 $shortpc =~ s/^0*//; | 2964 $shortpc =~ s/^0*//; |
| 3336 # Each line may have a list of names, which includes the function | 2965 # Each line may have a list of names, which includes the function |
| 3337 # and also other functions it has inlined. They are separated (in | 2966 # and also other functions it has inlined. They are separated |
| 3338 # PrintSymbolizedProfile), by --, which is illegal in function names. | 2967 # (in PrintSymbolizedFile), by --, which is illegal in function names. |
| 3339 my $fullnames; | 2968 my $fullnames; |
| 3340 if (defined($symbol_map->{$shortpc})) { | 2969 if (defined($symbol_map->{$shortpc})) { |
| 3341 $fullnames = $symbol_map->{$shortpc}; | 2970 $fullnames = $symbol_map->{$shortpc}; |
| 3342 } else { | 2971 } else { |
| 3343 $fullnames = "0x" . $pc; # Just use addresses | 2972 $fullnames = "0x" . $pc; # Just use addresses |
| 3344 } | 2973 } |
| 3345 my $sym = []; | 2974 my $sym = []; |
| 3346 $symbols->{$pc} = $sym; | 2975 $symbols->{$pc} = $sym; |
| 3347 foreach my $fullname (split("--", $fullnames)) { | 2976 foreach my $fullname (split("--", $fullnames)) { |
| 3348 my $name = ShortFunctionName($fullname); | 2977 my $name = ShortFunctionName($fullname); |
| (...skipping 57 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3406 mkdir($profile_dir) | 3035 mkdir($profile_dir) |
| 3407 || die("Unable to create profile directory $profile_dir: $!\n"); | 3036 || die("Unable to create profile directory $profile_dir: $!\n"); |
| 3408 } | 3037 } |
| 3409 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; | 3038 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; |
| 3410 my $real_profile = "$profile_dir/$profile_file"; | 3039 my $real_profile = "$profile_dir/$profile_file"; |
| 3411 | 3040 |
| 3412 if ($fetch_name_only > 0) { | 3041 if ($fetch_name_only > 0) { |
| 3413 return $real_profile; | 3042 return $real_profile; |
| 3414 } | 3043 } |
| 3415 | 3044 |
| 3416 my @fetcher = AddFetchTimeout($fetch_timeout, @URL_FETCHER); | 3045 my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout); |
| 3417 my $cmd = ShellEscape(@fetcher, $url) . " > " . ShellEscape($tmp_profile); | 3046 my $cmd = "$fetcher '$url' > '$tmp_profile'"; |
| 3418 if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){ | 3047 if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){ |
| 3419 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon
ds to\n ${real_profile}\n"; | 3048 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon
ds to\n ${real_profile}\n"; |
| 3420 if ($encourage_patience) { | 3049 if ($encourage_patience) { |
| 3421 print STDERR "Be patient...\n"; | 3050 print STDERR "Be patient...\n"; |
| 3422 } | 3051 } |
| 3423 } else { | 3052 } else { |
| 3424 print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; | 3053 print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; |
| 3425 } | 3054 } |
| 3426 | 3055 |
| 3427 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); | 3056 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); |
| 3428 (system("mv", $tmp_profile, $real_profile) == 0) || error("Unable to rename
profile\n"); | 3057 (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename pr
ofile\n"); |
| 3429 print STDERR "Wrote profile to $real_profile\n"; | 3058 print STDERR "Wrote profile to $real_profile\n"; |
| 3430 $main::collected_profile = $real_profile; | 3059 $main::collected_profile = $real_profile; |
| 3431 return $main::collected_profile; | 3060 return $main::collected_profile; |
| 3432 } | 3061 } |
| 3433 } | 3062 } |
| 3434 | 3063 |
| 3435 # Collect profiles in parallel | 3064 # Collect profiles in parallel |
| 3436 sub FetchDynamicProfiles { | 3065 sub FetchDynamicProfiles { |
| 3437 my $items = scalar(@main::pfile_args); | 3066 my $items = scalar(@main::pfile_args); |
| 3438 my $levels = log($items) / log(2); | 3067 my $levels = log($items) / log(2); |
| (...skipping 93 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3532 @$slots = unpack($self->{unpack_code} . "*", $str); | 3161 @$slots = unpack($self->{unpack_code} . "*", $str); |
| 3533 } else { | 3162 } else { |
| 3534 # If we're a 64-bit profile, check if we're a 64-bit-capable | 3163 # If we're a 64-bit profile, check if we're a 64-bit-capable |
| 3535 # perl. Otherwise, each slot will be represented as a float | 3164 # perl. Otherwise, each slot will be represented as a float |
| 3536 # instead of an int64, losing precision and making all the | 3165 # instead of an int64, losing precision and making all the |
| 3537 # 64-bit addresses wrong. We won't complain yet, but will | 3166 # 64-bit addresses wrong. We won't complain yet, but will |
| 3538 # later if we ever see a value that doesn't fit in 32 bits. | 3167 # later if we ever see a value that doesn't fit in 32 bits. |
| 3539 my $has_q = 0; | 3168 my $has_q = 0; |
| 3540 eval { $has_q = pack("Q", "1") ? 1 : 1; }; | 3169 eval { $has_q = pack("Q", "1") ? 1 : 1; }; |
| 3541 if (!$has_q) { | 3170 if (!$has_q) { |
| 3542 $self->{perl_is_64bit} = 0; | 3171 » $self->{perl_is_64bit} = 0; |
| 3543 } | 3172 } |
| 3544 read($self->{file}, $str, 8); | 3173 read($self->{file}, $str, 8); |
| 3545 if (substr($str, 4, 4) eq chr(0)x4) { | 3174 if (substr($str, 4, 4) eq chr(0)x4) { |
| 3546 # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. | 3175 # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. |
| 3547 $self->{unpack_code} = 'V'; # Little-endian. | 3176 $self->{unpack_code} = 'V'; # Little-endian. |
| 3548 } elsif (substr($str, 0, 4) eq chr(0)x4) { | 3177 } elsif (substr($str, 0, 4) eq chr(0)x4) { |
| 3549 $self->{unpack_code} = 'N'; # Big-endian | 3178 $self->{unpack_code} = 'N'; # Big-endian |
| 3550 } else { | 3179 } else { |
| 3551 ::error("$fname: header size >= 2**32\n"); | 3180 ::error("$fname: header size >= 2**32\n"); |
| 3552 } | 3181 } |
| (...skipping 15 matching lines...) Expand all Loading... |
| 3568 # This is the easy case: unpack provides 32-bit unpacking primitives. | 3197 # This is the easy case: unpack provides 32-bit unpacking primitives. |
| 3569 @$slots = unpack($self->{unpack_code} . "*", $str); | 3198 @$slots = unpack($self->{unpack_code} . "*", $str); |
| 3570 } else { | 3199 } else { |
| 3571 # We need to unpack 32 bits at a time and combine. | 3200 # We need to unpack 32 bits at a time and combine. |
| 3572 my @b32_values = unpack($self->{unpack_code} . "*", $str); | 3201 my @b32_values = unpack($self->{unpack_code} . "*", $str); |
| 3573 my @b64_values = (); | 3202 my @b64_values = (); |
| 3574 for (my $i = 0; $i < $#b32_values; $i += 2) { | 3203 for (my $i = 0; $i < $#b32_values; $i += 2) { |
| 3575 # TODO(csilvers): if this is a 32-bit perl, the math below | 3204 # TODO(csilvers): if this is a 32-bit perl, the math below |
| 3576 # could end up in a too-large int, which perl will promote | 3205 # could end up in a too-large int, which perl will promote |
| 3577 # to a double, losing necessary precision. Deal with that. | 3206 # to a double, losing necessary precision. Deal with that. |
| 3578 # Right now, we just die. | 3207 » # Right now, we just die. |
| 3579 my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); | 3208 » my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); |
| 3580 if ($self->{unpack_code} eq 'N') { # big-endian | 3209 if ($self->{unpack_code} eq 'N') { # big-endian |
| 3581 ($lo, $hi) = ($hi, $lo); | 3210 » ($lo, $hi) = ($hi, $lo); |
| 3582 } | 3211 » } |
| 3583 my $value = $lo + $hi * (2**32); | 3212 » my $value = $lo + $hi * (2**32); |
| 3584 if (!$self->{perl_is_64bit} && # check value is exactly represented | 3213 » if (!$self->{perl_is_64bit} && # check value is exactly represented |
| 3585 (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { | 3214 » (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { |
| 3586 ::error("Need a 64-bit perl to process this 64-bit profile.\n"); | 3215 » ::error("Need a 64-bit perl to process this 64-bit profile.\n"); |
| 3587 } | 3216 » } |
| 3588 push(@b64_values, $value); | 3217 » push(@b64_values, $value); |
| 3589 } | 3218 } |
| 3590 @$slots = @b64_values; | 3219 @$slots = @b64_values; |
| 3591 } | 3220 } |
| 3592 } | 3221 } |
| 3593 | 3222 |
| 3594 # Access the i-th long in the file (logically), or -1 at EOF. | 3223 # Access the i-th long in the file (logically), or -1 at EOF. |
| 3595 sub get { | 3224 sub get { |
| 3596 my ($self, $idx) = @_; | 3225 my ($self, $idx) = @_; |
| 3597 my $slots = $self->{slots}; | 3226 my $slots = $self->{slots}; |
| 3598 while ($#$slots >= 0) { | 3227 while ($#$slots >= 0) { |
| (...skipping 107 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 3706 if (!defined($header)) { # means "at EOF" | 3335 if (!defined($header)) { # means "at EOF" |
| 3707 error("Profile is empty.\n"); | 3336 error("Profile is empty.\n"); |
| 3708 } | 3337 } |
| 3709 | 3338 |
| 3710 my $symbols; | 3339 my $symbols; |
| 3711 if ($header =~ m/^--- *$symbol_marker/o) { | 3340 if ($header =~ m/^--- *$symbol_marker/o) { |
| 3712 # Verify that the user asked for a symbolized profile | 3341 # Verify that the user asked for a symbolized profile |
| 3713 if (!$main::use_symbolized_profile) { | 3342 if (!$main::use_symbolized_profile) { |
| 3714 # we have both a binary and symbolized profiles, abort | 3343 # we have both a binary and symbolized profiles, abort |
| 3715 error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " . | 3344 error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " . |
| 3716 "a binary arg. Try again without passing\n $prog\n"); | 3345 » "a binary arg. Try again without passing\n $prog\n"); |
| 3717 } | 3346 } |
| 3718 # Read the symbol section of the symbolized profile file. | 3347 # Read the symbol section of the symbolized profile file. |
| 3719 $symbols = ReadSymbols(*PROFILE{IO}); | 3348 $symbols = ReadSymbols(*PROFILE{IO}); |
| 3720 # Read the next line to get the header for the remaining profile. | 3349 # Read the next line to get the header for the remaining profile. |
| 3721 $header = ReadProfileHeader(*PROFILE) || ""; | 3350 $header = ReadProfileHeader(*PROFILE) || ""; |
| 3722 } | 3351 } |
| 3723 | 3352 |
| 3724 $main::profile_type = ''; | 3353 $main::profile_type = ''; |
| 3725 if ($header =~ m/^heap profile:.*$growth_marker/o) { | 3354 if ($header =~ m/^heap profile:.*$growth_marker/o) { |
| 3726 $main::profile_type = 'growth'; | 3355 $main::profile_type = 'growth'; |
| (...skipping 280 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 4007 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { | 3636 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { |
| 4008 my $stack = $5; | 3637 my $stack = $5; |
| 4009 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); | 3638 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); |
| 4010 | 3639 |
| 4011 if ($sample_adjustment) { | 3640 if ($sample_adjustment) { |
| 4012 if ($sampling_algorithm == 2) { | 3641 if ($sampling_algorithm == 2) { |
| 4013 # Remote-heap version 2 | 3642 # Remote-heap version 2 |
| 4014 # The sampling frequency is the rate of a Poisson process. | 3643 # The sampling frequency is the rate of a Poisson process. |
| 4015 # This means that the probability of sampling an allocation of | 3644 # This means that the probability of sampling an allocation of |
| 4016 # size X with sampling rate Y is 1 - exp(-X/Y) | 3645 # size X with sampling rate Y is 1 - exp(-X/Y) |
| 4017 if ($n1 != 0) { | 3646 » if ($n1 != 0) { |
| 4018 my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); | 3647 » my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); |
| 4019 my $scale_factor = 1/(1 - exp(-$ratio)); | 3648 » my $scale_factor = 1/(1 - exp(-$ratio)); |
| 4020 $n1 *= $scale_factor; | 3649 » $n1 *= $scale_factor; |
| 4021 $s1 *= $scale_factor; | 3650 » $s1 *= $scale_factor; |
| 4022 } | 3651 » } |
| 4023 if ($n2 != 0) { | 3652 » if ($n2 != 0) { |
| 4024 my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); | 3653 » my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); |
| 4025 my $scale_factor = 1/(1 - exp(-$ratio)); | 3654 » my $scale_factor = 1/(1 - exp(-$ratio)); |
| 4026 $n2 *= $scale_factor; | 3655 » $n2 *= $scale_factor; |
| 4027 $s2 *= $scale_factor; | 3656 » $s2 *= $scale_factor; |
| 4028 } | 3657 » } |
| 4029 } else { | 3658 } else { |
| 4030 # Remote-heap version 1 | 3659 # Remote-heap version 1 |
| 4031 my $ratio; | 3660 my $ratio; |
| 4032 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); | 3661 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); |
| 4033 if ($ratio < 1) { | 3662 if ($ratio < 1) { |
| 4034 $n1 /= $ratio; | 3663 $n1 /= $ratio; |
| 4035 $s1 /= $ratio; | 3664 $s1 /= $ratio; |
| 4036 } | 3665 } |
| 4037 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); | 3666 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); |
| 4038 if ($ratio < 1) { | 3667 if ($ratio < 1) { |
| (...skipping 103 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 4142 | 3771 |
| 4143 my $r = {}; | 3772 my $r = {}; |
| 4144 $r->{version} = 0; | 3773 $r->{version} = 0; |
| 4145 $r->{period} = $sampling_period; | 3774 $r->{period} = $sampling_period; |
| 4146 $r->{profile} = $profile; | 3775 $r->{profile} = $profile; |
| 4147 $r->{libs} = ParseLibraries($prog, $map, $pcs); | 3776 $r->{libs} = ParseLibraries($prog, $map, $pcs); |
| 4148 $r->{pcs} = $pcs; | 3777 $r->{pcs} = $pcs; |
| 4149 return $r; | 3778 return $r; |
| 4150 } | 3779 } |
| 4151 | 3780 |
| 4152 # Given a hex value in the form "0x1abcd" or "1abcd", return either | 3781 # Given a hex value in the form "0x1abcd" return "0001abcd" or |
| 4153 # "0001abcd" or "000000000001abcd", depending on the current (global) | 3782 # "000000000001abcd", depending on the current address length. |
| 4154 # address length. | 3783 # There's probably a more idiomatic (or faster) way to do this... |
| 4155 sub HexExtend { | 3784 sub HexExtend { |
| 4156 my $addr = shift; | 3785 my $addr = shift; |
| 4157 | 3786 |
| 4158 $addr =~ s/^(0x)?0*//; | 3787 $addr =~ s/^0x//; |
| 4159 my $zeros_needed = $address_length - length($addr); | 3788 |
| 4160 if ($zeros_needed < 0) { | 3789 if (length $addr > $address_length) { |
| 4161 printf STDERR "Warning: address $addr is longer than address length $address
_length\n"; | 3790 printf STDERR "Warning: address $addr is longer than address length $addres
s_length\n"; |
| 4162 return $addr; | |
| 4163 } | 3791 } |
| 4164 return ("0" x $zeros_needed) . $addr; | 3792 |
| 3793 return substr("000000000000000".$addr, -$address_length); |
| 4165 } | 3794 } |
| 4166 | 3795 |
| 4167 ##### Symbol extraction ##### | 3796 ##### Symbol extraction ##### |
| 4168 | 3797 |
| 4169 # Aggressively search the lib_prefix values for the given library | 3798 # Aggressively search the lib_prefix values for the given library |
| 4170 # If all else fails, just return the name of the library unmodified. | 3799 # If all else fails, just return the name of the library unmodified. |
| 4171 # If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so" | 3800 # If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so" |
| 4172 # it will search the following locations in this order, until it finds a file: | 3801 # it will search the following locations in this order, until it finds a file: |
| 4173 # /my/path/lib/dir/mylib.so | 3802 # /my/path/lib/dir/mylib.so |
| 4174 # /other/path/lib/dir/mylib.so | 3803 # /other/path/lib/dir/mylib.so |
| (...skipping 30 matching lines...) Expand all Loading... |
| 4205 | 3834 |
| 4206 # Parse text section header of a library using objdump | 3835 # Parse text section header of a library using objdump |
| 4207 sub ParseTextSectionHeaderFromObjdump { | 3836 sub ParseTextSectionHeaderFromObjdump { |
| 4208 my $lib = shift; | 3837 my $lib = shift; |
| 4209 | 3838 |
| 4210 my $size = undef; | 3839 my $size = undef; |
| 4211 my $vma; | 3840 my $vma; |
| 4212 my $file_offset; | 3841 my $file_offset; |
| 4213 # Get objdump output from the library file to figure out how to | 3842 # Get objdump output from the library file to figure out how to |
| 4214 # map between mapped addresses and addresses in the library. | 3843 # map between mapped addresses and addresses in the library. |
| 4215 my $cmd = ShellEscape($obj_tool_map{"objdump"}, "-h", $lib); | 3844 my $objdump = $obj_tool_map{"objdump"}; |
| 4216 open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); | 3845 open(OBJDUMP, "$objdump -h $lib |") |
| 3846 || error("$objdump $lib: $!\n"); |
| 4217 while (<OBJDUMP>) { | 3847 while (<OBJDUMP>) { |
| 4218 s/\r//g; # turn windows-looking lines into unix-looking lines | 3848 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 4219 # Idx Name Size VMA LMA File off Algn | 3849 # Idx Name Size VMA LMA File off Algn |
| 4220 # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4 | 3850 # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4 |
| 4221 # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file | 3851 # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file |
| 4222 # offset may still be 8. But AddressSub below will still handle that. | 3852 # offset may still be 8. But AddressSub below will still handle that. |
| 4223 my @x = split; | 3853 my @x = split; |
| 4224 if (($#x >= 6) && ($x[1] eq '.text')) { | 3854 if (($#x >= 6) && ($x[1] eq '.text')) { |
| 4225 $size = $x[2]; | 3855 $size = $x[2]; |
| 4226 $vma = $x[3]; | 3856 $vma = $x[3]; |
| (...skipping 17 matching lines...) Expand all Loading... |
| 4244 | 3874 |
| 4245 # Parse text section header of a library using otool (on OS X) | 3875 # Parse text section header of a library using otool (on OS X) |
| 4246 sub ParseTextSectionHeaderFromOtool { | 3876 sub ParseTextSectionHeaderFromOtool { |
| 4247 my $lib = shift; | 3877 my $lib = shift; |
| 4248 | 3878 |
| 4249 my $size = undef; | 3879 my $size = undef; |
| 4250 my $vma = undef; | 3880 my $vma = undef; |
| 4251 my $file_offset = undef; | 3881 my $file_offset = undef; |
| 4252 # Get otool output from the library file to figure out how to | 3882 # Get otool output from the library file to figure out how to |
| 4253 # map between mapped addresses and addresses in the library. | 3883 # map between mapped addresses and addresses in the library. |
| 4254 my $command = ShellEscape($obj_tool_map{"otool"}, "-l", $lib); | 3884 my $otool = $obj_tool_map{"otool"}; |
| 4255 open(OTOOL, "$command |") || error("$command: $!\n"); | 3885 open(OTOOL, "$otool -l $lib |") |
| 3886 || error("$otool $lib: $!\n"); |
| 4256 my $cmd = ""; | 3887 my $cmd = ""; |
| 4257 my $sectname = ""; | 3888 my $sectname = ""; |
| 4258 my $segname = ""; | 3889 my $segname = ""; |
| 4259 foreach my $line (<OTOOL>) { | 3890 foreach my $line (<OTOOL>) { |
| 4260 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines | 3891 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines |
| 4261 # Load command <#> | 3892 # Load command <#> |
| 4262 # cmd LC_SEGMENT | 3893 # cmd LC_SEGMENT |
| 4263 # [...] | 3894 # [...] |
| 4264 # Section | 3895 # Section |
| 4265 # sectname __text | 3896 # sectname __text |
| (...skipping 321 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 4587 my $libname = $lib->[0]; | 4218 my $libname = $lib->[0]; |
| 4588 my $start = $lib->[1]; | 4219 my $start = $lib->[1]; |
| 4589 my $finish = $lib->[2]; | 4220 my $finish = $lib->[2]; |
| 4590 my $offset = $lib->[3]; | 4221 my $offset = $lib->[3]; |
| 4591 | 4222 |
| 4592 # Get list of pcs that belong in this library. | 4223 # Get list of pcs that belong in this library. |
| 4593 my $contained = []; | 4224 my $contained = []; |
| 4594 my ($start_pc_index, $finish_pc_index); | 4225 my ($start_pc_index, $finish_pc_index); |
| 4595 # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index]. | 4226 # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index]. |
| 4596 for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; | 4227 for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; |
| 4597 $finish_pc_index--) { | 4228 » $finish_pc_index--) { |
| 4598 last if $pcs[$finish_pc_index - 1] le $finish; | 4229 last if $pcs[$finish_pc_index - 1] le $finish; |
| 4599 } | 4230 } |
| 4600 # Find smallest start_pc_index such that $start <= $pc[$start_pc_index]. | 4231 # Find smallest start_pc_index such that $start <= $pc[$start_pc_index]. |
| 4601 for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; | 4232 for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; |
| 4602 $start_pc_index--) { | 4233 » $start_pc_index--) { |
| 4603 last if $pcs[$start_pc_index - 1] lt $start; | 4234 last if $pcs[$start_pc_index - 1] lt $start; |
| 4604 } | 4235 } |
| 4605 # This keeps PC values higher than $pc[$finish_pc_index] in @pcs, | 4236 # This keeps PC values higher than $pc[$finish_pc_index] in @pcs, |
| 4606 # in case there are overlaps in libraries and the main binary. | 4237 # in case there are overlaps in libraries and the main binary. |
| 4607 @{$contained} = splice(@pcs, $start_pc_index, | 4238 @{$contained} = splice(@pcs, $start_pc_index, |
| 4608 $finish_pc_index - $start_pc_index); | 4239 » » » $finish_pc_index - $start_pc_index); |
| 4609 # Map to symbols | 4240 # Map to symbols |
| 4610 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); | 4241 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); |
| 4611 } | 4242 } |
| 4612 | 4243 |
| 4613 return $symbols; | 4244 return $symbols; |
| 4614 } | 4245 } |
| 4615 | 4246 |
| 4616 # Map list of PC values to symbols for a given image | 4247 # Map list of PC values to symbols for a given image |
| 4617 sub MapToSymbols { | 4248 sub MapToSymbols { |
| 4618 my $image = shift; | 4249 my $image = shift; |
| 4619 my $offset = shift; | 4250 my $offset = shift; |
| 4620 my $pclist = shift; | 4251 my $pclist = shift; |
| 4621 my $symbols = shift; | 4252 my $symbols = shift; |
| 4622 | 4253 |
| 4623 my $debug = 0; | 4254 my $debug = 0; |
| 4624 | 4255 |
| 4625 # Ignore empty binaries | 4256 # Ignore empty binaries |
| 4626 if ($#{$pclist} < 0) { return; } | 4257 if ($#{$pclist} < 0) { return; } |
| 4627 | 4258 |
| 4628 # Figure out the addr2line command to use | 4259 # Figure out the addr2line command to use |
| 4629 my $addr2line = $obj_tool_map{"addr2line"}; | 4260 my $addr2line = $obj_tool_map{"addr2line"}; |
| 4630 my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image); | 4261 my $cmd = "$addr2line -f -C -e $image"; |
| 4631 if (exists $obj_tool_map{"addr2line_pdb"}) { | 4262 if (exists $obj_tool_map{"addr2line_pdb"}) { |
| 4632 $addr2line = $obj_tool_map{"addr2line_pdb"}; | 4263 $addr2line = $obj_tool_map{"addr2line_pdb"}; |
| 4633 $cmd = ShellEscape($addr2line, "--demangle", "-f", "-C", "-e", $image); | 4264 $cmd = "$addr2line --demangle -f -C -e $image"; |
| 4634 } | 4265 } |
| 4635 | 4266 |
| 4636 # If "addr2line" isn't installed on the system at all, just use | 4267 # If "addr2line" isn't installed on the system at all, just use |
| 4637 # nm to get what info we can (function names, but not line numbers). | 4268 # nm to get what info we can (function names, but not line numbers). |
| 4638 if (system(ShellEscape($addr2line, "--help") . " >$dev_null 2>&1") != 0) { | 4269 if (system("$addr2line --help >$dev_null 2>&1") != 0) { |
| 4639 MapSymbolsWithNM($image, $offset, $pclist, $symbols); | 4270 MapSymbolsWithNM($image, $offset, $pclist, $symbols); |
| 4640 return; | 4271 return; |
| 4641 } | 4272 } |
| 4642 | 4273 |
| 4643 # "addr2line -i" can produce a variable number of lines per input | 4274 # "addr2line -i" can produce a variable number of lines per input |
| 4644 # address, with no separator that allows us to tell when data for | 4275 # address, with no separator that allows us to tell when data for |
| 4645 # the next address starts. So we find the address for a special | 4276 # the next address starts. So we find the address for a special |
| 4646 # symbol (_fini) and interleave this address between all real | 4277 # symbol (_fini) and interleave this address between all real |
| 4647 # addresses passed to addr2line. The name of this special symbol | 4278 # addresses passed to addr2line. The name of this special symbol |
| 4648 # can then be used as a separator. | 4279 # can then be used as a separator. |
| 4649 $sep_address = undef; # May be filled in by MapSymbolsWithNM() | 4280 $sep_address = undef; # May be filled in by MapSymbolsWithNM() |
| 4650 my $nm_symbols = {}; | 4281 my $nm_symbols = {}; |
| 4651 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); | 4282 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); |
| 4283 # TODO(csilvers): only add '-i' if addr2line supports it. |
| 4652 if (defined($sep_address)) { | 4284 if (defined($sep_address)) { |
| 4653 # Only add " -i" to addr2line if the binary supports it. | 4285 # Only add " -i" to addr2line if the binary supports it. |
| 4654 # addr2line --help returns 0, but not if it sees an unknown flag first. | 4286 # addr2line --help returns 0, but not if it sees an unknown flag first. |
| 4655 if (system("$cmd -i --help >$dev_null 2>&1") == 0) { | 4287 if (system("$cmd -i --help >$dev_null 2>&1") == 0) { |
| 4656 $cmd .= " -i"; | 4288 $cmd .= " -i"; |
| 4657 } else { | 4289 } else { |
| 4658 $sep_address = undef; # no need for sep_address if we don't support -i | 4290 $sep_address = undef; # no need for sep_address if we don't support -i |
| 4659 } | 4291 } |
| 4660 } | 4292 } |
| 4661 | 4293 |
| 4662 # Make file with all PC values with intervening 'sep_address' so | 4294 # Make file with all PC values with intervening 'sep_address' so |
| 4663 # that we can reliably detect the end of inlined function list | 4295 # that we can reliably detect the end of inlined function list |
| 4664 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); | 4296 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); |
| 4665 if ($debug) { print("---- $image ---\n"); } | 4297 if ($debug) { print("---- $image ---\n"); } |
| 4666 for (my $i = 0; $i <= $#{$pclist}; $i++) { | 4298 for (my $i = 0; $i <= $#{$pclist}; $i++) { |
| 4667 # addr2line always reads hex addresses, and does not need '0x' prefix. | 4299 # addr2line always reads hex addresses, and does not need '0x' prefix. |
| 4668 if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); } | 4300 if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); } |
| 4669 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset)); | 4301 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset)); |
| 4670 if (defined($sep_address)) { | 4302 if (defined($sep_address)) { |
| 4671 printf ADDRESSES ("%s\n", $sep_address); | 4303 printf ADDRESSES ("%s\n", $sep_address); |
| 4672 } | 4304 } |
| 4673 } | 4305 } |
| 4674 close(ADDRESSES); | 4306 close(ADDRESSES); |
| 4675 if ($debug) { | 4307 if ($debug) { |
| 4676 print("----\n"); | 4308 print("----\n"); |
| 4677 system("cat", $main::tmpfile_sym); | 4309 system("cat $main::tmpfile_sym"); |
| 4678 print("----\n"); | 4310 print("----\n"); |
| 4679 system("$cmd < " . ShellEscape($main::tmpfile_sym)); | 4311 system("$cmd <$main::tmpfile_sym"); |
| 4680 print("----\n"); | 4312 print("----\n"); |
| 4681 } | 4313 } |
| 4682 | 4314 |
| 4683 open(SYMBOLS, "$cmd <" . ShellEscape($main::tmpfile_sym) . " |") | 4315 open(SYMBOLS, "$cmd <$main::tmpfile_sym |") || error("$cmd: $!\n"); |
| 4684 || error("$cmd: $!\n"); | |
| 4685 my $count = 0; # Index in pclist | 4316 my $count = 0; # Index in pclist |
| 4686 while (<SYMBOLS>) { | 4317 while (<SYMBOLS>) { |
| 4687 # Read fullfunction and filelineinfo from next pair of lines | 4318 # Read fullfunction and filelineinfo from next pair of lines |
| 4688 s/\r?\n$//g; | 4319 s/\r?\n$//g; |
| 4689 my $fullfunction = $_; | 4320 my $fullfunction = $_; |
| 4690 $_ = <SYMBOLS>; | 4321 $_ = <SYMBOLS>; |
| 4691 s/\r?\n$//g; | 4322 s/\r?\n$//g; |
| 4692 my $filelinenum = $_; | 4323 my $filelinenum = $_; |
| 4693 | 4324 |
| 4694 if (defined($sep_address) && $fullfunction eq $sep_symbol) { | 4325 if (defined($sep_address) && $fullfunction eq $sep_symbol) { |
| 4695 # Terminating marker for data for this address | 4326 # Terminating marker for data for this address |
| 4696 $count++; | 4327 $count++; |
| 4697 next; | 4328 next; |
| 4698 } | 4329 } |
| 4699 | 4330 |
| 4700 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths | 4331 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths |
| 4701 | 4332 |
| 4702 my $pcstr = $pclist->[$count]; | 4333 my $pcstr = $pclist->[$count]; |
| 4703 my $function = ShortFunctionName($fullfunction); | 4334 my $function = ShortFunctionName($fullfunction); |
| 4704 my $nms = $nm_symbols->{$pcstr}; | 4335 if ($fullfunction eq '??') { |
| 4705 if (defined($nms)) { | 4336 # See if nm found a symbol |
| 4706 if ($fullfunction eq '??') { | 4337 my $nms = $nm_symbols->{$pcstr}; |
| 4707 # nm found a symbol for us. | 4338 if (defined($nms)) { |
| 4708 $function = $nms->[0]; | 4339 $function = $nms->[0]; |
| 4709 $fullfunction = $nms->[2]; | 4340 $fullfunction = $nms->[2]; |
| 4710 } else { | |
| 4711 # MapSymbolsWithNM tags each routine with its starting address, | |
| 4712 # useful in case the image has multiple occurrences of this | |
| 4713 # routine. (It uses a syntax that resembles template paramters, | |
| 4714 # that are automatically stripped out by ShortFunctionName().) | |
| 4715 # addr2line does not provide the same information. So we check | |
| 4716 # if nm disambiguated our symbol, and if so take the annotated | |
| 4717 # (nm) version of the routine-name. TODO(csilvers): this won't | |
| 4718 # catch overloaded, inlined symbols, which nm doesn't see. | |
| 4719 # Better would be to do a check similar to nm's, in this fn. | |
| 4720 if ($nms->[2] =~ m/^\Q$function\E/) { # sanity check it's the right fn | |
| 4721 $function = $nms->[0]; | |
| 4722 $fullfunction = $nms->[2]; | |
| 4723 } | |
| 4724 } | 4341 } |
| 4725 } | 4342 } |
| 4726 | 4343 |
| 4727 # Prepend to accumulated symbols for pcstr | 4344 # Prepend to accumulated symbols for pcstr |
| 4728 # (so that caller comes before callee) | 4345 # (so that caller comes before callee) |
| 4729 my $sym = $symbols->{$pcstr}; | 4346 my $sym = $symbols->{$pcstr}; |
| 4730 if (!defined($sym)) { | 4347 if (!defined($sym)) { |
| 4731 $sym = []; | 4348 $sym = []; |
| 4732 $symbols->{$pcstr} = $sym; | 4349 $symbols->{$pcstr} = $sym; |
| 4733 } | 4350 } |
| 4734 unshift(@{$sym}, $function, $filelinenum, $fullfunction); | 4351 unshift(@{$sym}, $function, $filelinenum, $fullfunction); |
| 4735 if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } | 4352 if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } |
| 4736 if (!defined($sep_address)) { | 4353 if (!defined($sep_address)) { |
| 4737 # Inlining is off, so this entry ends immediately | 4354 # Inlining is off, se this entry ends immediately |
| 4738 $count++; | 4355 $count++; |
| 4739 } | 4356 } |
| 4740 } | 4357 } |
| 4741 close(SYMBOLS); | 4358 close(SYMBOLS); |
| 4742 } | 4359 } |
| 4743 | 4360 |
| 4744 # Use nm to map the list of referenced PCs to symbols. Return true iff we | 4361 # Use nm to map the list of referenced PCs to symbols. Return true iff we |
| 4745 # are able to read procedure information via nm. | 4362 # are able to read procedure information via nm. |
| 4746 sub MapSymbolsWithNM { | 4363 sub MapSymbolsWithNM { |
| 4747 my $image = shift; | 4364 my $image = shift; |
| (...skipping 42 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 4790 } | 4407 } |
| 4791 | 4408 |
| 4792 sub ShortFunctionName { | 4409 sub ShortFunctionName { |
| 4793 my $function = shift; | 4410 my $function = shift; |
| 4794 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types | 4411 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types |
| 4795 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments | 4412 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments |
| 4796 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type | 4413 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type |
| 4797 return $function; | 4414 return $function; |
| 4798 } | 4415 } |
| 4799 | 4416 |
| 4800 # Trim overly long symbols found in disassembler output | |
| 4801 sub CleanDisassembly { | |
| 4802 my $d = shift; | |
| 4803 while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax) | |
| 4804 while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments | |
| 4805 return $d; | |
| 4806 } | |
| 4807 | |
| 4808 # Clean file name for display | |
| 4809 sub CleanFileName { | |
| 4810 my ($f) = @_; | |
| 4811 $f =~ s|^/proc/self/cwd/||; | |
| 4812 $f =~ s|^\./||; | |
| 4813 return $f; | |
| 4814 } | |
| 4815 | |
| 4816 # Make address relative to section and clean up for display | |
| 4817 sub UnparseAddress { | |
| 4818 my ($offset, $address) = @_; | |
| 4819 $address = AddressSub($address, $offset); | |
| 4820 $address =~ s/^0x//; | |
| 4821 $address =~ s/^0*//; | |
| 4822 return $address; | |
| 4823 } | |
| 4824 | |
| 4825 ##### Miscellaneous ##### | 4417 ##### Miscellaneous ##### |
| 4826 | 4418 |
| 4827 # Find the right versions of the above object tools to use. The | 4419 # Find the right versions of the above object tools to use. The |
| 4828 # argument is the program file being analyzed, and should be an ELF | 4420 # argument is the program file being analyzed, and should be an ELF |
| 4829 # 32-bit or ELF 64-bit executable file. The location of the tools | 4421 # 32-bit or ELF 64-bit executable file. The location of the tools |
| 4830 # is determined by considering the following options in this order: | 4422 # is determined by considering the following options in this order: |
| 4831 # 1) --tools option, if set | 4423 # 1) --tools option, if set |
| 4832 # 2) PPROF_TOOLS environment variable, if set | 4424 # 2) PPROF_TOOLS environment variable, if set |
| 4833 # 3) the environment | 4425 # 3) the environment |
| 4834 sub ConfigureObjTools { | 4426 sub ConfigureObjTools { |
| 4835 my $prog_file = shift; | 4427 my $prog_file = shift; |
| 4836 | 4428 |
| 4837 # Check for the existence of $prog_file because /usr/bin/file does not | 4429 # Check for the existence of $prog_file because /usr/bin/file does not |
| 4838 # predictably return error status in prod. | 4430 # predictably return error status in prod. |
| 4839 (-e $prog_file) || error("$prog_file does not exist.\n"); | 4431 (-e $prog_file) || error("$prog_file does not exist.\n"); |
| 4840 | 4432 |
| 4841 my $file_type = undef; | 4433 my $file_type = undef; |
| 4842 if (-e "/usr/bin/file") { | 4434 if (-e "/usr/bin/file") { |
| 4843 # Follow symlinks (at least for systems where "file" supports that). | 4435 # Follow symlinks (at least for systems where "file" supports that). |
| 4844 my $escaped_prog_file = ShellEscape($prog_file); | 4436 $file_type = `/usr/bin/file -L $prog_file 2>$dev_null || /usr/bin/file $prog
_file`; |
| 4845 $file_type = `/usr/bin/file -L $escaped_prog_file 2>$dev_null || | |
| 4846 /usr/bin/file $escaped_prog_file`; | |
| 4847 } elsif ($^O == "MSWin32") { | 4437 } elsif ($^O == "MSWin32") { |
| 4848 $file_type = "MS Windows"; | 4438 $file_type = "MS Windows"; |
| 4849 } else { | 4439 } else { |
| 4850 print STDERR "WARNING: Can't determine the file type of $prog_file"; | 4440 print STDERR "WARNING: Can't determine the file type of $prog_file"; |
| 4851 } | 4441 } |
| 4852 | 4442 |
| 4853 if ($file_type =~ /64-bit/) { | 4443 if ($file_type =~ /64-bit/) { |
| 4854 # Change $address_length to 16 if the program file is ELF 64-bit. | 4444 # Change $address_length to 16 if the program file is ELF 64-bit. |
| 4855 # We can't detect this from many (most?) heap or lock contention | 4445 # We can't detect this from many (most?) heap or lock contention |
| 4856 # profiles, since the actual addresses referenced are generally in low | 4446 # profiles, since the actual addresses referenced are generally in low |
| (...skipping 61 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 4918 if (-x "$dirname$tool") { | 4508 if (-x "$dirname$tool") { |
| 4919 $path = "$dirname$tool"; | 4509 $path = "$dirname$tool"; |
| 4920 } else { | 4510 } else { |
| 4921 $path = $tool; | 4511 $path = $tool; |
| 4922 } | 4512 } |
| 4923 } | 4513 } |
| 4924 if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; } | 4514 if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; } |
| 4925 return $path; | 4515 return $path; |
| 4926 } | 4516 } |
| 4927 | 4517 |
| 4928 sub ShellEscape { | |
| 4929 my @escaped_words = (); | |
| 4930 foreach my $word (@_) { | |
| 4931 my $escaped_word = $word; | |
| 4932 if ($word =~ m![^a-zA-Z0-9/.,_=-]!) { # check for anything not in whitelist | |
| 4933 $escaped_word =~ s/'/'\\''/; | |
| 4934 $escaped_word = "'$escaped_word'"; | |
| 4935 } | |
| 4936 push(@escaped_words, $escaped_word); | |
| 4937 } | |
| 4938 return join(" ", @escaped_words); | |
| 4939 } | |
| 4940 | |
| 4941 sub cleanup { | 4518 sub cleanup { |
| 4942 unlink($main::tmpfile_sym); | 4519 unlink($main::tmpfile_sym); |
| 4943 unlink(keys %main::tempnames); | 4520 unlink(keys %main::tempnames); |
| 4944 | 4521 |
| 4945 # We leave any collected profiles in $HOME/pprof in case the user wants | 4522 # We leave any collected profiles in $HOME/pprof in case the user wants |
| 4946 # to look at them later. We print a message informing them of this. | 4523 # to look at them later. We print a message informing them of this. |
| 4947 if ((scalar(@main::profile_files) > 0) && | 4524 if ((scalar(@main::profile_files) > 0) && |
| 4948 defined($main::collected_profile)) { | 4525 defined($main::collected_profile)) { |
| 4949 if (scalar(@main::profile_files) == 1) { | 4526 if (scalar(@main::profile_files) == 1) { |
| 4950 print STDERR "Dynamically gathered profile is in $main::collected_profile\
n"; | 4527 print STDERR "Dynamically gathered profile is in $main::collected_profile\
n"; |
| (...skipping 17 matching lines...) Expand all Loading... |
| 4968 print STDERR $msg; | 4545 print STDERR $msg; |
| 4969 cleanup(); | 4546 cleanup(); |
| 4970 exit(1); | 4547 exit(1); |
| 4971 } | 4548 } |
| 4972 | 4549 |
| 4973 | 4550 |
| 4974 # Run $nm_command and get all the resulting procedure boundaries whose | 4551 # Run $nm_command and get all the resulting procedure boundaries whose |
| 4975 # names match "$regexp" and returns them in a hashtable mapping from | 4552 # names match "$regexp" and returns them in a hashtable mapping from |
| 4976 # procedure name to a two-element vector of [start address, end address] | 4553 # procedure name to a two-element vector of [start address, end address] |
| 4977 sub GetProcedureBoundariesViaNm { | 4554 sub GetProcedureBoundariesViaNm { |
| 4978 my $escaped_nm_command = shift; # shell-escaped | 4555 my $nm_command = shift; |
| 4979 my $regexp = shift; | 4556 my $regexp = shift; |
| 4980 | 4557 |
| 4981 my $symbol_table = {}; | 4558 my $symbol_table = {}; |
| 4982 open(NM, "$escaped_nm_command |") || error("$escaped_nm_command: $!\n"); | 4559 open(NM, "$nm_command |") || error("$nm_command: $!\n"); |
| 4983 my $last_start = "0"; | 4560 my $last_start = "0"; |
| 4984 my $routine = ""; | 4561 my $routine = ""; |
| 4985 while (<NM>) { | 4562 while (<NM>) { |
| 4986 s/\r//g; # turn windows-looking lines into unix-looking lines | 4563 s/\r//g; # turn windows-looking lines into unix-looking lines |
| 4987 if (m/^\s*([0-9a-f]+) (.) (..*)/) { | 4564 if (m/^\s*([0-9a-f]+) (.) (..*)/) { |
| 4988 my $start_val = $1; | 4565 my $start_val = $1; |
| 4989 my $type = $2; | 4566 my $type = $2; |
| 4990 my $this_routine = $3; | 4567 my $this_routine = $3; |
| 4991 | 4568 |
| 4992 # It's possible for two symbols to share the same address, if | 4569 # It's possible for two symbols to share the same address, if |
| (...skipping 57 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 5050 } | 4627 } |
| 5051 | 4628 |
| 5052 # Gets the procedure boundaries for all routines in "$image" whose names | 4629 # Gets the procedure boundaries for all routines in "$image" whose names |
| 5053 # match "$regexp" and returns them in a hashtable mapping from procedure | 4630 # match "$regexp" and returns them in a hashtable mapping from procedure |
| 5054 # name to a two-element vector of [start address, end address]. | 4631 # name to a two-element vector of [start address, end address]. |
| 5055 # Will return an empty map if nm is not installed or not working properly. | 4632 # Will return an empty map if nm is not installed or not working properly. |
| 5056 sub GetProcedureBoundaries { | 4633 sub GetProcedureBoundaries { |
| 5057 my $image = shift; | 4634 my $image = shift; |
| 5058 my $regexp = shift; | 4635 my $regexp = shift; |
| 5059 | 4636 |
| 5060 # If $image doesn't start with /, then put ./ in front of it. This works | |
| 5061 # around an obnoxious bug in our probing of nm -f behavior. | |
| 5062 # "nm -f $image" is supposed to fail on GNU nm, but if: | |
| 5063 # | |
| 5064 # a. $image starts with [BbSsPp] (for example, bin/foo/bar), AND | |
| 5065 # b. you have a.out in your current directory (a not uncommon occurence) | |
| 5066 # | |
| 5067 # then "nm -f $image" succeeds because -f only looks at the first letter of | |
| 5068 # the argument, which looks valid because it's [BbSsPp], and then since | |
| 5069 # there's no image provided, it looks for a.out and finds it. | |
| 5070 # | |
| 5071 # This regex makes sure that $image starts with . or /, forcing the -f | |
| 5072 # parsing to fail since . and / are not valid formats. | |
| 5073 $image =~ s#^[^/]#./$&#; | |
| 5074 | |
| 5075 # For libc libraries, the copy in /usr/lib/debug contains debugging symbols | 4637 # For libc libraries, the copy in /usr/lib/debug contains debugging symbols |
| 5076 my $debugging = DebuggingLibrary($image); | 4638 my $debugging = DebuggingLibrary($image); |
| 5077 if ($debugging) { | 4639 if ($debugging) { |
| 5078 $image = $debugging; | 4640 $image = $debugging; |
| 5079 } | 4641 } |
| 5080 | 4642 |
| 5081 my $nm = $obj_tool_map{"nm"}; | 4643 my $nm = $obj_tool_map{"nm"}; |
| 5082 my $cppfilt = $obj_tool_map{"c++filt"}; | 4644 my $cppfilt = $obj_tool_map{"c++filt"}; |
| 5083 | 4645 |
| 5084 # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm | 4646 # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm |
| 5085 # binary doesn't support --demangle. In addition, for OS X we need | 4647 # binary doesn't support --demangle. In addition, for OS X we need |
| 5086 # to use the -f flag to get 'flat' nm output (otherwise we don't sort | 4648 # to use the -f flag to get 'flat' nm output (otherwise we don't sort |
| 5087 # properly and get incorrect results). Unfortunately, GNU nm uses -f | 4649 # properly and get incorrect results). Unfortunately, GNU nm uses -f |
| 5088 # in an incompatible way. So first we test whether our nm supports | 4650 # in an incompatible way. So first we test whether our nm supports |
| 5089 # --demangle and -f. | 4651 # --demangle and -f. |
| 5090 my $demangle_flag = ""; | 4652 my $demangle_flag = ""; |
| 5091 my $cppfilt_flag = ""; | 4653 my $cppfilt_flag = ""; |
| 5092 my $to_devnull = ">$dev_null 2>&1"; | 4654 if (system("$nm --demangle $image >$dev_null 2>&1") == 0) { |
| 5093 if (system(ShellEscape($nm, "--demangle", "image") . $to_devnull) == 0) { | |
| 5094 # In this mode, we do "nm --demangle <foo>" | 4655 # In this mode, we do "nm --demangle <foo>" |
| 5095 $demangle_flag = "--demangle"; | 4656 $demangle_flag = "--demangle"; |
| 5096 $cppfilt_flag = ""; | 4657 $cppfilt_flag = ""; |
| 5097 } elsif (system(ShellEscape($cppfilt, $image) . $to_devnull) == 0) { | 4658 } elsif (system("$cppfilt $image >$dev_null 2>&1") == 0) { |
| 5098 # In this mode, we do "nm <foo> | c++filt" | 4659 # In this mode, we do "nm <foo> | c++filt" |
| 5099 $cppfilt_flag = " | " . ShellEscape($cppfilt); | 4660 $cppfilt_flag = " | $cppfilt"; |
| 5100 }; | 4661 }; |
| 5101 my $flatten_flag = ""; | 4662 my $flatten_flag = ""; |
| 5102 if (system(ShellEscape($nm, "-f", $image) . $to_devnull) == 0) { | 4663 if (system("$nm -f $image >$dev_null 2>&1") == 0) { |
| 5103 $flatten_flag = "-f"; | 4664 $flatten_flag = "-f"; |
| 5104 } | 4665 } |
| 5105 | 4666 |
| 5106 # Finally, in the case $imagie isn't a debug library, we try again with | 4667 # Finally, in the case $imagie isn't a debug library, we try again with |
| 5107 # -D to at least get *exported* symbols. If we can't use --demangle, | 4668 # -D to at least get *exported* symbols. If we can't use --demangle, |
| 5108 # we use c++filt instead, if it exists on this system. | 4669 # we use c++filt instead, if it exists on this system. |
| 5109 my @nm_commands = (ShellEscape($nm, "-n", $flatten_flag, $demangle_flag, | 4670 my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" . |
| 5110 $image) . " 2>$dev_null $cppfilt_flag", | 4671 " $image 2>$dev_null $cppfilt_flag", |
| 5111 ShellEscape($nm, "-D", "-n", $flatten_flag, $demangle_flag, | 4672 "$nm -D -n $flatten_flag $demangle_flag" . |
| 5112 $image) . " 2>$dev_null $cppfilt_flag", | 4673 " $image 2>$dev_null $cppfilt_flag", |
| 5113 # 6nm is for Go binaries | 4674 # 6nm is for Go binaries |
| 5114 ShellEscape("6nm", "$image") . " 2>$dev_null | sort", | 4675 » » "6nm $image 2>$dev_null | sort", |
| 5115 ); | 4676 ); |
| 5116 | 4677 |
| 5117 # If the executable is an MS Windows PDB-format executable, we'll | 4678 # If the executable is an MS Windows PDB-format executable, we'll |
| 5118 # have set up obj_tool_map("nm_pdb"). In this case, we actually | 4679 # have set up obj_tool_map("nm_pdb"). In this case, we actually |
| 5119 # want to use both unix nm and windows-specific nm_pdb, since | 4680 # want to use both unix nm and windows-specific nm_pdb, since |
| 5120 # PDB-format executables can apparently include dwarf .o files. | 4681 # PDB-format executables can apparently include dwarf .o files. |
| 5121 if (exists $obj_tool_map{"nm_pdb"}) { | 4682 if (exists $obj_tool_map{"nm_pdb"}) { |
| 5122 push(@nm_commands, | 4683 my $nm_pdb = $obj_tool_map{"nm_pdb"}; |
| 5123 ShellEscape($obj_tool_map{"nm_pdb"}, "--demangle", $image) | 4684 push(@nm_commands, "$nm_pdb --demangle $image 2>$dev_null"); |
| 5124 . " 2>$dev_null"); | |
| 5125 } | 4685 } |
| 5126 | 4686 |
| 5127 foreach my $nm_command (@nm_commands) { | 4687 foreach my $nm_command (@nm_commands) { |
| 5128 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); | 4688 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); |
| 5129 return $symbol_table if (%{$symbol_table}); | 4689 return $symbol_table if (%{$symbol_table}); |
| 5130 } | 4690 } |
| 5131 my $symbol_table = {}; | 4691 my $symbol_table = {}; |
| 5132 return $symbol_table; | 4692 return $symbol_table; |
| 5133 } | 4693 } |
| 5134 | 4694 |
| (...skipping 204 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 5339 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); | 4899 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); |
| 5340 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); | 4900 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); |
| 5341 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); | 4901 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); |
| 5342 if ($error_count > 0) { | 4902 if ($error_count > 0) { |
| 5343 print STDERR $error_count, " errors: FAILED\n"; | 4903 print STDERR $error_count, " errors: FAILED\n"; |
| 5344 } else { | 4904 } else { |
| 5345 print STDERR "PASS\n"; | 4905 print STDERR "PASS\n"; |
| 5346 } | 4906 } |
| 5347 exit ($error_count); | 4907 exit ($error_count); |
| 5348 } | 4908 } |
| OLD | NEW |