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

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

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