Chromium Code Reviews
chromiumcodereview-hr@appspot.gserviceaccount.com (chromiumcodereview-hr) | Please choose your nickname with Settings | Help | Chromium Project | Gerrit Changes | Sign out
(56)

Side by Side Diff: third_party/tcmalloc/vendor/src/pprof

Issue 9701040: Revert 126715 - Update the tcmalloc vendor branch to r144 (gperftools 2.0). (Closed) Base URL: svn://svn.chromium.org/chrome/trunk/src/
Patch Set: Created 8 years, 9 months ago
Use n/p to move between diff chunks; N/P to move between comments. Draft comments are only viewable by you.
Jump to:
View unified diff | Download patch | Annotate | Revision Log
Property Changes:
Deleted: svn:executable
- *
OLDNEW
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
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.8";
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 43 matching lines...) Expand 10 before | Expand all | Expand 10 after
165 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin g). 161 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin g).
166 pprof --symbols <program> 162 pprof --symbols <program>
167 Maps addresses to symbol names. In this mode, stdin should be a 163 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- 164 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 165 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. 166 on linux), followed by a list of hex addresses to map, one per line.
171 167
172 For more help with querying remote servers, including how to add the 168 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): 169 necessary server-side support code, see this filename (or one like it):
174 170
175 /usr/doc/gperftools-$PPROF_VERSION/pprof_remote_servers.html 171 /usr/doc/google-perftools-$PPROF_VERSION/pprof_remote_servers.html
176 172
177 Options: 173 Options:
178 --cum Sort by cumulative data 174 --cum Sort by cumulative data
179 --base=<base> Subtract <base> from <profile> before display 175 --base=<base> Subtract <base> from <profile> before display
180 --interactive Run in interactive mode (interactive "help" gives help) [ default] 176 --interactive Run in interactive mode (interactive "help" gives help) [ default]
181 --seconds=<n> Length of time for dynamic profiles [default=30 secs] 177 --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 178 --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 179 --lib_prefix=<dir> Comma separated list of library path prefixes
184 180
185 Reporting Granularity: 181 Reporting Granularity:
(...skipping 77 matching lines...) Expand 10 before | Expand all | Expand 10 after
263 Outputs one line per procedure for localhost:1234 259 Outputs one line per procedure for localhost:1234
264 pprof --raw localhost:1234 > ./local.raw 260 pprof --raw localhost:1234 > ./local.raw
265 pprof --text ./local.raw 261 pprof --text ./local.raw
266 Fetches a remote profile for later analysis and then 262 Fetches a remote profile for later analysis and then
267 analyzes it in text mode. 263 analyzes it in text mode.
268 EOF 264 EOF
269 } 265 }
270 266
271 sub version_string { 267 sub version_string {
272 return <<EOF 268 return <<EOF
273 pprof (part of gperftools $PPROF_VERSION) 269 pprof (part of google-perftools $PPROF_VERSION)
274 270
275 Copyright 1998-2007 Google Inc. 271 Copyright 1998-2007 Google Inc.
276 272
277 This is BSD licensed software; see the source for copying conditions 273 This is BSD licensed software; see the source for copying conditions
278 and license information. 274 and license information.
279 There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A 275 There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A
280 PARTICULAR PURPOSE. 276 PARTICULAR PURPOSE.
281 EOF 277 EOF
282 } 278 }
283 279
(...skipping 211 matching lines...) Expand 10 before | Expand all | Expand 10 after
495 RunUnitTests(); 491 RunUnitTests();
496 # Should not return 492 # Should not return
497 exit(1); 493 exit(1);
498 } 494 }
499 495
500 # Binary name and profile arguments list 496 # Binary name and profile arguments list
501 $main::prog = ""; 497 $main::prog = "";
502 @main::pfile_args = (); 498 @main::pfile_args = ();
503 499
504 # Remote profiling without a binary (using $SYMBOL_PAGE instead) 500 # Remote profiling without a binary (using $SYMBOL_PAGE instead)
505 if (@ARGV > 0) { 501 if (IsProfileURL($ARGV[0])) {
506 if (IsProfileURL($ARGV[0])) { 502 $main::use_symbol_page = 1;
507 $main::use_symbol_page = 1; 503 } elsif (IsSymbolizedProfileFile($ARGV[0])) {
508 } elsif (IsSymbolizedProfileFile($ARGV[0])) { 504 $main::use_symbolized_profile = 1;
509 $main::use_symbolized_profile = 1; 505 $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 } 506 }
513 507
514 if ($main::use_symbol_page || $main::use_symbolized_profile) { 508 if ($main::use_symbol_page || $main::use_symbolized_profile) {
515 # We don't need a binary! 509 # We don't need a binary!
516 my %disabled = ('--lines' => $main::opt_lines, 510 my %disabled = ('--lines' => $main::opt_lines,
517 '--disasm' => $main::opt_disasm); 511 '--disasm' => $main::opt_disasm);
518 for my $option (keys %disabled) { 512 for my $option (keys %disabled) {
519 usage("$option cannot be used without a binary") if $disabled{$option}; 513 usage("$option cannot be used without a binary") if $disabled{$option};
520 } 514 }
521 # Set $main::prog later... 515 # Set $main::prog later...
(...skipping 139 matching lines...) Expand 10 before | Expand all | Expand 10 after
661 PrintText($symbols, $flat, $cumulative, -1); 655 PrintText($symbols, $flat, $cumulative, -1);
662 } elsif ($main::opt_raw) { 656 } elsif ($main::opt_raw) {
663 PrintSymbolizedProfile($symbols, $profile, $main::prog); 657 PrintSymbolizedProfile($symbols, $profile, $main::prog);
664 } elsif ($main::opt_callgrind) { 658 } elsif ($main::opt_callgrind) {
665 PrintCallgrind($calls); 659 PrintCallgrind($calls);
666 } else { 660 } else {
667 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { 661 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
668 if ($main::opt_gv) { 662 if ($main::opt_gv) {
669 RunGV(TempName($main::next_tmpfile, "ps"), ""); 663 RunGV(TempName($main::next_tmpfile, "ps"), "");
670 } elsif ($main::opt_evince) { 664 } elsif ($main::opt_evince) {
671 RunEvince(TempName($main::next_tmpfile, "pdf"), ""); 665 » RunEvince(TempName($main::next_tmpfile, "pdf"), "");
672 } elsif ($main::opt_web) { 666 } elsif ($main::opt_web) {
673 my $tmp = TempName($main::next_tmpfile, "svg"); 667 my $tmp = TempName($main::next_tmpfile, "svg");
674 RunWeb($tmp); 668 RunWeb($tmp);
675 # The command we run might hand the file name off 669 # The command we run might hand the file name off
676 # to an already running browser instance and then exit. 670 # to an already running browser instance and then exit.
677 # Normally, we'd remove $tmp on exit (right now), 671 # Normally, we'd remove $tmp on exit (right now),
678 # but fork a child to remove $tmp a little later, so that the 672 # but fork a child to remove $tmp a little later, so that the
679 # browser has time to load it first. 673 # browser has time to load it first.
680 delete $main::tempnames{$tmp}; 674 delete $main::tempnames{$tmp};
681 if (fork() == 0) { 675 if (fork() == 0) {
(...skipping 28 matching lines...) Expand all
710 if (-e '/lib/libtermcap.so.2') { 704 if (-e '/lib/libtermcap.so.2') {
711 return 0; # libtermcap exists, so readline should be okay 705 return 0; # libtermcap exists, so readline should be okay
712 } else { 706 } else {
713 return 1; 707 return 1;
714 } 708 }
715 } 709 }
716 710
717 sub RunGV { 711 sub RunGV {
718 my $fname = shift; 712 my $fname = shift;
719 my $bg = shift; # "" or " &" if we should run in background 713 my $bg = shift; # "" or " &" if we should run in background
720 if (!system(ShellEscape(@GV, "--version") . " >$dev_null 2>&1")) { 714 if (!system("$GV --version >$dev_null 2>&1")) {
721 # Options using double dash are supported by this gv version. 715 # Options using double dash are supported by this gv version.
722 # Also, turn on noantialias to better handle bug in gv for 716 # Also, turn on noantialias to better handle bug in gv for
723 # postscript files with large dimensions. 717 # postscript files with large dimensions.
724 # TODO: Maybe we should not pass the --noantialias flag 718 # TODO: Maybe we should not pass the --noantialias flag
725 # if the gv version is known to work properly without the flag. 719 # if the gv version is known to work properly without the flag.
726 system(ShellEscape(@GV, "--scale=$main::opt_scale", "--noantialias", $fname) 720 system("$GV --scale=$main::opt_scale --noantialias " . $fname . $bg);
727 . $bg);
728 } else { 721 } else {
729 # Old gv version - only supports options that use single dash. 722 # Old gv version - only supports options that use single dash.
730 print STDERR ShellEscape(@GV, "-scale", $main::opt_scale) . "\n"; 723 print STDERR "$GV -scale $main::opt_scale\n";
731 system(ShellEscape(@GV, "-scale", "$main::opt_scale", $fname) . $bg); 724 system("$GV -scale $main::opt_scale " . $fname . $bg);
732 } 725 }
733 } 726 }
734 727
735 sub RunEvince { 728 sub RunEvince {
736 my $fname = shift; 729 my $fname = shift;
737 my $bg = shift; # "" or " &" if we should run in background 730 my $bg = shift; # "" or " &" if we should run in background
738 system(ShellEscape(@EVINCE, $fname) . $bg); 731 system("$EVINCE " . $fname . $bg);
739 } 732 }
740 733
741 sub RunWeb { 734 sub RunWeb {
742 my $fname = shift; 735 my $fname = shift;
743 print STDERR "Loading web page file:///$fname\n"; 736 print STDERR "Loading web page file:///$fname\n";
744 737
745 if (`uname` =~ /Darwin/) { 738 if (`uname` =~ /Darwin/) {
746 # OS X: open will use standard preference for SVG files. 739 # OS X: open will use standard preference for SVG files.
747 system("/usr/bin/open", $fname); 740 system("/usr/bin/open", $fname);
748 return; 741 return;
(...skipping 13 matching lines...) Expand all
762 return; 755 return;
763 } 756 }
764 } 757 }
765 758
766 print STDERR "Could not load web browser.\n"; 759 print STDERR "Could not load web browser.\n";
767 } 760 }
768 761
769 sub RunKcachegrind { 762 sub RunKcachegrind {
770 my $fname = shift; 763 my $fname = shift;
771 my $bg = shift; # "" or " &" if we should run in background 764 my $bg = shift; # "" or " &" if we should run in background
772 print STDERR "Starting '@KCACHEGRIND " . $fname . $bg . "'\n"; 765 print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n";
773 system(ShellEscape(@KCACHEGRIND, $fname) . $bg); 766 system("$KCACHEGRIND " . $fname . $bg);
774 } 767 }
775 768
776 769
777 ##### Interactive helper routines ##### 770 ##### Interactive helper routines #####
778 771
779 sub InteractiveMode { 772 sub InteractiveMode {
780 $| = 1; # Make output unbuffered for interactive mode 773 $| = 1; # Make output unbuffered for interactive mode
781 my ($orig_profile, $symbols, $libs, $total) = @_; 774 my ($orig_profile, $symbols, $libs, $total) = @_;
782 775
783 print STDERR "Welcome to pprof! For help, type 'help'.\n"; 776 print STDERR "Welcome to pprof! For help, type 'help'.\n";
(...skipping 248 matching lines...) Expand 10 before | Expand all | Expand 10 after
1032 1025
1033 help - This listing 1026 help - This listing
1034 quit or ^D - End pprof 1027 quit or ^D - End pprof
1035 1028
1036 For commands that accept optional -ignore tags, samples where any routine in 1029 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 1030 the stack trace matches the regular expression in any of the -ignore
1038 parameters will be ignored. 1031 parameters will be ignored.
1039 1032
1040 Further pprof details are available at this location (or one similar): 1033 Further pprof details are available at this location (or one similar):
1041 1034
1042 /usr/doc/gperftools-$PPROF_VERSION/cpu_profiler.html 1035 /usr/doc/google-perftools-$PPROF_VERSION/cpu_profiler.html
1043 /usr/doc/gperftools-$PPROF_VERSION/heap_profiler.html 1036 /usr/doc/google-perftools-$PPROF_VERSION/heap_profiler.html
1044 1037
1045 ENDOFHELP 1038 ENDOFHELP
1046 } 1039 }
1047 sub ParseInteractiveArgs { 1040 sub ParseInteractiveArgs {
1048 my $args = shift; 1041 my $args = shift;
1049 my $focus = ""; 1042 my $focus = "";
1050 my $ignore = ""; 1043 my $ignore = "";
1051 my @x = split(/ +/, $args); 1044 my @x = split(/ +/, $args);
1052 foreach $a (@x) { 1045 foreach $a (@x) {
1053 if ($a =~ m/^(--|-)lines$/) { 1046 if ($a =~ m/^(--|-)lines$/) {
(...skipping 133 matching lines...) Expand 10 before | Expand all | Expand 10 after
1187 Percent($running_sum, $total), 1180 Percent($running_sum, $total),
1188 Unparse($c), 1181 Unparse($c),
1189 Percent($c, $total), 1182 Percent($c, $total),
1190 $sym); 1183 $sym);
1191 } 1184 }
1192 $lines++; 1185 $lines++;
1193 last if ($line_limit >= 0 && $lines >= $line_limit); 1186 last if ($line_limit >= 0 && $lines >= $line_limit);
1194 } 1187 }
1195 } 1188 }
1196 1189
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 }
1217 }
1218
1219 # Print the call graph in a way that's suiteable for callgrind. 1190 # Print the call graph in a way that's suiteable for callgrind.
1220 sub PrintCallgrind { 1191 sub PrintCallgrind {
1221 my $calls = shift; 1192 my $calls = shift;
1222 my $filename; 1193 my $filename;
1223 my %filename_to_index_map;
1224 my %fnname_to_index_map;
1225
1226 if ($main::opt_interactive) { 1194 if ($main::opt_interactive) {
1227 $filename = shift; 1195 $filename = shift;
1228 print STDERR "Writing callgrind file to '$filename'.\n" 1196 print STDERR "Writing callgrind file to '$filename'.\n"
1229 } else { 1197 } else {
1230 $filename = "&STDOUT"; 1198 $filename = "&STDOUT";
1231 } 1199 }
1232 open(CG, ">$filename"); 1200 open(CG, ">".$filename );
1233 printf CG ("events: Hits\n\n"); 1201 printf CG ("events: Hits\n\n");
1234 foreach my $call ( map { $_->[0] } 1202 foreach my $call ( map { $_->[0] }
1235 sort { $a->[1] cmp $b ->[1] || 1203 sort { $a->[1] cmp $b ->[1] ||
1236 $a->[2] <=> $b->[2] } 1204 $a->[2] <=> $b->[2] }
1237 map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1205 map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
1238 [$_, $1, $2] } 1206 [$_, $1, $2] }
1239 keys %$calls ) { 1207 keys %$calls ) {
1240 my $count = int($calls->{$call}); 1208 my $count = int($calls->{$call});
1241 $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1209 $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
1242 my ( $caller_file, $caller_line, $caller_function, 1210 my ( $caller_file, $caller_line, $caller_function,
1243 $callee_file, $callee_line, $callee_function ) = 1211 $callee_file, $callee_line, $callee_function ) =
1244 ( $1, $2, $3, $5, $6, $7 ); 1212 ( $1, $2, $3, $5, $6, $7 );
1245 1213
1246 # TODO(csilvers): for better compression, collect all the 1214
1247 # caller/callee_files and functions first, before printing 1215 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) { 1216 if (defined $6) {
1252 printf CG CompressedCGName("cfl", $callee_file, \%filename_to_index_map); 1217 printf CG ("cfl=$callee_file\n");
1253 printf CG CompressedCGName("cfn", $callee_function, \%fnname_to_index_map) ; 1218 printf CG ("cfn=$callee_function\n");
1254 printf CG ("calls=$count $callee_line\n"); 1219 printf CG ("calls=$count $callee_line\n");
1255 } 1220 }
1256 printf CG ("$caller_line $count\n\n"); 1221 printf CG ("$caller_line $count\n\n");
1257 } 1222 }
1258 } 1223 }
1259 1224
1260 # Print disassembly for all all routines that match $main::opt_disasm 1225 # Print disassembly for all all routines that match $main::opt_disasm
1261 sub PrintDisassembly { 1226 sub PrintDisassembly {
1262 my $libs = shift; 1227 my $libs = shift;
1263 my $flat = shift; 1228 my $flat = shift;
(...skipping 28 matching lines...) Expand all
1292 # [start_address, filename, linenumber, instruction, limit_address] 1257 # [start_address, filename, linenumber, instruction, limit_address]
1293 # E.g., 1258 # E.g.,
1294 # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] 1259 # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"]
1295 sub Disassemble { 1260 sub Disassemble {
1296 my $prog = shift; 1261 my $prog = shift;
1297 my $offset = shift; 1262 my $offset = shift;
1298 my $start_addr = shift; 1263 my $start_addr = shift;
1299 my $end_addr = shift; 1264 my $end_addr = shift;
1300 1265
1301 my $objdump = $obj_tool_map{"objdump"}; 1266 my $objdump = $obj_tool_map{"objdump"};
1302 my $cmd = ShellEscape($objdump, "-C", "-d", "-l", "--no-show-raw-insn", 1267 my $cmd = sprintf("$objdump -C -d -l --no-show-raw-insn " .
1303 "--start-address=0x$start_addr", 1268 "--start-address=0x$start_addr " .
1304 "--stop-address=0x$end_addr", $prog); 1269 "--stop-address=0x$end_addr $prog");
1305 open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); 1270 open(OBJDUMP, "$cmd |") || error("$objdump: $!\n");
1306 my @result = (); 1271 my @result = ();
1307 my $filename = ""; 1272 my $filename = "";
1308 my $linenumber = -1; 1273 my $linenumber = -1;
1309 my $last = ["", "", "", ""]; 1274 my $last = ["", "", "", ""];
1310 while (<OBJDUMP>) { 1275 while (<OBJDUMP>) {
1311 s/\r//g; # turn windows-looking lines into unix-looking lines 1276 s/\r//g; # turn windows-looking lines into unix-looking lines
1312 chop; 1277 chop;
1313 if (m|\s*([^:\s]+):(\d+)\s*$|) { 1278 if (m|\s*([^:\s]+):(\d+)\s*$|) {
1314 # Location line of the form: 1279 # Location line of the form:
1315 # <filename>:<linenumber> 1280 # <filename>:<linenumber>
(...skipping 684 matching lines...) Expand 10 before | Expand all | Expand 10 after
2000 } 1965 }
2001 1966
2002 if ($nodelimit > 0 || $edgelimit > 0) { 1967 if ($nodelimit > 0 || $edgelimit > 0) {
2003 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", 1968 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n",
2004 Unparse($nodelimit), Units(), 1969 Unparse($nodelimit), Units(),
2005 Unparse($edgelimit), Units()); 1970 Unparse($edgelimit), Units());
2006 } 1971 }
2007 1972
2008 # Open DOT output file 1973 # Open DOT output file
2009 my $output; 1974 my $output;
2010 my $escaped_dot = ShellEscape(@DOT);
2011 my $escaped_ps2pdf = ShellEscape(@PS2PDF);
2012 if ($main::opt_gv) { 1975 if ($main::opt_gv) {
2013 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "ps")); 1976 $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps");
2014 $output = "| $escaped_dot -Tps2 >$escaped_outfile";
2015 } elsif ($main::opt_evince) { 1977 } elsif ($main::opt_evince) {
2016 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "pdf")); 1978 $output = "| $DOT -Tps2 | $PS2PDF - " . TempName($main::next_tmpfile, "pdf") ;
2017 $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - $escaped_outfile";
2018 } elsif ($main::opt_ps) { 1979 } elsif ($main::opt_ps) {
2019 $output = "| $escaped_dot -Tps2"; 1980 $output = "| $DOT -Tps2";
2020 } elsif ($main::opt_pdf) { 1981 } elsif ($main::opt_pdf) {
2021 $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - -"; 1982 $output = "| $DOT -Tps2 | $PS2PDF - -";
2022 } elsif ($main::opt_web || $main::opt_svg) { 1983 } elsif ($main::opt_web || $main::opt_svg) {
2023 # We need to post-process the SVG, so write to a temporary file always. 1984 # We need to post-process the SVG, so write to a temporary file always.
2024 my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "svg")); 1985 $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg");
2025 $output = "| $escaped_dot -Tsvg >$escaped_outfile";
2026 } elsif ($main::opt_gif) { 1986 } elsif ($main::opt_gif) {
2027 $output = "| $escaped_dot -Tgif"; 1987 $output = "| $DOT -Tgif";
2028 } else { 1988 } else {
2029 $output = ">&STDOUT"; 1989 $output = ">&STDOUT";
2030 } 1990 }
2031 open(DOT, $output) || error("$output: $!\n"); 1991 open(DOT, $output) || error("$output: $!\n");
2032 1992
2033 # Title 1993 # Title
2034 printf DOT ("digraph \"%s; %s %s\" {\n", 1994 printf DOT ("digraph \"%s; %s %s\" {\n",
2035 $prog, 1995 $prog,
2036 Unparse($overall_total), 1996 Unparse($overall_total),
2037 Units()); 1997 Units());
(...skipping 60 matching lines...) Expand 10 before | Expand all | Expand 10 after
2098 Percent($f, $local_total), 2058 Percent($f, $local_total),
2099 $extra, 2059 $extra,
2100 $fs, 2060 $fs,
2101 $style, 2061 $style,
2102 ); 2062 );
2103 } 2063 }
2104 2064
2105 # Get edges and counts per edge 2065 # Get edges and counts per edge
2106 my %edge = (); 2066 my %edge = ();
2107 my $n; 2067 my $n;
2108 my $fullname_to_shortname_map = {};
2109 FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
2110 foreach my $k (keys(%{$raw})) { 2068 foreach my $k (keys(%{$raw})) {
2111 # TODO: omit low %age edges 2069 # TODO: omit low %age edges
2112 $n = $raw->{$k}; 2070 $n = $raw->{$k};
2113 my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); 2071 my @translated = TranslateStack($symbols, $k);
2114 for (my $i = 1; $i <= $#translated; $i++) { 2072 for (my $i = 1; $i <= $#translated; $i++) {
2115 my $src = $translated[$i]; 2073 my $src = $translated[$i];
2116 my $dst = $translated[$i-1]; 2074 my $dst = $translated[$i-1];
2117 #next if ($src eq $dst); # Avoid self-edges? 2075 #next if ($src eq $dst); # Avoid self-edges?
2118 if (exists($node{$src}) && exists($node{$dst})) { 2076 if (exists($node{$src}) && exists($node{$dst})) {
2119 my $edge_label = "$src\001$dst"; 2077 my $edge_label = "$src\001$dst";
2120 if (!exists($edge{$edge_label})) { 2078 if (!exists($edge{$edge_label})) {
2121 $edge{$edge_label} = 0; 2079 $edge{$edge_label} = 0;
2122 } 2080 }
2123 $edge{$edge_label} += $n; 2081 $edge{$edge_label} += $n;
(...skipping 363 matching lines...) Expand 10 before | Expand all | Expand 10 after
2487 if(state == 'pan' || state == 'move') { 2445 if(state == 'pan' || state == 'move') {
2488 // Quit pan mode 2446 // Quit pan mode
2489 state = ''; 2447 state = '';
2490 } 2448 }
2491 } 2449 }
2492 2450
2493 ]]></script> 2451 ]]></script>
2494 EOF 2452 EOF
2495 } 2453 }
2496 2454
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. 2455 # Return a small number that identifies the argument.
2542 # Multiple calls with the same argument will return the same number. 2456 # Multiple calls with the same argument will return the same number.
2543 # Calls with different arguments will return different numbers. 2457 # Calls with different arguments will return different numbers.
2544 sub ShortIdFor { 2458 sub ShortIdFor {
2545 my $key = shift; 2459 my $key = shift;
2546 my $id = $main::uniqueid{$key}; 2460 my $id = $main::uniqueid{$key};
2547 if (!defined($id)) { 2461 if (!defined($id)) {
2548 $id = keys(%main::uniqueid) + 1; 2462 $id = keys(%main::uniqueid) + 1;
2549 $main::uniqueid{$key} = $id; 2463 $main::uniqueid{$key} = $id;
2550 } 2464 }
2551 return $id; 2465 return $id;
2552 } 2466 }
2553 2467
2554 # Translate a stack of addresses into a stack of symbols 2468 # Translate a stack of addresses into a stack of symbols
2555 sub TranslateStack { 2469 sub TranslateStack {
2556 my $symbols = shift; 2470 my $symbols = shift;
2557 my $fullname_to_shortname_map = shift;
2558 my $k = shift; 2471 my $k = shift;
2559 2472
2560 my @addrs = split(/\n/, $k); 2473 my @addrs = split(/\n/, $k);
2561 my @result = (); 2474 my @result = ();
2562 for (my $i = 0; $i <= $#addrs; $i++) { 2475 for (my $i = 0; $i <= $#addrs; $i++) {
2563 my $a = $addrs[$i]; 2476 my $a = $addrs[$i];
2564 2477
2565 # Skip large addresses since they sometimes show up as fake entries on RH9 2478 # Skip large addresses since they sometimes show up as fake entries on RH9
2566 if (length($a) > 8 && $a gt "7fffffffffffffff") { 2479 if (length($a) > 8 && $a gt "7fffffffffffffff") {
2567 next; 2480 next;
(...skipping 11 matching lines...) Expand all
2579 } 2492 }
2580 2493
2581 # We can have a sequence of symbols for a particular entry 2494 # We can have a sequence of symbols for a particular entry
2582 # (more than one symbol in the case of inlining). Callers 2495 # (more than one symbol in the case of inlining). Callers
2583 # come before callees in symlist, so walk backwards since 2496 # come before callees in symlist, so walk backwards since
2584 # the translated stack should contain callees before callers. 2497 # the translated stack should contain callees before callers.
2585 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { 2498 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) {
2586 my $func = $symlist->[$j-2]; 2499 my $func = $symlist->[$j-2];
2587 my $fileline = $symlist->[$j-1]; 2500 my $fileline = $symlist->[$j-1];
2588 my $fullfunc = $symlist->[$j]; 2501 my $fullfunc = $symlist->[$j];
2589 if (defined($fullname_to_shortname_map->{$fullfunc})) {
2590 $func = $fullname_to_shortname_map->{$fullfunc};
2591 }
2592 if ($j > 2) { 2502 if ($j > 2) {
2593 $func = "$func (inline)"; 2503 $func = "$func (inline)";
2594 } 2504 }
2595 2505
2596 # Do not merge nodes corresponding to Callback::Run since that 2506 # Do not merge nodes corresponding to Callback::Run since that
2597 # causes confusing cycles in dot display. Instead, we synthesize 2507 # causes confusing cycles in dot display. Instead, we synthesize
2598 # a unique name for this frame per caller. 2508 # a unique name for this frame per caller.
2599 if ($func =~ m/Callback.*::Run$/) { 2509 if ($func =~ m/Callback.*::Run$/) {
2600 my $caller = ($i > 0) ? $addrs[$i-1] : 0; 2510 my $caller = ($i > 0) ? $addrs[$i-1] : 0;
2601 $func = "Run#" . ShortIdFor($caller); 2511 $func = "Run#" . ShortIdFor($caller);
(...skipping 232 matching lines...) Expand 10 before | Expand all | Expand 10 after
2834 '::do_malloc_or_cpp_alloc', 2744 '::do_malloc_or_cpp_alloc',
2835 'DoSampledAllocation', 2745 'DoSampledAllocation',
2836 'simple_alloc::allocate', 2746 'simple_alloc::allocate',
2837 '__malloc_alloc_template::allocate', 2747 '__malloc_alloc_template::allocate',
2838 '__builtin_delete', 2748 '__builtin_delete',
2839 '__builtin_new', 2749 '__builtin_new',
2840 '__builtin_vec_delete', 2750 '__builtin_vec_delete',
2841 '__builtin_vec_new', 2751 '__builtin_vec_new',
2842 'operator new', 2752 'operator new',
2843 'operator new[]', 2753 'operator new[]',
2844 # The entry to our memory-allocation routines on OS X 2754 » » # The entry to our memory-allocation routines on OS X
2845 'malloc_zone_malloc', 2755 » » 'malloc_zone_malloc',
2846 'malloc_zone_calloc', 2756 » » 'malloc_zone_calloc',
2847 'malloc_zone_valloc', 2757 » » 'malloc_zone_valloc',
2848 'malloc_zone_realloc', 2758 » » 'malloc_zone_realloc',
2849 'malloc_zone_memalign', 2759 » » 'malloc_zone_memalign',
2850 'malloc_zone_free', 2760 » » 'malloc_zone_free',
2851 # These mark the beginning/end of our custom sections 2761 # These mark the beginning/end of our custom sections
2852 '__start_google_malloc', 2762 '__start_google_malloc',
2853 '__stop_google_malloc', 2763 '__stop_google_malloc',
2854 '__start_malloc_hook', 2764 '__start_malloc_hook',
2855 '__stop_malloc_hook') { 2765 '__stop_malloc_hook') {
2856 $skip{$name} = 1; 2766 $skip{$name} = 1;
2857 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything 2767 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything
2858 } 2768 }
2859 # TODO: Remove TCMalloc once everything has been 2769 # TODO: Remove TCMalloc once everything has been
2860 # moved into the tcmalloc:: namespace and we have flushed 2770 # moved into the tcmalloc:: namespace and we have flushed
(...skipping 71 matching lines...) Expand 10 before | Expand all | Expand 10 after
2932 AddEntry($result, $reduced_path, $count); 2842 AddEntry($result, $reduced_path, $count);
2933 } 2843 }
2934 return $result; 2844 return $result;
2935 } 2845 }
2936 2846
2937 # Reduce profile to granularity given by user 2847 # Reduce profile to granularity given by user
2938 sub ReduceProfile { 2848 sub ReduceProfile {
2939 my $symbols = shift; 2849 my $symbols = shift;
2940 my $profile = shift; 2850 my $profile = shift;
2941 my $result = {}; 2851 my $result = {};
2942 my $fullname_to_shortname_map = {};
2943 FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
2944 foreach my $k (keys(%{$profile})) { 2852 foreach my $k (keys(%{$profile})) {
2945 my $count = $profile->{$k}; 2853 my $count = $profile->{$k};
2946 my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); 2854 my @translated = TranslateStack($symbols, $k);
2947 my @path = (); 2855 my @path = ();
2948 my %seen = (); 2856 my %seen = ();
2949 $seen{''} = 1; # So that empty keys are skipped 2857 $seen{''} = 1; # So that empty keys are skipped
2950 foreach my $e (@translated) { 2858 foreach my $e (@translated) {
2951 # To avoid double-counting due to recursion, skip a stack-trace 2859 # To avoid double-counting due to recursion, skip a stack-trace
2952 # entry if it has already been seen 2860 # entry if it has already been seen
2953 if (!$seen{$e}) { 2861 if (!$seen{$e}) {
2954 $seen{$e} = 1; 2862 $seen{$e} = 1;
2955 push(@path, $e); 2863 push(@path, $e);
2956 } 2864 }
(...skipping 186 matching lines...) Expand 10 before | Expand all | Expand 10 after
3143 $pcs->{$pc} = 1; 3051 $pcs->{$pc} = 1;
3144 push @k, $pc; 3052 push @k, $pc;
3145 } 3053 }
3146 AddEntry($profile, (join "\n", @k), $count); 3054 AddEntry($profile, (join "\n", @k), $count);
3147 } 3055 }
3148 3056
3149 ##### Code to profile a server dynamically ##### 3057 ##### Code to profile a server dynamically #####
3150 3058
3151 sub CheckSymbolPage { 3059 sub CheckSymbolPage {
3152 my $url = SymbolPageURL(); 3060 my $url = SymbolPageURL();
3153 my $command = ShellEscape(@URL_FETCHER, $url); 3061 open(SYMBOL, "$URL_FETCHER '$url' |");
3154 open(SYMBOL, "$command |") or error($command);
3155 my $line = <SYMBOL>; 3062 my $line = <SYMBOL>;
3156 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3063 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
3157 close(SYMBOL); 3064 close(SYMBOL);
3158 unless (defined($line)) { 3065 unless (defined($line)) {
3159 error("$url doesn't exist\n"); 3066 error("$url doesn't exist\n");
3160 } 3067 }
3161 3068
3162 if ($line =~ /^num_symbols:\s+(\d+)$/) { 3069 if ($line =~ /^num_symbols:\s+(\d+)$/) {
3163 if ($1 == 0) { 3070 if ($1 == 0) {
3164 error("Stripped binary. No symbols available.\n"); 3071 error("Stripped binary. No symbols available.\n");
(...skipping 36 matching lines...) Expand 10 before | Expand all | Expand 10 after
3201 3108
3202 # We fetch symbols from the first profile argument. 3109 # We fetch symbols from the first profile argument.
3203 sub SymbolPageURL { 3110 sub SymbolPageURL {
3204 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 3111 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
3205 return "$baseURL$SYMBOL_PAGE"; 3112 return "$baseURL$SYMBOL_PAGE";
3206 } 3113 }
3207 3114
3208 sub FetchProgramName() { 3115 sub FetchProgramName() {
3209 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 3116 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
3210 my $url = "$baseURL$PROGRAM_NAME_PAGE"; 3117 my $url = "$baseURL$PROGRAM_NAME_PAGE";
3211 my $command_line = ShellEscape(@URL_FETCHER, $url); 3118 my $command_line = "$URL_FETCHER '$url'";
3212 open(CMDLINE, "$command_line |") or error($command_line); 3119 open(CMDLINE, "$command_line |") or error($command_line);
3213 my $cmdline = <CMDLINE>; 3120 my $cmdline = <CMDLINE>;
3214 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3121 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
3215 close(CMDLINE); 3122 close(CMDLINE);
3216 error("Failed to get program name from $url\n") unless defined($cmdline); 3123 error("Failed to get program name from $url\n") unless defined($cmdline);
3217 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. 3124 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters.
3218 $cmdline =~ s!\n!!g; # Remove LFs. 3125 $cmdline =~ s!\n!!g; # Remove LFs.
3219 return $cmdline; 3126 return $cmdline;
3220 } 3127 }
3221 3128
3222 # Gee, curl's -L (--location) option isn't reliable at least 3129 # 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 3130 # with its 7.12.3 version. Curl will forget to post data if
3224 # there is a redirection. This function is a workaround for 3131 # there is a redirection. This function is a workaround for
3225 # curl. Redirection happens on borg hosts. 3132 # curl. Redirection happens on borg hosts.
3226 sub ResolveRedirectionForCurl { 3133 sub ResolveRedirectionForCurl {
3227 my $url = shift; 3134 my $url = shift;
3228 my $command_line = ShellEscape(@URL_FETCHER, "--head", $url); 3135 my $command_line = "$URL_FETCHER --head '$url'";
3229 open(CMDLINE, "$command_line |") or error($command_line); 3136 open(CMDLINE, "$command_line |") or error($command_line);
3230 while (<CMDLINE>) { 3137 while (<CMDLINE>) {
3231 s/\r//g; # turn windows-looking lines into unix-looking lines 3138 s/\r//g; # turn windows-looking lines into unix-looking lines
3232 if (/^Location: (.*)/) { 3139 if (/^Location: (.*)/) {
3233 $url = $1; 3140 $url = $1;
3234 } 3141 }
3235 } 3142 }
3236 close(CMDLINE); 3143 close(CMDLINE);
3237 return $url; 3144 return $url;
3238 } 3145 }
3239 3146
3240 # Add a timeout flat to URL_FETCHER. Returns a new list. 3147 # Add a timeout flat to URL_FETCHER
3241 sub AddFetchTimeout { 3148 sub AddFetchTimeout {
3149 my $fetcher = shift;
3242 my $timeout = shift; 3150 my $timeout = shift;
3243 my @fetcher = shift;
3244 if (defined($timeout)) { 3151 if (defined($timeout)) {
3245 if (join(" ", @fetcher) =~ m/\bcurl -s/) { 3152 if ($fetcher =~ m/\bcurl -s/) {
3246 push(@fetcher, "--max-time", sprintf("%d", $timeout)); 3153 $fetcher .= sprintf(" --max-time %d", $timeout);
3247 } elsif (join(" ", @fetcher) =~ m/\brpcget\b/) { 3154 } elsif ($fetcher =~ m/\brpcget\b/) {
3248 push(@fetcher, sprintf("--deadline=%d", $timeout)); 3155 $fetcher .= sprintf(" --deadline=%d", $timeout);
3249 } 3156 }
3250 } 3157 }
3251 return @fetcher; 3158 return $fetcher;
3252 } 3159 }
3253 3160
3254 # Reads a symbol map from the file handle name given as $1, returning 3161 # Reads a symbol map from the file handle name given as $1, returning
3255 # the resulting symbol map. Also processes variables relating to symbols. 3162 # the resulting symbol map. Also processes variables relating to symbols.
3256 # Currently, the only variable processed is 'binary=<value>' which updates 3163 # Currently, the only variable processed is 'binary=<value>' which updates
3257 # $main::prog to have the correct program name. 3164 # $main::prog to have the correct program name.
3258 sub ReadSymbols { 3165 sub ReadSymbols {
3259 my $in = shift; 3166 my $in = shift;
3260 my $map = {}; 3167 my $map = {};
3261 while (<$in>) { 3168 while (<$in>) {
(...skipping 39 matching lines...) Expand 10 before | Expand all | Expand 10 after
3301 if (!defined($symbol_map)) { 3208 if (!defined($symbol_map)) {
3302 my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); 3209 my $post_data = join("+", sort((map {"0x" . "$_"} @pcs)));
3303 3210
3304 open(POSTFILE, ">$main::tmpfile_sym"); 3211 open(POSTFILE, ">$main::tmpfile_sym");
3305 print POSTFILE $post_data; 3212 print POSTFILE $post_data;
3306 close(POSTFILE); 3213 close(POSTFILE);
3307 3214
3308 my $url = SymbolPageURL(); 3215 my $url = SymbolPageURL();
3309 3216
3310 my $command_line; 3217 my $command_line;
3311 if (join(" ", @URL_FETCHER) =~ m/\bcurl -s/) { 3218 if ($URL_FETCHER =~ m/\bcurl -s/) {
3312 $url = ResolveRedirectionForCurl($url); 3219 $url = ResolveRedirectionForCurl($url);
3313 $command_line = ShellEscape(@URL_FETCHER, "-d", "\@$main::tmpfile_sym", 3220 $command_line = "$URL_FETCHER -d '\@$main::tmpfile_sym' '$url'";
3314 $url);
3315 } else { 3221 } else {
3316 $command_line = (ShellEscape(@URL_FETCHER, "--post", $url) 3222 $command_line = "$URL_FETCHER --post '$url' < '$main::tmpfile_sym'";
3317 . " < " . ShellEscape($main::tmpfile_sym));
3318 } 3223 }
3319 # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols. 3224 # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols.
3320 my $escaped_cppfilt = ShellEscape($obj_tool_map{"c++filt"}); 3225 my $cppfilt = $obj_tool_map{"c++filt"};
3321 open(SYMBOL, "$command_line | $escaped_cppfilt |") or error($command_line); 3226 open(SYMBOL, "$command_line | $cppfilt |") or error($command_line);
3322 $symbol_map = ReadSymbols(*SYMBOL{IO}); 3227 $symbol_map = ReadSymbols(*SYMBOL{IO});
3323 close(SYMBOL); 3228 close(SYMBOL);
3324 } 3229 }
3325 3230
3326 my $symbols = {}; 3231 my $symbols = {};
3327 foreach my $pc (@pcs) { 3232 foreach my $pc (@pcs) {
3328 my $fullname; 3233 my $fullname;
3329 # For 64 bits binaries, symbols are extracted with 8 leading zeroes. 3234 # For 64 bits binaries, symbols are extracted with 8 leading zeroes.
3330 # Then /symbol reads the long symbols in as uint64, and outputs 3235 # 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. 3236 # 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 3237 # By removing all the leading zeroes in both $pc and the symbols from
3333 # /symbol, the symbols match and are retrievable from the map. 3238 # /symbol, the symbols match and are retrievable from the map.
3334 my $shortpc = $pc; 3239 my $shortpc = $pc;
3335 $shortpc =~ s/^0*//; 3240 $shortpc =~ s/^0*//;
3336 # Each line may have a list of names, which includes the function 3241 # Each line may have a list of names, which includes the function
3337 # and also other functions it has inlined. They are separated (in 3242 # and also other functions it has inlined. They are separated
3338 # PrintSymbolizedProfile), by --, which is illegal in function names. 3243 # (in PrintSymbolizedFile), by --, which is illegal in function names.
3339 my $fullnames; 3244 my $fullnames;
3340 if (defined($symbol_map->{$shortpc})) { 3245 if (defined($symbol_map->{$shortpc})) {
3341 $fullnames = $symbol_map->{$shortpc}; 3246 $fullnames = $symbol_map->{$shortpc};
3342 } else { 3247 } else {
3343 $fullnames = "0x" . $pc; # Just use addresses 3248 $fullnames = "0x" . $pc; # Just use addresses
3344 } 3249 }
3345 my $sym = []; 3250 my $sym = [];
3346 $symbols->{$pc} = $sym; 3251 $symbols->{$pc} = $sym;
3347 foreach my $fullname (split("--", $fullnames)) { 3252 foreach my $fullname (split("--", $fullnames)) {
3348 my $name = ShortFunctionName($fullname); 3253 my $name = ShortFunctionName($fullname);
(...skipping 57 matching lines...) Expand 10 before | Expand all | Expand 10 after
3406 mkdir($profile_dir) 3311 mkdir($profile_dir)
3407 || die("Unable to create profile directory $profile_dir: $!\n"); 3312 || die("Unable to create profile directory $profile_dir: $!\n");
3408 } 3313 }
3409 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; 3314 my $tmp_profile = "$profile_dir/.tmp.$profile_file";
3410 my $real_profile = "$profile_dir/$profile_file"; 3315 my $real_profile = "$profile_dir/$profile_file";
3411 3316
3412 if ($fetch_name_only > 0) { 3317 if ($fetch_name_only > 0) {
3413 return $real_profile; 3318 return $real_profile;
3414 } 3319 }
3415 3320
3416 my @fetcher = AddFetchTimeout($fetch_timeout, @URL_FETCHER); 3321 my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout);
3417 my $cmd = ShellEscape(@fetcher, $url) . " > " . ShellEscape($tmp_profile); 3322 my $cmd = "$fetcher '$url' > '$tmp_profile'";
3418 if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){ 3323 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"; 3324 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon ds to\n ${real_profile}\n";
3420 if ($encourage_patience) { 3325 if ($encourage_patience) {
3421 print STDERR "Be patient...\n"; 3326 print STDERR "Be patient...\n";
3422 } 3327 }
3423 } else { 3328 } else {
3424 print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; 3329 print STDERR "Fetching $path profile from $url to\n ${real_profile}\n";
3425 } 3330 }
3426 3331
3427 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); 3332 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
3428 (system("mv", $tmp_profile, $real_profile) == 0) || error("Unable to rename profile\n"); 3333 (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename pr ofile\n");
3429 print STDERR "Wrote profile to $real_profile\n"; 3334 print STDERR "Wrote profile to $real_profile\n";
3430 $main::collected_profile = $real_profile; 3335 $main::collected_profile = $real_profile;
3431 return $main::collected_profile; 3336 return $main::collected_profile;
3432 } 3337 }
3433 } 3338 }
3434 3339
3435 # Collect profiles in parallel 3340 # Collect profiles in parallel
3436 sub FetchDynamicProfiles { 3341 sub FetchDynamicProfiles {
3437 my $items = scalar(@main::pfile_args); 3342 my $items = scalar(@main::pfile_args);
3438 my $levels = log($items) / log(2); 3343 my $levels = log($items) / log(2);
(...skipping 93 matching lines...) Expand 10 before | Expand all | Expand 10 after
3532 @$slots = unpack($self->{unpack_code} . "*", $str); 3437 @$slots = unpack($self->{unpack_code} . "*", $str);
3533 } else { 3438 } else {
3534 # If we're a 64-bit profile, check if we're a 64-bit-capable 3439 # 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 3440 # perl. Otherwise, each slot will be represented as a float
3536 # instead of an int64, losing precision and making all the 3441 # instead of an int64, losing precision and making all the
3537 # 64-bit addresses wrong. We won't complain yet, but will 3442 # 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. 3443 # later if we ever see a value that doesn't fit in 32 bits.
3539 my $has_q = 0; 3444 my $has_q = 0;
3540 eval { $has_q = pack("Q", "1") ? 1 : 1; }; 3445 eval { $has_q = pack("Q", "1") ? 1 : 1; };
3541 if (!$has_q) { 3446 if (!$has_q) {
3542 $self->{perl_is_64bit} = 0; 3447 » $self->{perl_is_64bit} = 0;
3543 } 3448 }
3544 read($self->{file}, $str, 8); 3449 read($self->{file}, $str, 8);
3545 if (substr($str, 4, 4) eq chr(0)x4) { 3450 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. 3451 # We'd love to use 'Q', but it's a) not universal, b) not endian-proof.
3547 $self->{unpack_code} = 'V'; # Little-endian. 3452 $self->{unpack_code} = 'V'; # Little-endian.
3548 } elsif (substr($str, 0, 4) eq chr(0)x4) { 3453 } elsif (substr($str, 0, 4) eq chr(0)x4) {
3549 $self->{unpack_code} = 'N'; # Big-endian 3454 $self->{unpack_code} = 'N'; # Big-endian
3550 } else { 3455 } else {
3551 ::error("$fname: header size >= 2**32\n"); 3456 ::error("$fname: header size >= 2**32\n");
3552 } 3457 }
(...skipping 15 matching lines...) Expand all
3568 # This is the easy case: unpack provides 32-bit unpacking primitives. 3473 # This is the easy case: unpack provides 32-bit unpacking primitives.
3569 @$slots = unpack($self->{unpack_code} . "*", $str); 3474 @$slots = unpack($self->{unpack_code} . "*", $str);
3570 } else { 3475 } else {
3571 # We need to unpack 32 bits at a time and combine. 3476 # We need to unpack 32 bits at a time and combine.
3572 my @b32_values = unpack($self->{unpack_code} . "*", $str); 3477 my @b32_values = unpack($self->{unpack_code} . "*", $str);
3573 my @b64_values = (); 3478 my @b64_values = ();
3574 for (my $i = 0; $i < $#b32_values; $i += 2) { 3479 for (my $i = 0; $i < $#b32_values; $i += 2) {
3575 # TODO(csilvers): if this is a 32-bit perl, the math below 3480 # 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 3481 # could end up in a too-large int, which perl will promote
3577 # to a double, losing necessary precision. Deal with that. 3482 # to a double, losing necessary precision. Deal with that.
3578 # Right now, we just die. 3483 » # Right now, we just die.
3579 my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); 3484 » my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]);
3580 if ($self->{unpack_code} eq 'N') { # big-endian 3485 if ($self->{unpack_code} eq 'N') { # big-endian
3581 ($lo, $hi) = ($hi, $lo); 3486 » ($lo, $hi) = ($hi, $lo);
3582 } 3487 » }
3583 my $value = $lo + $hi * (2**32); 3488 » my $value = $lo + $hi * (2**32);
3584 if (!$self->{perl_is_64bit} && # check value is exactly represented 3489 » if (!$self->{perl_is_64bit} && # check value is exactly represented
3585 (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { 3490 » (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) {
3586 ::error("Need a 64-bit perl to process this 64-bit profile.\n"); 3491 » ::error("Need a 64-bit perl to process this 64-bit profile.\n");
3587 } 3492 » }
3588 push(@b64_values, $value); 3493 » push(@b64_values, $value);
3589 } 3494 }
3590 @$slots = @b64_values; 3495 @$slots = @b64_values;
3591 } 3496 }
3592 } 3497 }
3593 3498
3594 # Access the i-th long in the file (logically), or -1 at EOF. 3499 # Access the i-th long in the file (logically), or -1 at EOF.
3595 sub get { 3500 sub get {
3596 my ($self, $idx) = @_; 3501 my ($self, $idx) = @_;
3597 my $slots = $self->{slots}; 3502 my $slots = $self->{slots};
3598 while ($#$slots >= 0) { 3503 while ($#$slots >= 0) {
(...skipping 107 matching lines...) Expand 10 before | Expand all | Expand 10 after
3706 if (!defined($header)) { # means "at EOF" 3611 if (!defined($header)) { # means "at EOF"
3707 error("Profile is empty.\n"); 3612 error("Profile is empty.\n");
3708 } 3613 }
3709 3614
3710 my $symbols; 3615 my $symbols;
3711 if ($header =~ m/^--- *$symbol_marker/o) { 3616 if ($header =~ m/^--- *$symbol_marker/o) {
3712 # Verify that the user asked for a symbolized profile 3617 # Verify that the user asked for a symbolized profile
3713 if (!$main::use_symbolized_profile) { 3618 if (!$main::use_symbolized_profile) {
3714 # we have both a binary and symbolized profiles, abort 3619 # we have both a binary and symbolized profiles, abort
3715 error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " . 3620 error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " .
3716 "a binary arg. Try again without passing\n $prog\n"); 3621 » "a binary arg. Try again without passing\n $prog\n");
3717 } 3622 }
3718 # Read the symbol section of the symbolized profile file. 3623 # Read the symbol section of the symbolized profile file.
3719 $symbols = ReadSymbols(*PROFILE{IO}); 3624 $symbols = ReadSymbols(*PROFILE{IO});
3720 # Read the next line to get the header for the remaining profile. 3625 # Read the next line to get the header for the remaining profile.
3721 $header = ReadProfileHeader(*PROFILE) || ""; 3626 $header = ReadProfileHeader(*PROFILE) || "";
3722 } 3627 }
3723 3628
3724 $main::profile_type = ''; 3629 $main::profile_type = '';
3725 if ($header =~ m/^heap profile:.*$growth_marker/o) { 3630 if ($header =~ m/^heap profile:.*$growth_marker/o) {
3726 $main::profile_type = 'growth'; 3631 $main::profile_type = 'growth';
(...skipping 280 matching lines...) Expand 10 before | Expand all | Expand 10 after
4007 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { 3912 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) {
4008 my $stack = $5; 3913 my $stack = $5;
4009 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); 3914 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
4010 3915
4011 if ($sample_adjustment) { 3916 if ($sample_adjustment) {
4012 if ($sampling_algorithm == 2) { 3917 if ($sampling_algorithm == 2) {
4013 # Remote-heap version 2 3918 # Remote-heap version 2
4014 # The sampling frequency is the rate of a Poisson process. 3919 # The sampling frequency is the rate of a Poisson process.
4015 # This means that the probability of sampling an allocation of 3920 # This means that the probability of sampling an allocation of
4016 # size X with sampling rate Y is 1 - exp(-X/Y) 3921 # size X with sampling rate Y is 1 - exp(-X/Y)
4017 if ($n1 != 0) { 3922 » if ($n1 != 0) {
4018 my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 3923 » my $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
4019 my $scale_factor = 1/(1 - exp(-$ratio)); 3924 » my $scale_factor = 1/(1 - exp(-$ratio));
4020 $n1 *= $scale_factor; 3925 » $n1 *= $scale_factor;
4021 $s1 *= $scale_factor; 3926 » $s1 *= $scale_factor;
4022 } 3927 » }
4023 if ($n2 != 0) { 3928 » if ($n2 != 0) {
4024 my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 3929 » my $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
4025 my $scale_factor = 1/(1 - exp(-$ratio)); 3930 » my $scale_factor = 1/(1 - exp(-$ratio));
4026 $n2 *= $scale_factor; 3931 » $n2 *= $scale_factor;
4027 $s2 *= $scale_factor; 3932 » $s2 *= $scale_factor;
4028 } 3933 » }
4029 } else { 3934 } else {
4030 # Remote-heap version 1 3935 # Remote-heap version 1
4031 my $ratio; 3936 my $ratio;
4032 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 3937 $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
4033 if ($ratio < 1) { 3938 if ($ratio < 1) {
4034 $n1 /= $ratio; 3939 $n1 /= $ratio;
4035 $s1 /= $ratio; 3940 $s1 /= $ratio;
4036 } 3941 }
4037 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 3942 $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
4038 if ($ratio < 1) { 3943 if ($ratio < 1) {
(...skipping 103 matching lines...) Expand 10 before | Expand all | Expand 10 after
4142 4047
4143 my $r = {}; 4048 my $r = {};
4144 $r->{version} = 0; 4049 $r->{version} = 0;
4145 $r->{period} = $sampling_period; 4050 $r->{period} = $sampling_period;
4146 $r->{profile} = $profile; 4051 $r->{profile} = $profile;
4147 $r->{libs} = ParseLibraries($prog, $map, $pcs); 4052 $r->{libs} = ParseLibraries($prog, $map, $pcs);
4148 $r->{pcs} = $pcs; 4053 $r->{pcs} = $pcs;
4149 return $r; 4054 return $r;
4150 } 4055 }
4151 4056
4152 # Given a hex value in the form "0x1abcd" or "1abcd", return either 4057 # Given a hex value in the form "0x1abcd" return "0001abcd" or
4153 # "0001abcd" or "000000000001abcd", depending on the current (global) 4058 # "000000000001abcd", depending on the current address length.
4154 # address length. 4059 # There's probably a more idiomatic (or faster) way to do this...
4155 sub HexExtend { 4060 sub HexExtend {
4156 my $addr = shift; 4061 my $addr = shift;
4157 4062
4158 $addr =~ s/^(0x)?0*//; 4063 $addr =~ s/^0x//;
4159 my $zeros_needed = $address_length - length($addr); 4064
4160 if ($zeros_needed < 0) { 4065 if (length $addr > $address_length) {
4161 printf STDERR "Warning: address $addr is longer than address length $address _length\n"; 4066 printf STDERR "Warning: address $addr is longer than address length $addres s_length\n";
4162 return $addr;
4163 } 4067 }
4164 return ("0" x $zeros_needed) . $addr; 4068
4069 return substr("000000000000000".$addr, -$address_length);
4165 } 4070 }
4166 4071
4167 ##### Symbol extraction ##### 4072 ##### Symbol extraction #####
4168 4073
4169 # Aggressively search the lib_prefix values for the given library 4074 # Aggressively search the lib_prefix values for the given library
4170 # If all else fails, just return the name of the library unmodified. 4075 # 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" 4076 # 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: 4077 # it will search the following locations in this order, until it finds a file:
4173 # /my/path/lib/dir/mylib.so 4078 # /my/path/lib/dir/mylib.so
4174 # /other/path/lib/dir/mylib.so 4079 # /other/path/lib/dir/mylib.so
(...skipping 30 matching lines...) Expand all
4205 4110
4206 # Parse text section header of a library using objdump 4111 # Parse text section header of a library using objdump
4207 sub ParseTextSectionHeaderFromObjdump { 4112 sub ParseTextSectionHeaderFromObjdump {
4208 my $lib = shift; 4113 my $lib = shift;
4209 4114
4210 my $size = undef; 4115 my $size = undef;
4211 my $vma; 4116 my $vma;
4212 my $file_offset; 4117 my $file_offset;
4213 # Get objdump output from the library file to figure out how to 4118 # Get objdump output from the library file to figure out how to
4214 # map between mapped addresses and addresses in the library. 4119 # map between mapped addresses and addresses in the library.
4215 my $cmd = ShellEscape($obj_tool_map{"objdump"}, "-h", $lib); 4120 my $objdump = $obj_tool_map{"objdump"};
4216 open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); 4121 open(OBJDUMP, "$objdump -h $lib |")
4122 || error("$objdump $lib: $!\n");
4217 while (<OBJDUMP>) { 4123 while (<OBJDUMP>) {
4218 s/\r//g; # turn windows-looking lines into unix-looking lines 4124 s/\r//g; # turn windows-looking lines into unix-looking lines
4219 # Idx Name Size VMA LMA File off Algn 4125 # Idx Name Size VMA LMA File off Algn
4220 # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4 4126 # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4
4221 # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file 4127 # 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. 4128 # offset may still be 8. But AddressSub below will still handle that.
4223 my @x = split; 4129 my @x = split;
4224 if (($#x >= 6) && ($x[1] eq '.text')) { 4130 if (($#x >= 6) && ($x[1] eq '.text')) {
4225 $size = $x[2]; 4131 $size = $x[2];
4226 $vma = $x[3]; 4132 $vma = $x[3];
(...skipping 17 matching lines...) Expand all
4244 4150
4245 # Parse text section header of a library using otool (on OS X) 4151 # Parse text section header of a library using otool (on OS X)
4246 sub ParseTextSectionHeaderFromOtool { 4152 sub ParseTextSectionHeaderFromOtool {
4247 my $lib = shift; 4153 my $lib = shift;
4248 4154
4249 my $size = undef; 4155 my $size = undef;
4250 my $vma = undef; 4156 my $vma = undef;
4251 my $file_offset = undef; 4157 my $file_offset = undef;
4252 # Get otool output from the library file to figure out how to 4158 # Get otool output from the library file to figure out how to
4253 # map between mapped addresses and addresses in the library. 4159 # map between mapped addresses and addresses in the library.
4254 my $command = ShellEscape($obj_tool_map{"otool"}, "-l", $lib); 4160 my $otool = $obj_tool_map{"otool"};
4255 open(OTOOL, "$command |") || error("$command: $!\n"); 4161 open(OTOOL, "$otool -l $lib |")
4162 || error("$otool $lib: $!\n");
4256 my $cmd = ""; 4163 my $cmd = "";
4257 my $sectname = ""; 4164 my $sectname = "";
4258 my $segname = ""; 4165 my $segname = "";
4259 foreach my $line (<OTOOL>) { 4166 foreach my $line (<OTOOL>) {
4260 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 4167 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
4261 # Load command <#> 4168 # Load command <#>
4262 # cmd LC_SEGMENT 4169 # cmd LC_SEGMENT
4263 # [...] 4170 # [...]
4264 # Section 4171 # Section
4265 # sectname __text 4172 # sectname __text
(...skipping 321 matching lines...) Expand 10 before | Expand all | Expand 10 after
4587 my $libname = $lib->[0]; 4494 my $libname = $lib->[0];
4588 my $start = $lib->[1]; 4495 my $start = $lib->[1];
4589 my $finish = $lib->[2]; 4496 my $finish = $lib->[2];
4590 my $offset = $lib->[3]; 4497 my $offset = $lib->[3];
4591 4498
4592 # Get list of pcs that belong in this library. 4499 # Get list of pcs that belong in this library.
4593 my $contained = []; 4500 my $contained = [];
4594 my ($start_pc_index, $finish_pc_index); 4501 my ($start_pc_index, $finish_pc_index);
4595 # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index]. 4502 # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index].
4596 for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; 4503 for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0;
4597 $finish_pc_index--) { 4504 » $finish_pc_index--) {
4598 last if $pcs[$finish_pc_index - 1] le $finish; 4505 last if $pcs[$finish_pc_index - 1] le $finish;
4599 } 4506 }
4600 # Find smallest start_pc_index such that $start <= $pc[$start_pc_index]. 4507 # Find smallest start_pc_index such that $start <= $pc[$start_pc_index].
4601 for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; 4508 for ($start_pc_index = $finish_pc_index; $start_pc_index > 0;
4602 $start_pc_index--) { 4509 » $start_pc_index--) {
4603 last if $pcs[$start_pc_index - 1] lt $start; 4510 last if $pcs[$start_pc_index - 1] lt $start;
4604 } 4511 }
4605 # This keeps PC values higher than $pc[$finish_pc_index] in @pcs, 4512 # This keeps PC values higher than $pc[$finish_pc_index] in @pcs,
4606 # in case there are overlaps in libraries and the main binary. 4513 # in case there are overlaps in libraries and the main binary.
4607 @{$contained} = splice(@pcs, $start_pc_index, 4514 @{$contained} = splice(@pcs, $start_pc_index,
4608 $finish_pc_index - $start_pc_index); 4515 » » » $finish_pc_index - $start_pc_index);
4609 # Map to symbols 4516 # Map to symbols
4610 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); 4517 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols);
4611 } 4518 }
4612 4519
4613 return $symbols; 4520 return $symbols;
4614 } 4521 }
4615 4522
4616 # Map list of PC values to symbols for a given image 4523 # Map list of PC values to symbols for a given image
4617 sub MapToSymbols { 4524 sub MapToSymbols {
4618 my $image = shift; 4525 my $image = shift;
4619 my $offset = shift; 4526 my $offset = shift;
4620 my $pclist = shift; 4527 my $pclist = shift;
4621 my $symbols = shift; 4528 my $symbols = shift;
4622 4529
4623 my $debug = 0; 4530 my $debug = 0;
4624 4531
4625 # Ignore empty binaries 4532 # Ignore empty binaries
4626 if ($#{$pclist} < 0) { return; } 4533 if ($#{$pclist} < 0) { return; }
4627 4534
4628 # Figure out the addr2line command to use 4535 # Figure out the addr2line command to use
4629 my $addr2line = $obj_tool_map{"addr2line"}; 4536 my $addr2line = $obj_tool_map{"addr2line"};
4630 my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image); 4537 my $cmd = "$addr2line -f -C -e $image";
4631 if (exists $obj_tool_map{"addr2line_pdb"}) { 4538 if (exists $obj_tool_map{"addr2line_pdb"}) {
4632 $addr2line = $obj_tool_map{"addr2line_pdb"}; 4539 $addr2line = $obj_tool_map{"addr2line_pdb"};
4633 $cmd = ShellEscape($addr2line, "--demangle", "-f", "-C", "-e", $image); 4540 $cmd = "$addr2line --demangle -f -C -e $image";
4634 } 4541 }
4635 4542
4636 # If "addr2line" isn't installed on the system at all, just use 4543 # 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). 4544 # nm to get what info we can (function names, but not line numbers).
4638 if (system(ShellEscape($addr2line, "--help") . " >$dev_null 2>&1") != 0) { 4545 if (system("$addr2line --help >$dev_null 2>&1") != 0) {
4639 MapSymbolsWithNM($image, $offset, $pclist, $symbols); 4546 MapSymbolsWithNM($image, $offset, $pclist, $symbols);
4640 return; 4547 return;
4641 } 4548 }
4642 4549
4643 # "addr2line -i" can produce a variable number of lines per input 4550 # "addr2line -i" can produce a variable number of lines per input
4644 # address, with no separator that allows us to tell when data for 4551 # 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 4552 # the next address starts. So we find the address for a special
4646 # symbol (_fini) and interleave this address between all real 4553 # symbol (_fini) and interleave this address between all real
4647 # addresses passed to addr2line. The name of this special symbol 4554 # addresses passed to addr2line. The name of this special symbol
4648 # can then be used as a separator. 4555 # can then be used as a separator.
4649 $sep_address = undef; # May be filled in by MapSymbolsWithNM() 4556 $sep_address = undef; # May be filled in by MapSymbolsWithNM()
4650 my $nm_symbols = {}; 4557 my $nm_symbols = {};
4651 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); 4558 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);
4559 # TODO(csilvers): only add '-i' if addr2line supports it.
4652 if (defined($sep_address)) { 4560 if (defined($sep_address)) {
4653 # Only add " -i" to addr2line if the binary supports it. 4561 # Only add " -i" to addr2line if the binary supports it.
4654 # addr2line --help returns 0, but not if it sees an unknown flag first. 4562 # addr2line --help returns 0, but not if it sees an unknown flag first.
4655 if (system("$cmd -i --help >$dev_null 2>&1") == 0) { 4563 if (system("$cmd -i --help >$dev_null 2>&1") == 0) {
4656 $cmd .= " -i"; 4564 $cmd .= " -i";
4657 } else { 4565 } else {
4658 $sep_address = undef; # no need for sep_address if we don't support -i 4566 $sep_address = undef; # no need for sep_address if we don't support -i
4659 } 4567 }
4660 } 4568 }
4661 4569
4662 # Make file with all PC values with intervening 'sep_address' so 4570 # Make file with all PC values with intervening 'sep_address' so
4663 # that we can reliably detect the end of inlined function list 4571 # that we can reliably detect the end of inlined function list
4664 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); 4572 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
4665 if ($debug) { print("---- $image ---\n"); } 4573 if ($debug) { print("---- $image ---\n"); }
4666 for (my $i = 0; $i <= $#{$pclist}; $i++) { 4574 for (my $i = 0; $i <= $#{$pclist}; $i++) {
4667 # addr2line always reads hex addresses, and does not need '0x' prefix. 4575 # addr2line always reads hex addresses, and does not need '0x' prefix.
4668 if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); } 4576 if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); }
4669 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset)); 4577 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
4670 if (defined($sep_address)) { 4578 if (defined($sep_address)) {
4671 printf ADDRESSES ("%s\n", $sep_address); 4579 printf ADDRESSES ("%s\n", $sep_address);
4672 } 4580 }
4673 } 4581 }
4674 close(ADDRESSES); 4582 close(ADDRESSES);
4675 if ($debug) { 4583 if ($debug) {
4676 print("----\n"); 4584 print("----\n");
4677 system("cat", $main::tmpfile_sym); 4585 system("cat $main::tmpfile_sym");
4678 print("----\n"); 4586 print("----\n");
4679 system("$cmd < " . ShellEscape($main::tmpfile_sym)); 4587 system("$cmd <$main::tmpfile_sym");
4680 print("----\n"); 4588 print("----\n");
4681 } 4589 }
4682 4590
4683 open(SYMBOLS, "$cmd <" . ShellEscape($main::tmpfile_sym) . " |") 4591 open(SYMBOLS, "$cmd <$main::tmpfile_sym |") || error("$cmd: $!\n");
4684 || error("$cmd: $!\n");
4685 my $count = 0; # Index in pclist 4592 my $count = 0; # Index in pclist
4686 while (<SYMBOLS>) { 4593 while (<SYMBOLS>) {
4687 # Read fullfunction and filelineinfo from next pair of lines 4594 # Read fullfunction and filelineinfo from next pair of lines
4688 s/\r?\n$//g; 4595 s/\r?\n$//g;
4689 my $fullfunction = $_; 4596 my $fullfunction = $_;
4690 $_ = <SYMBOLS>; 4597 $_ = <SYMBOLS>;
4691 s/\r?\n$//g; 4598 s/\r?\n$//g;
4692 my $filelinenum = $_; 4599 my $filelinenum = $_;
4693 4600
4694 if (defined($sep_address) && $fullfunction eq $sep_symbol) { 4601 if (defined($sep_address) && $fullfunction eq $sep_symbol) {
4695 # Terminating marker for data for this address 4602 # Terminating marker for data for this address
4696 $count++; 4603 $count++;
4697 next; 4604 next;
4698 } 4605 }
4699 4606
4700 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths 4607 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths
4701 4608
4702 my $pcstr = $pclist->[$count]; 4609 my $pcstr = $pclist->[$count];
4703 my $function = ShortFunctionName($fullfunction); 4610 my $function = ShortFunctionName($fullfunction);
4704 my $nms = $nm_symbols->{$pcstr}; 4611 if ($fullfunction eq '??') {
4705 if (defined($nms)) { 4612 # See if nm found a symbol
4706 if ($fullfunction eq '??') { 4613 my $nms = $nm_symbols->{$pcstr};
4707 # nm found a symbol for us. 4614 if (defined($nms)) {
4708 $function = $nms->[0]; 4615 $function = $nms->[0];
4709 $fullfunction = $nms->[2]; 4616 $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 } 4617 }
4725 } 4618 }
4726 4619
4727 # Prepend to accumulated symbols for pcstr 4620 # Prepend to accumulated symbols for pcstr
4728 # (so that caller comes before callee) 4621 # (so that caller comes before callee)
4729 my $sym = $symbols->{$pcstr}; 4622 my $sym = $symbols->{$pcstr};
4730 if (!defined($sym)) { 4623 if (!defined($sym)) {
4731 $sym = []; 4624 $sym = [];
4732 $symbols->{$pcstr} = $sym; 4625 $symbols->{$pcstr} = $sym;
4733 } 4626 }
4734 unshift(@{$sym}, $function, $filelinenum, $fullfunction); 4627 unshift(@{$sym}, $function, $filelinenum, $fullfunction);
4735 if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } 4628 if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
4736 if (!defined($sep_address)) { 4629 if (!defined($sep_address)) {
4737 # Inlining is off, so this entry ends immediately 4630 # Inlining is off, se this entry ends immediately
4738 $count++; 4631 $count++;
4739 } 4632 }
4740 } 4633 }
4741 close(SYMBOLS); 4634 close(SYMBOLS);
4742 } 4635 }
4743 4636
4744 # Use nm to map the list of referenced PCs to symbols. Return true iff we 4637 # Use nm to map the list of referenced PCs to symbols. Return true iff we
4745 # are able to read procedure information via nm. 4638 # are able to read procedure information via nm.
4746 sub MapSymbolsWithNM { 4639 sub MapSymbolsWithNM {
4747 my $image = shift; 4640 my $image = shift;
(...skipping 86 matching lines...) Expand 10 before | Expand all | Expand 10 after
4834 sub ConfigureObjTools { 4727 sub ConfigureObjTools {
4835 my $prog_file = shift; 4728 my $prog_file = shift;
4836 4729
4837 # Check for the existence of $prog_file because /usr/bin/file does not 4730 # Check for the existence of $prog_file because /usr/bin/file does not
4838 # predictably return error status in prod. 4731 # predictably return error status in prod.
4839 (-e $prog_file) || error("$prog_file does not exist.\n"); 4732 (-e $prog_file) || error("$prog_file does not exist.\n");
4840 4733
4841 my $file_type = undef; 4734 my $file_type = undef;
4842 if (-e "/usr/bin/file") { 4735 if (-e "/usr/bin/file") {
4843 # Follow symlinks (at least for systems where "file" supports that). 4736 # Follow symlinks (at least for systems where "file" supports that).
4844 my $escaped_prog_file = ShellEscape($prog_file); 4737 $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") { 4738 } elsif ($^O == "MSWin32") {
4848 $file_type = "MS Windows"; 4739 $file_type = "MS Windows";
4849 } else { 4740 } else {
4850 print STDERR "WARNING: Can't determine the file type of $prog_file"; 4741 print STDERR "WARNING: Can't determine the file type of $prog_file";
4851 } 4742 }
4852 4743
4853 if ($file_type =~ /64-bit/) { 4744 if ($file_type =~ /64-bit/) {
4854 # Change $address_length to 16 if the program file is ELF 64-bit. 4745 # 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 4746 # We can't detect this from many (most?) heap or lock contention
4856 # profiles, since the actual addresses referenced are generally in low 4747 # profiles, since the actual addresses referenced are generally in low
(...skipping 61 matching lines...) Expand 10 before | Expand all | Expand 10 after
4918 if (-x "$dirname$tool") { 4809 if (-x "$dirname$tool") {
4919 $path = "$dirname$tool"; 4810 $path = "$dirname$tool";
4920 } else { 4811 } else {
4921 $path = $tool; 4812 $path = $tool;
4922 } 4813 }
4923 } 4814 }
4924 if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; } 4815 if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; }
4925 return $path; 4816 return $path;
4926 } 4817 }
4927 4818
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 { 4819 sub cleanup {
4942 unlink($main::tmpfile_sym); 4820 unlink($main::tmpfile_sym);
4943 unlink(keys %main::tempnames); 4821 unlink(keys %main::tempnames);
4944 4822
4945 # We leave any collected profiles in $HOME/pprof in case the user wants 4823 # 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. 4824 # to look at them later. We print a message informing them of this.
4947 if ((scalar(@main::profile_files) > 0) && 4825 if ((scalar(@main::profile_files) > 0) &&
4948 defined($main::collected_profile)) { 4826 defined($main::collected_profile)) {
4949 if (scalar(@main::profile_files) == 1) { 4827 if (scalar(@main::profile_files) == 1) {
4950 print STDERR "Dynamically gathered profile is in $main::collected_profile\ n"; 4828 print STDERR "Dynamically gathered profile is in $main::collected_profile\ n";
(...skipping 17 matching lines...) Expand all
4968 print STDERR $msg; 4846 print STDERR $msg;
4969 cleanup(); 4847 cleanup();
4970 exit(1); 4848 exit(1);
4971 } 4849 }
4972 4850
4973 4851
4974 # Run $nm_command and get all the resulting procedure boundaries whose 4852 # Run $nm_command and get all the resulting procedure boundaries whose
4975 # names match "$regexp" and returns them in a hashtable mapping from 4853 # names match "$regexp" and returns them in a hashtable mapping from
4976 # procedure name to a two-element vector of [start address, end address] 4854 # procedure name to a two-element vector of [start address, end address]
4977 sub GetProcedureBoundariesViaNm { 4855 sub GetProcedureBoundariesViaNm {
4978 my $escaped_nm_command = shift; # shell-escaped 4856 my $nm_command = shift;
4979 my $regexp = shift; 4857 my $regexp = shift;
4980 4858
4981 my $symbol_table = {}; 4859 my $symbol_table = {};
4982 open(NM, "$escaped_nm_command |") || error("$escaped_nm_command: $!\n"); 4860 open(NM, "$nm_command |") || error("$nm_command: $!\n");
4983 my $last_start = "0"; 4861 my $last_start = "0";
4984 my $routine = ""; 4862 my $routine = "";
4985 while (<NM>) { 4863 while (<NM>) {
4986 s/\r//g; # turn windows-looking lines into unix-looking lines 4864 s/\r//g; # turn windows-looking lines into unix-looking lines
4987 if (m/^\s*([0-9a-f]+) (.) (..*)/) { 4865 if (m/^\s*([0-9a-f]+) (.) (..*)/) {
4988 my $start_val = $1; 4866 my $start_val = $1;
4989 my $type = $2; 4867 my $type = $2;
4990 my $this_routine = $3; 4868 my $this_routine = $3;
4991 4869
4992 # It's possible for two symbols to share the same address, if 4870 # It's possible for two symbols to share the same address, if
(...skipping 57 matching lines...) Expand 10 before | Expand all | Expand 10 after
5050 } 4928 }
5051 4929
5052 # Gets the procedure boundaries for all routines in "$image" whose names 4930 # Gets the procedure boundaries for all routines in "$image" whose names
5053 # match "$regexp" and returns them in a hashtable mapping from procedure 4931 # match "$regexp" and returns them in a hashtable mapping from procedure
5054 # name to a two-element vector of [start address, end address]. 4932 # 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. 4933 # Will return an empty map if nm is not installed or not working properly.
5056 sub GetProcedureBoundaries { 4934 sub GetProcedureBoundaries {
5057 my $image = shift; 4935 my $image = shift;
5058 my $regexp = shift; 4936 my $regexp = shift;
5059 4937
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 4938 # For libc libraries, the copy in /usr/lib/debug contains debugging symbols
5076 my $debugging = DebuggingLibrary($image); 4939 my $debugging = DebuggingLibrary($image);
5077 if ($debugging) { 4940 if ($debugging) {
5078 $image = $debugging; 4941 $image = $debugging;
5079 } 4942 }
5080 4943
5081 my $nm = $obj_tool_map{"nm"}; 4944 my $nm = $obj_tool_map{"nm"};
5082 my $cppfilt = $obj_tool_map{"c++filt"}; 4945 my $cppfilt = $obj_tool_map{"c++filt"};
5083 4946
5084 # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm 4947 # 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 4948 # 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 4949 # 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 4950 # properly and get incorrect results). Unfortunately, GNU nm uses -f
5088 # in an incompatible way. So first we test whether our nm supports 4951 # in an incompatible way. So first we test whether our nm supports
5089 # --demangle and -f. 4952 # --demangle and -f.
5090 my $demangle_flag = ""; 4953 my $demangle_flag = "";
5091 my $cppfilt_flag = ""; 4954 my $cppfilt_flag = "";
5092 my $to_devnull = ">$dev_null 2>&1"; 4955 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>" 4956 # In this mode, we do "nm --demangle <foo>"
5095 $demangle_flag = "--demangle"; 4957 $demangle_flag = "--demangle";
5096 $cppfilt_flag = ""; 4958 $cppfilt_flag = "";
5097 } elsif (system(ShellEscape($cppfilt, $image) . $to_devnull) == 0) { 4959 } elsif (system("$cppfilt $image >$dev_null 2>&1") == 0) {
5098 # In this mode, we do "nm <foo> | c++filt" 4960 # In this mode, we do "nm <foo> | c++filt"
5099 $cppfilt_flag = " | " . ShellEscape($cppfilt); 4961 $cppfilt_flag = " | $cppfilt";
5100 }; 4962 };
5101 my $flatten_flag = ""; 4963 my $flatten_flag = "";
5102 if (system(ShellEscape($nm, "-f", $image) . $to_devnull) == 0) { 4964 if (system("$nm -f $image >$dev_null 2>&1") == 0) {
5103 $flatten_flag = "-f"; 4965 $flatten_flag = "-f";
5104 } 4966 }
5105 4967
5106 # Finally, in the case $imagie isn't a debug library, we try again with 4968 # 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, 4969 # -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. 4970 # we use c++filt instead, if it exists on this system.
5109 my @nm_commands = (ShellEscape($nm, "-n", $flatten_flag, $demangle_flag, 4971 my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" .
5110 $image) . " 2>$dev_null $cppfilt_flag", 4972 " $image 2>$dev_null $cppfilt_flag",
5111 ShellEscape($nm, "-D", "-n", $flatten_flag, $demangle_flag, 4973 "$nm -D -n $flatten_flag $demangle_flag" .
5112 $image) . " 2>$dev_null $cppfilt_flag", 4974 " $image 2>$dev_null $cppfilt_flag",
5113 # 6nm is for Go binaries 4975 # 6nm is for Go binaries
5114 ShellEscape("6nm", "$image") . " 2>$dev_null | sort", 4976 » » "6nm $image 2>$dev_null | sort",
5115 ); 4977 );
5116 4978
5117 # If the executable is an MS Windows PDB-format executable, we'll 4979 # 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 4980 # 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 4981 # want to use both unix nm and windows-specific nm_pdb, since
5120 # PDB-format executables can apparently include dwarf .o files. 4982 # PDB-format executables can apparently include dwarf .o files.
5121 if (exists $obj_tool_map{"nm_pdb"}) { 4983 if (exists $obj_tool_map{"nm_pdb"}) {
5122 push(@nm_commands, 4984 my $nm_pdb = $obj_tool_map{"nm_pdb"};
5123 ShellEscape($obj_tool_map{"nm_pdb"}, "--demangle", $image) 4985 push(@nm_commands, "$nm_pdb --demangle $image 2>$dev_null");
5124 . " 2>$dev_null");
5125 } 4986 }
5126 4987
5127 foreach my $nm_command (@nm_commands) { 4988 foreach my $nm_command (@nm_commands) {
5128 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); 4989 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp);
5129 return $symbol_table if (%{$symbol_table}); 4990 return $symbol_table if (%{$symbol_table});
5130 } 4991 }
5131 my $symbol_table = {}; 4992 my $symbol_table = {};
5132 return $symbol_table; 4993 return $symbol_table;
5133 } 4994 }
5134 4995
(...skipping 204 matching lines...) Expand 10 before | Expand all | Expand 10 after
5339 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); 5200 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16);
5340 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); 5201 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);
5341 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); 5202 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);
5342 if ($error_count > 0) { 5203 if ($error_count > 0) {
5343 print STDERR $error_count, " errors: FAILED\n"; 5204 print STDERR $error_count, " errors: FAILED\n";
5344 } else { 5205 } else {
5345 print STDERR "PASS\n"; 5206 print STDERR "PASS\n";
5346 } 5207 }
5347 exit ($error_count); 5208 exit ($error_count);
5348 } 5209 }
OLDNEW
« no previous file with comments | « third_party/tcmalloc/vendor/src/page_heap_allocator.h ('k') | third_party/tcmalloc/vendor/src/profile-handler.h » ('j') | no next file with comments »

Powered by Google App Engine
This is Rietveld 408576698