summaryrefslogtreecommitdiffstats
path: root/third_party/tcmalloc/chromium/src/pprof
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/tcmalloc/chromium/src/pprof')
-rwxr-xr-xthird_party/tcmalloc/chromium/src/pprof1146
1 files changed, 330 insertions, 816 deletions
diff --git a/third_party/tcmalloc/chromium/src/pprof b/third_party/tcmalloc/chromium/src/pprof
index 8aff380..fec0c9e 100755
--- a/third_party/tcmalloc/chromium/src/pprof
+++ b/third_party/tcmalloc/chromium/src/pprof
@@ -89,10 +89,11 @@ my %obj_tool_map = (
);
my $DOT = "dot"; # leave non-absolute, since it may be in /usr/local
my $GV = "gv";
-my $KCACHEGRIND = "kcachegrind";
my $PS2PDF = "ps2pdf";
# These are used for dynamic profiles
-my $URL_FETCHER = "curl -s";
+my $WGET = "wget";
+my $WGET_FLAGS = "--no-http-keep-alive"; # only supported by some wgets
+my $CURL = "curl";
# These are the web pages that servers need to support for dynamic profiles
my $HEAP_PAGE = "/pprof/heap";
@@ -106,12 +107,6 @@ my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?";
my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST
my $PROGRAM_NAME_PAGE = "/pprof/cmdline";
-# These are the web pages that can be named on the command line.
-# All the alternatives must begin with /.
-my $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" .
- "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" .
- "$FILTEREDPROFILE_PAGE)";
-
# default binary name
my $UNKNOWN_BINARY = "(unknown)";
@@ -180,14 +175,12 @@ Output type:
--text Generate text report
--callgrind Generate callgrind format to stdout
--gv Generate Postscript and display
- --web Generate SVG and display
--list=<regexp> Generate source listing of matching routines
--disasm=<regexp> Generate disassembly of matching routines
--symbols Print demangled symbol names found at given addresses
--dot Generate DOT file to stdout
--ps Generate Postcript to stdout
--pdf Generate PDF to stdout
- --svg Generate SVG to stdout
--gif Generate GIF to stdout
--raw Generate symbolized pprof data (useful with remote fetch)
@@ -230,8 +223,6 @@ pprof /bin/ls ls.prof
Enters "interactive" mode
pprof --text /bin/ls ls.prof
Outputs one line per procedure
-pprof --web /bin/ls ls.prof
- Displays annotated call-graph in web browser
pprof --gv /bin/ls ls.prof
Displays annotated call-graph via 'gv'
pprof --gv --focus=Mutex /bin/ls ls.prof
@@ -242,9 +233,6 @@ pprof --list=getdir /bin/ls ls.prof
(Per-line) annotated source listing for getdir()
pprof --disasm=getdir /bin/ls ls.prof
(Per-PC) annotated disassembly for getdir()
-
-pprof http://localhost:1234/
- Enters "interactive" mode
pprof --text localhost:1234
Outputs one line per procedure for localhost:1234
pprof --raw localhost:1234 > ./local.raw
@@ -304,12 +292,10 @@ sub Init() {
$main::opt_disasm = "";
$main::opt_symbols = 0;
$main::opt_gv = 0;
- $main::opt_web = 0;
$main::opt_dot = 0;
$main::opt_ps = 0;
$main::opt_pdf = 0;
$main::opt_gif = 0;
- $main::opt_svg = 0;
$main::opt_raw = 0;
$main::opt_nodecount = 80;
@@ -344,16 +330,13 @@ sub Init() {
# Are we using $SYMBOL_PAGE?
$main::use_symbol_page = 0;
- # Files returned by TempName.
- %main::tempnames = ();
-
# Type of profile we are dealing with
# Supported types:
- # cpu
- # heap
- # growth
- # contention
- $main::profile_type = ''; # Empty type means "unknown"
+ # cpu
+ # heap
+ # growth
+ # contention
+ $main::profile_type = ''; # Empty type means "unknown"
GetOptions("help!" => \$main::opt_help,
"version!" => \$main::opt_version,
@@ -372,11 +355,9 @@ sub Init() {
"disasm=s" => \$main::opt_disasm,
"symbols!" => \$main::opt_symbols,
"gv!" => \$main::opt_gv,
- "web!" => \$main::opt_web,
"dot!" => \$main::opt_dot,
"ps!" => \$main::opt_ps,
"pdf!" => \$main::opt_pdf,
- "svg!" => \$main::opt_svg,
"gif!" => \$main::opt_gif,
"raw!" => \$main::opt_raw,
"interactive!" => \$main::opt_interactive,
@@ -399,8 +380,8 @@ sub Init() {
"tools=s" => \$main::opt_tools,
"test!" => \$main::opt_test,
"debug!" => \$main::opt_debug,
- # Undocumented flags used only by unittests:
- "test_stride=i" => \$main::opt_test_stride,
+ # Undocumented flags used only by unittests:
+ "test_stride=i" => \$main::opt_test_stride,
) || usage("Invalid option(s)");
# Deal with the standard --help and --version
@@ -452,11 +433,9 @@ sub Init() {
($main::opt_disasm eq '' ? 0 : 1) +
($main::opt_symbols == 0 ? 0 : 1) +
$main::opt_gv +
- $main::opt_web +
$main::opt_dot +
$main::opt_ps +
$main::opt_pdf +
- $main::opt_svg +
$main::opt_gif +
$main::opt_raw +
$main::opt_interactive +
@@ -531,6 +510,20 @@ sub Init() {
ConfigureObjTools($main::prog)
}
+ # Check what flags our commandline utilities support
+ if (open(TFILE, "$WGET $WGET_FLAGS -V 2>&1 |")) {
+ my @lines = <TFILE>;
+ if (grep(/unrecognized/, @lines) > 0) {
+ # grep found 'unrecognized' token from WGET, clear WGET flags
+ $WGET_FLAGS = "";
+ }
+ close(TFILE);
+ }
+ # TODO(csilvers): check all the other binaries and objtools to see
+ # if they are installed and what flags they support, and store that
+ # in a data structure here, rather than scattering these tests about.
+ # Then, ideally, rewrite code to use wget OR curl OR GET or ...
+
# Break the opt_list_prefix into the prefix_list array
@prefix_list = split (',', $main::opt_lib_prefix);
@@ -641,24 +634,9 @@ sub Main() {
} else {
if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
if ($main::opt_gv) {
- RunGV(TempName($main::next_tmpfile, "ps"), "");
- } elsif ($main::opt_web) {
- my $tmp = TempName($main::next_tmpfile, "svg");
- RunWeb($tmp);
- # The command we run might hand the file name off
- # to an already running browser instance and then exit.
- # Normally, we'd remove $tmp on exit (right now),
- # but fork a child to remove $tmp a little later, so that the
- # browser has time to load it first.
- delete $main::tempnames{$tmp};
- if (fork() == 0) {
- sleep 5;
- unlink($tmp);
- exit(0);
- }
+ RunGV(PsTempName($main::next_tmpfile), "");
}
} else {
- cleanup();
exit(1);
}
}
@@ -689,7 +667,7 @@ sub ReadlineMightFail {
sub RunGV {
my $fname = shift;
- my $bg = shift; # "" or " &" if we should run in background
+ my $bg = shift; # "" or " &" if we should run in background
if (!system("$GV --version >/dev/null 2>&1")) {
# Options using double dash are supported by this gv version.
# Also, turn on noantialias to better handle bug in gv for
@@ -704,41 +682,6 @@ sub RunGV {
}
}
-sub RunWeb {
- my $fname = shift;
- print STDERR "Loading web page file:///$fname\n";
-
- if (`uname` =~ /Darwin/) {
- # OS X: open will use standard preference for SVG files.
- system("/usr/bin/open", $fname);
- return;
- }
-
- # Some kind of Unix; try generic symlinks, then specific browsers.
- # (Stop once we find one.)
- # Works best if the browser is already running.
- my @alt = (
- "/etc/alternatives/gnome-www-browser",
- "/etc/alternatives/x-www-browser",
- "google-chrome",
- "firefox",
- );
- foreach my $b (@alt) {
- if (system($b, $fname) == 0) {
- return;
- }
- }
-
- print STDERR "Could not load web browser.\n";
-}
-
-sub RunKcachegrind {
- my $fname = shift;
- my $bg = shift; # "" or " &" if we should run in background
- print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n";
- system("$KCACHEGRIND " . $fname . $bg);
-}
-
##### Interactive helper routines #####
@@ -746,11 +689,10 @@ sub InteractiveMode {
$| = 1; # Make output unbuffered for interactive mode
my ($orig_profile, $symbols, $libs, $total) = @_;
- print STDERR "Welcome to pprof! For help, type 'help'.\n";
+ print "Welcome to pprof! For help, type 'help'.\n";
- # Use ReadLine if it's installed and input comes from a console.
- if ( -t STDIN &&
- !ReadlineMightFail() &&
+ # Use ReadLine if it's installed.
+ if ( !ReadlineMightFail() &&
defined(eval {require Term::ReadLine}) ) {
my $term = new Term::ReadLine 'pprof';
while ( defined ($_ = $term->readline('(pprof) '))) {
@@ -761,7 +703,7 @@ sub InteractiveMode {
}
} else { # don't have readline
while (1) {
- print STDERR "(pprof) ";
+ print "(pprof) ";
$_ = <STDIN>;
last if ! defined $_ ;
s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -785,13 +727,13 @@ sub InteractiveCommand {
my($orig_profile, $symbols, $libs, $total, $command) = @_;
$_ = $command; # just to make future m//'s easier
if (!defined($_)) {
- print STDERR "\n";
+ print "\n";
return 0;
}
- if (m/^\s*quit/) {
+ if (m/^ *quit/) {
return 0;
}
- if (m/^\s*help/) {
+ if (m/^ *help/) {
InteractiveHelpMessage();
return 1;
}
@@ -803,7 +745,7 @@ sub InteractiveCommand {
$main::opt_gv = 0;
$main::opt_cum = 0;
- if (m/^\s*(text|top)(\d*)\s*(.*)/) {
+ if (m/^ *(text|top)(\d*) *(.*)/) {
$main::opt_text = 1;
my $line_limit = ($2 ne "") ? int($2) : 10;
@@ -822,24 +764,7 @@ sub InteractiveCommand {
PrintText($symbols, $flat, $cumulative, $total, $line_limit);
return 1;
}
- if (m/^\s*callgrind\s*([^ \n]*)/) {
- $main::opt_callgrind = 1;
-
- # Get derived profiles
- my $calls = ExtractCalls($symbols, $orig_profile);
- my $filename = $1;
- if ( $1 eq '' ) {
- $filename = TempName($main::next_tmpfile, "callgrind");
- }
- PrintCallgrind($calls, $filename);
- if ( $1 eq '' ) {
- RunKcachegrind($filename, " & ");
- $main::next_tmpfile++;
- }
-
- return 1;
- }
- if (m/^\s*list\s*(.+)/) {
+ if (m/^ *list *(.+)/) {
$main::opt_list = 1;
my $routine;
@@ -856,7 +781,7 @@ sub InteractiveCommand {
PrintListing($libs, $flat, $cumulative, $routine);
return 1;
}
- if (m/^\s*disasm\s*(.+)/) {
+ if (m/^ *disasm *(.+)/) {
$main::opt_disasm = 1;
my $routine;
@@ -874,18 +799,12 @@ sub InteractiveCommand {
PrintDisassembly($libs, $flat, $cumulative, $routine, $total);
return 1;
}
- if (m/^\s*(gv|web)\s*(.*)/) {
- $main::opt_gv = 0;
- $main::opt_web = 0;
- if ($1 eq "gv") {
- $main::opt_gv = 1;
- } elsif ($1 eq "web") {
- $main::opt_web = 1;
- }
+ if (m/^ *gv *(.*)/) {
+ $main::opt_gv = 1;
my $focus;
my $ignore;
- ($focus, $ignore) = ParseInteractiveArgs($2);
+ ($focus, $ignore) = ParseInteractiveArgs($1);
# Process current profile to account for various settings
my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore);
@@ -896,19 +815,11 @@ sub InteractiveCommand {
my $cumulative = CumulativeProfile($reduced);
if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
- if ($main::opt_gv) {
- RunGV(TempName($main::next_tmpfile, "ps"), " &");
- } elsif ($main::opt_web) {
- RunWeb(TempName($main::next_tmpfile, "svg"));
- }
+ RunGV(PsTempName($main::next_tmpfile), " &");
$main::next_tmpfile++;
}
return 1;
}
- if (m/^\s*$/) {
- return 1;
- }
- print STDERR "Unknown command: try 'help'.\n";
return 1;
}
@@ -945,7 +856,7 @@ sub ProcessProfile {
}
sub InteractiveHelpMessage {
- print STDERR <<ENDOFHELP;
+ print <<ENDOFHELP;
Interactive pprof mode
Commands:
@@ -957,14 +868,6 @@ Commands:
the "focus" regular expression matches a routine name on the stack
trace.
- web
- web [focus] [-ignore1] [-ignore2]
- Like GV, but displays profile in your web browser instead of using
- Ghostview. Works best if your web browser is already running.
- To change the browser that gets used:
- On Linux, set the /etc/alternatives/gnome-www-browser symlink.
- On OS X, change the Finder association for SVG files.
-
list [routine_regexp] [-ignore1] [-ignore2]
Show source listing of routines whose names match "routine_regexp"
@@ -979,10 +882,6 @@ Commands:
Show disassembly of routines whose names match "routine_regexp",
annotated with sample counts.
- callgrind
- callgrind [filename]
- Generates callgrind file. If no filename is given, kcachegrind is called.
-
help - This listing
quit or ^D - End pprof
@@ -1014,19 +913,16 @@ sub ParseInteractiveArgs {
}
}
if ($ignore ne "") {
- print STDERR "Ignoring samples in call stacks that match '$ignore'\n";
+ print "Ignoring samples in call stacks that match '$ignore'\n";
}
return ($focus, $ignore);
}
##### Output code #####
-sub TempName {
+sub PsTempName {
my $fnum = shift;
- my $ext = shift;
- my $file = "$main::tmpfile_ps.$fnum.$ext";
- $main::tempnames{$file} = 1;
- return $file;
+ return "$main::tmpfile_ps" . "." . "$fnum" . ".ps";
}
# Print profile data in packed binary format (64-bit) to standard out
@@ -1149,15 +1045,7 @@ sub PrintText {
# Print the call graph in a way that's suiteable for callgrind.
sub PrintCallgrind {
my $calls = shift;
- my $filename;
- if ($main::opt_interactive) {
- $filename = shift;
- print STDERR "Writing callgrind file to '$filename'.\n"
- } else {
- $filename = "&STDOUT";
- }
- open(CG, ">".$filename );
- printf CG ("events: Hits\n\n");
+ printf("events: Hits\n\n");
foreach my $call ( map { $_->[0] }
sort { $a->[1] cmp $b ->[1] ||
$a->[2] <=> $b->[2] }
@@ -1169,15 +1057,13 @@ sub PrintCallgrind {
my ( $caller_file, $caller_line, $caller_function,
$callee_file, $callee_line, $callee_function ) =
( $1, $2, $3, $5, $6, $7 );
-
-
- printf CG ("fl=$caller_file\nfn=$caller_function\n");
+ printf("fl=$caller_file\nfn=$caller_function\n");
if (defined $6) {
- printf CG ("cfl=$callee_file\n");
- printf CG ("cfn=$callee_function\n");
- printf CG ("calls=$count $callee_line\n");
+ printf("cfl=$callee_file\n");
+ printf("cfn=$callee_function\n");
+ printf("calls=$count $callee_line\n");
}
- printf CG ("$caller_line $count\n\n");
+ printf("$caller_line $count\n\n");
}
}
@@ -1499,7 +1385,7 @@ sub SourceLine {
return undef;
}
my $lines = [];
- push(@{$lines}, ""); # So we can use 1-based line numbers as indices
+ push(@{$lines}, ""); # So we can use 1-based line numbers as indices
while (<FILE>) {
push(@{$lines}, $_);
}
@@ -1591,8 +1477,8 @@ sub PrintDisassembledFunction {
# Find run of instructions for this range of source lines
my $first_inst = $i;
while (($i <= $#instructions) &&
- ($instructions[$i]->[2] >= $first_line) &&
- ($instructions[$i]->[2] <= $last_line)) {
+ ($instructions[$i]->[2] >= $first_line) &&
+ ($instructions[$i]->[2] <= $last_line)) {
$e = $instructions[$i];
$flat_sum{$e->[2]} += $flat_count[$i];
$cum_sum{$e->[2]} += $cum_count[$i];
@@ -1604,16 +1490,16 @@ sub PrintDisassembledFunction {
for (my $l = $first_line; $l <= $last_line; $l++) {
my $line = SourceLine($current_file, $l);
if (!defined($line)) {
- $line = "?\n";
+ $line = "?\n";
next;
} else {
$line =~ s/^\s+//;
}
printf("%6s %6s %5d: %s",
- UnparseAlt($flat_sum{$l}),
- UnparseAlt($cum_sum{$l}),
- $l,
- $line);
+ UnparseAlt($flat_sum{$l}),
+ UnparseAlt($cum_sum{$l}),
+ $l,
+ $line);
}
# Print disassembly
@@ -1630,9 +1516,9 @@ sub PrintDisassembledFunction {
while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments
printf("%6s %6s %8s: %6s\n",
- UnparseAlt($flat_count[$x]),
- UnparseAlt($cum_count[$x]),
- $address,
+ UnparseAlt($flat_count[$x]),
+ UnparseAlt($cum_count[$x]),
+ $address,
$d);
}
}
@@ -1656,7 +1542,7 @@ sub PrintDot {
# Find nodes to include
my @list = (sort { abs(GetEntry($cumulative, $b)) <=>
abs(GetEntry($cumulative, $a))
- || $a cmp $b }
+ || $a cmp $b }
keys(%{$cumulative}));
my $last = $nodecount - 1;
if ($last > $#list) {
@@ -1668,6 +1554,7 @@ sub PrintDot {
}
if ($last < 0) {
print STDERR "No nodes to print\n";
+ cleanup();
return 0;
}
@@ -1680,14 +1567,11 @@ sub PrintDot {
# Open DOT output file
my $output;
if ($main::opt_gv) {
- $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps");
+ $output = "| $DOT -Tps2 >" . PsTempName($main::next_tmpfile);
} elsif ($main::opt_ps) {
$output = "| $DOT -Tps2";
} elsif ($main::opt_pdf) {
$output = "| $DOT -Tps2 | $PS2PDF - -";
- } elsif ($main::opt_web || $main::opt_svg) {
- # We need to post-process the SVG, so write to a temporary file always.
- $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg");
} elsif ($main::opt_gif) {
$output = "| $DOT -Tgif";
} else {
@@ -1798,10 +1682,7 @@ sub PrintDot {
my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0);
if ($fraction > 1) { $fraction = 1; }
my $w = $fraction * 2;
- if ($w < 1 && ($main::opt_web || $main::opt_svg)) {
- # SVG output treats line widths < 1 poorly.
- $w = 1;
- }
+ #if ($w < 1) { $w = 1; }
# Dot sometimes segfaults if given edge weights that are too large, so
# we cap the weights at a large value
@@ -1825,312 +1706,11 @@ sub PrintDot {
}
print DOT ("}\n");
- close(DOT);
-
- if ($main::opt_web || $main::opt_svg) {
- # Rewrite SVG to be more usable inside web browser.
- RewriteSvg(TempName($main::next_tmpfile, "svg"));
- }
+ close(DOT);
return 1;
}
-sub RewriteSvg {
- my $svgfile = shift;
-
- open(SVG, $svgfile) || die "open temp svg: $!";
- my @svg = <SVG>;
- close(SVG);
- unlink $svgfile;
- my $svg = join('', @svg);
-
- # Dot's SVG output is
- #
- # <svg width="___" height="___"
- # viewBox="___" xmlns=...>
- # <g id="graph0" transform="...">
- # ...
- # </g>
- # </svg>
- #
- # Change it to
- #
- # <svg width="100%" height="100%"
- # xmlns=...>
- # $svg_javascript
- # <g id="viewport" transform="translate(0,0)">
- # <g id="graph0" transform="...">
- # ...
- # </g>
- # </g>
- # </svg>
-
- # Fix width, height; drop viewBox.
- $svg =~ s/(?s)<svg width="[^"]+" height="[^"]+"(.*?)viewBox="[^"]+"/<svg width="100%" height="100%"$1/;
-
- # Insert script, viewport <g> above first <g>
- my $svg_javascript = SvgJavascript();
- my $viewport = "<g id=\"viewport\" transform=\"translate(0,0)\">\n";
- $svg =~ s/<g id="graph\d"/$svg_javascript$viewport$&/;
-
- # Insert final </g> above </svg>.
- $svg =~ s/(.*)(<\/svg>)/$1<\/g>$2/;
- $svg =~ s/<g id="graph\d"(.*?)/<g id="viewport"$1/;
-
- if ($main::opt_svg) {
- # --svg: write to standard output.
- print $svg;
- } else {
- # Write back to temporary file.
- open(SVG, ">$svgfile") || die "open $svgfile: $!";
- print SVG $svg;
- close(SVG);
- }
-}
-
-sub SvgJavascript {
- return <<'EOF';
-<script type="text/ecmascript"><![CDATA[
-// SVGPan
-// http://www.cyberz.org/blog/2009/12/08/svgpan-a-javascript-svg-panzoomdrag-library/
-// Local modification: if(true || ...) below to force panning, never moving.
-
-/**
- * SVGPan library 1.2
- * ====================
- *
- * Given an unique existing element with id "viewport", including the
- * the library into any SVG adds the following capabilities:
- *
- * - Mouse panning
- * - Mouse zooming (using the wheel)
- * - Object dargging
- *
- * Known issues:
- *
- * - Zooming (while panning) on Safari has still some issues
- *
- * Releases:
- *
- * 1.2, Sat Mar 20 08:42:50 GMT 2010, Zeng Xiaohui
- * Fixed a bug with browser mouse handler interaction
- *
- * 1.1, Wed Feb 3 17:39:33 GMT 2010, Zeng Xiaohui
- * Updated the zoom code to support the mouse wheel on Safari/Chrome
- *
- * 1.0, Andrea Leofreddi
- * First release
- *
- * This code is licensed under the following BSD license:
- *
- * Copyright 2009-2010 Andrea Leofreddi <a.leofreddi@itcharm.com>. All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without modification, are
- * permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice, this list of
- * conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice, this list
- * of conditions and the following disclaimer in the documentation and/or other materials
- * provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED BY Andrea Leofreddi ``AS IS'' AND ANY EXPRESS OR IMPLIED
- * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Andrea Leofreddi OR
- * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
- * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
- * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- * The views and conclusions contained in the software and documentation are those of the
- * authors and should not be interpreted as representing official policies, either expressed
- * or implied, of Andrea Leofreddi.
- */
-
-var root = document.documentElement;
-
-var state = 'none', stateTarget, stateOrigin, stateTf;
-
-setupHandlers(root);
-
-/**
- * Register handlers
- */
-function setupHandlers(root){
- setAttributes(root, {
- "onmouseup" : "add(evt)",
- "onmousedown" : "handleMouseDown(evt)",
- "onmousemove" : "handleMouseMove(evt)",
- "onmouseup" : "handleMouseUp(evt)",
- //"onmouseout" : "handleMouseUp(evt)", // Decomment this to stop the pan functionality when dragging out of the SVG element
- });
-
- if(navigator.userAgent.toLowerCase().indexOf('webkit') >= 0)
- window.addEventListener('mousewheel', handleMouseWheel, false); // Chrome/Safari
- else
- window.addEventListener('DOMMouseScroll', handleMouseWheel, false); // Others
-
- var g = svgDoc.getElementById("svg");
- g.width = "100%";
- g.height = "100%";
-}
-
-/**
- * Instance an SVGPoint object with given event coordinates.
- */
-function getEventPoint(evt) {
- var p = root.createSVGPoint();
-
- p.x = evt.clientX;
- p.y = evt.clientY;
-
- return p;
-}
-
-/**
- * Sets the current transform matrix of an element.
- */
-function setCTM(element, matrix) {
- var s = "matrix(" + matrix.a + "," + matrix.b + "," + matrix.c + "," + matrix.d + "," + matrix.e + "," + matrix.f + ")";
-
- element.setAttribute("transform", s);
-}
-
-/**
- * Dumps a matrix to a string (useful for debug).
- */
-function dumpMatrix(matrix) {
- var s = "[ " + matrix.a + ", " + matrix.c + ", " + matrix.e + "\n " + matrix.b + ", " + matrix.d + ", " + matrix.f + "\n 0, 0, 1 ]";
-
- return s;
-}
-
-/**
- * Sets attributes of an element.
- */
-function setAttributes(element, attributes){
- for (i in attributes)
- element.setAttributeNS(null, i, attributes[i]);
-}
-
-/**
- * Handle mouse move event.
- */
-function handleMouseWheel(evt) {
- if(evt.preventDefault)
- evt.preventDefault();
-
- evt.returnValue = false;
-
- var svgDoc = evt.target.ownerDocument;
-
- var delta;
-
- if(evt.wheelDelta)
- delta = evt.wheelDelta / 3600; // Chrome/Safari
- else
- delta = evt.detail / -90; // Mozilla
-
- var z = 1 + delta; // Zoom factor: 0.9/1.1
-
- var g = svgDoc.getElementById("viewport");
-
- var p = getEventPoint(evt);
-
- p = p.matrixTransform(g.getCTM().inverse());
-
- // Compute new scale matrix in current mouse position
- var k = root.createSVGMatrix().translate(p.x, p.y).scale(z).translate(-p.x, -p.y);
-
- setCTM(g, g.getCTM().multiply(k));
-
- stateTf = stateTf.multiply(k.inverse());
-}
-
-/**
- * Handle mouse move event.
- */
-function handleMouseMove(evt) {
- if(evt.preventDefault)
- evt.preventDefault();
-
- evt.returnValue = false;
-
- var svgDoc = evt.target.ownerDocument;
-
- var g = svgDoc.getElementById("viewport");
-
- if(state == 'pan') {
- // Pan mode
- var p = getEventPoint(evt).matrixTransform(stateTf);
-
- setCTM(g, stateTf.inverse().translate(p.x - stateOrigin.x, p.y - stateOrigin.y));
- } else if(state == 'move') {
- // Move mode
- var p = getEventPoint(evt).matrixTransform(g.getCTM().inverse());
-
- setCTM(stateTarget, root.createSVGMatrix().translate(p.x - stateOrigin.x, p.y - stateOrigin.y).multiply(g.getCTM().inverse()).multiply(stateTarget.getCTM()));
-
- stateOrigin = p;
- }
-}
-
-/**
- * Handle click event.
- */
-function handleMouseDown(evt) {
- if(evt.preventDefault)
- evt.preventDefault();
-
- evt.returnValue = false;
-
- var svgDoc = evt.target.ownerDocument;
-
- var g = svgDoc.getElementById("viewport");
-
- if(true || evt.target.tagName == "svg") {
- // Pan mode
- state = 'pan';
-
- stateTf = g.getCTM().inverse();
-
- stateOrigin = getEventPoint(evt).matrixTransform(stateTf);
- } else {
- // Move mode
- state = 'move';
-
- stateTarget = evt.target;
-
- stateTf = g.getCTM().inverse();
-
- stateOrigin = getEventPoint(evt).matrixTransform(stateTf);
- }
-}
-
-/**
- * Handle mouse button release event.
- */
-function handleMouseUp(evt) {
- if(evt.preventDefault)
- evt.preventDefault();
-
- evt.returnValue = false;
-
- var svgDoc = evt.target.ownerDocument;
-
- if(state == 'pan' || state == 'move') {
- // Quit pan mode
- state = '';
- }
-}
-
-]]></script>
-EOF
-}
-
# Translate a stack of addresses into a stack of symbols
sub TranslateStack {
my $symbols = shift;
@@ -2226,7 +1806,7 @@ sub Unparse {
}
}
} elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {
- return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds
+ return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds
} else {
return sprintf("%d", $num);
}
@@ -2367,42 +1947,42 @@ sub RemoveUninterestingFrames {
'malloc',
'free',
'memalign',
- 'posix_memalign',
+ 'posix_memalign',
'pvalloc',
'valloc',
'realloc',
- 'tc_calloc',
+ 'tc_calloc',
'tc_cfree',
'tc_malloc',
'tc_free',
'tc_memalign',
- 'tc_posix_memalign',
+ 'tc_posix_memalign',
'tc_pvalloc',
'tc_valloc',
'tc_realloc',
- 'tc_new',
- 'tc_delete',
- 'tc_newarray',
- 'tc_deletearray',
- 'tc_new_nothrow',
- 'tc_newarray_nothrow',
- 'do_malloc',
+ 'tc_new',
+ 'tc_delete',
+ 'tc_newarray',
+ 'tc_deletearray',
+ 'tc_new_nothrow',
+ 'tc_newarray_nothrow',
+ 'do_malloc',
'::do_malloc', # new name -- got moved to an unnamed ns
'::do_malloc_or_cpp_alloc',
'DoSampledAllocation',
- 'simple_alloc::allocate',
- '__malloc_alloc_template::allocate',
+ 'simple_alloc::allocate',
+ '__malloc_alloc_template::allocate',
'__builtin_delete',
'__builtin_new',
'__builtin_vec_delete',
'__builtin_vec_new',
'operator new',
'operator new[]',
- # These mark the beginning/end of our custom sections
- '__start_google_malloc',
- '__stop_google_malloc',
- '__start_malloc_hook',
- '__stop_malloc_hook') {
+ # These mark the beginning/end of our custom sections
+ '__start_google_malloc',
+ '__stop_google_malloc',
+ '__start_malloc_hook',
+ '__stop_malloc_hook') {
$skip{$name} = 1;
$skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything
}
@@ -2419,11 +1999,11 @@ sub RemoveUninterestingFrames {
# TODO(dpeng): this should not be necessary; it's taken
# care of by the general 2nd-pc mechanism below.
foreach my $name ('ProfileData::Add', # historical
- 'ProfileData::prof_handler', # historical
- 'CpuProfiler::prof_handler',
+ 'ProfileData::prof_handler', # historical
+ 'CpuProfiler::prof_handler',
'__FRAME_END__',
- '__pthread_sighandler',
- '__restore') {
+ '__pthread_sighandler',
+ '__restore') {
$skip{$name} = 1;
}
} else {
@@ -2462,10 +2042,10 @@ sub RemoveUninterestingFrames {
my @path = ();
foreach my $a (@addrs) {
if (exists($symbols->{$a})) {
- my $func = $symbols->{$a}->[0];
- if ($skip{$func} || ($func =~ m/$skip_regexp/)) {
- next;
- }
+ my $func = $symbols->{$a}->[0];
+ if ($skip{$func} || ($func =~ m/$skip_regexp/)) {
+ next;
+ }
}
push(@path, $a);
}
@@ -2490,8 +2070,8 @@ sub ReduceProfile {
# To avoid double-counting due to recursion, skip a stack-trace
# entry if it has already been seen
if (!$seen{$e}) {
- $seen{$e} = 1;
- push(@path, $e);
+ $seen{$e} = 1;
+ push(@path, $e);
}
}
my $reduced_path = join("\n", @path);
@@ -2685,11 +2265,28 @@ sub AddEntries {
AddEntry($profile, (join "\n", @k), $count);
}
+sub IsSymbolizedProfileFile {
+ my $file_name = shift;
+
+ if (!(-e $file_name) || !(-r $file_name)) {
+ return 0;
+ }
+
+ $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
+ my $symbol_marker = $&;
+ # Check if the file contains a symbol-section marker.
+ open(TFILE, "<$file_name");
+ my @lines = <TFILE>;
+ my $result = grep(/^--- *$symbol_marker/, @lines);
+ close(TFILE);
+ return $result > 0;
+}
+
##### Code to profile a server dynamically #####
sub CheckSymbolPage {
my $url = SymbolPageURL();
- open(SYMBOL, "$URL_FETCHER '$url' |");
+ open(SYMBOL, "$WGET $WGET_FLAGS -qO- '$url' |");
my $line = <SYMBOL>;
$line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
close(SYMBOL);
@@ -2708,45 +2305,33 @@ sub CheckSymbolPage {
sub IsProfileURL {
my $profile_name = shift;
- if (-f $profile_name) {
- printf STDERR "Using local file $profile_name.\n";
- return 0;
- }
- return 1;
+ my ($host, $port, $path) = ParseProfileURL($profile_name);
+ return defined($host) and defined($port) and defined($path);
}
sub ParseProfileURL {
my $profile_name = shift;
-
- if (!defined($profile_name) || $profile_name eq "") {
- return ();
- }
-
- # Split profile URL - matches all non-empty strings, so no test.
- $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,;
-
- my $proto = $1 || "http://";
- my $hostport = $2;
- my $prefix = $3;
- my $profile = $4 || "/";
-
- my $host = $hostport;
- $host =~ s/:.*//;
-
- my $baseurl = "$proto$hostport$prefix";
- return ($host, $baseurl, $profile);
+ if (defined($profile_name) &&
+ $profile_name =~ m,^(http://|)([^/:]+):(\d+)(|\@\d+)(|/|.*($PROFILE_PAGE|$PMUPROFILE_PAGE|$HEAP_PAGE|$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|$FILTEREDPROFILE_PAGE))$,o) {
+ # $6 is $PROFILE_PAGE/$HEAP_PAGE/etc. $5 is *everything* after
+ # the hostname, as long as that everything is the empty string,
+ # a slash, or something ending in $PROFILE_PAGE/$HEAP_PAGE/etc.
+ # So "$6 || $5" is $PROFILE_PAGE/etc if there, or else it's "/" or "".
+ return ($2, $3, $6 || $5);
+ }
+ return ();
}
# We fetch symbols from the first profile argument.
sub SymbolPageURL {
- my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
- return "$baseURL$SYMBOL_PAGE";
+ my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
+ return "http://$host:$port$SYMBOL_PAGE";
}
sub FetchProgramName() {
- my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
- my $url = "$baseURL$PROGRAM_NAME_PAGE";
- my $command_line = "$URL_FETCHER '$url'";
+ my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
+ my $url = "http://$host:$port$PROGRAM_NAME_PAGE";
+ my $command_line = "$WGET $WGET_FLAGS -qO- '$url'";
open(CMDLINE, "$command_line |") or error($command_line);
my $cmdline = <CMDLINE>;
$cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -2763,7 +2348,7 @@ sub FetchProgramName() {
# curl. Redirection happens on borg hosts.
sub ResolveRedirectionForCurl {
my $url = shift;
- my $command_line = "$URL_FETCHER --head '$url'";
+ my $command_line = "$CURL -s --head '$url'";
open(CMDLINE, "$command_line |") or error($command_line);
while (<CMDLINE>) {
s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -2775,20 +2360,6 @@ sub ResolveRedirectionForCurl {
return $url;
}
-# Add a timeout flat to URL_FETCHER
-sub AddFetchTimeout {
- my $fetcher = shift;
- my $timeout = shift;
- if (defined($timeout)) {
- if ($fetcher =~ m/\bcurl -s/) {
- $fetcher .= sprintf(" --max-time %d", $timeout);
- } elsif ($fetcher =~ m/\brpcget\b/) {
- $fetcher .= sprintf(" --deadline=%d", $timeout);
- }
- }
- return $fetcher;
-}
-
# Reads a symbol map from the file handle name given as $1, returning
# the resulting symbol map. Also processes variables relating to symbols.
# Currently, the only variable processed is 'binary=<value>' which updates
@@ -2833,6 +2404,7 @@ sub FetchSymbols {
my $pcset = shift;
my $symbol_map = shift;
+
my %seen = ();
my @pcs = grep { !$seen{$_}++ } keys(%$pcset); # uniq
@@ -2842,16 +2414,12 @@ sub FetchSymbols {
open(POSTFILE, ">$main::tmpfile_sym");
print POSTFILE $post_data;
close(POSTFILE);
-
+
my $url = SymbolPageURL();
-
- my $command_line;
- if ($URL_FETCHER =~ m/\bcurl -s/) {
- $url = ResolveRedirectionForCurl($url);
- $command_line = "$URL_FETCHER -d '\@$main::tmpfile_sym' '$url'";
- } else {
- $command_line = "$URL_FETCHER --post '$url' < '$main::tmpfile_sym'";
- }
+ # Here we use curl for sending data via POST since old
+ # wget doesn't have --post-file option.
+ $url = ResolveRedirectionForCurl($url);
+ my $command_line = "$CURL -sd '\@$main::tmpfile_sym' '$url'";
# We use c++filt in case $SYMBOL_PAGE gives us mangled symbols.
my $cppfilt = $obj_tool_map{"c++filt"};
open(SYMBOL, "$command_line | $cppfilt |") or error($command_line);
@@ -2896,10 +2464,10 @@ sub BaseName {
sub MakeProfileBaseName {
my ($binary_name, $profile_name) = @_;
- my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
+ my ($host, $port, $path) = ParseProfileURL($profile_name);
my $binary_shortname = BaseName($binary_name);
- return sprintf("%s.%s.%s",
- $binary_shortname, $main::op_time, $host);
+ return sprintf("%s.%s.%s-port%s",
+ $binary_shortname, $main::op_time, $host, $port);
}
sub FetchDynamicProfile {
@@ -2911,7 +2479,7 @@ sub FetchDynamicProfile {
if (!IsProfileURL($profile_name)) {
return $profile_name;
} else {
- my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
+ my ($host, $port, $path) = ParseProfileURL($profile_name);
if ($path eq "" || $path eq "/") {
# Missing type specifier defaults to cpu-profile
$path = $PROFILE_PAGE;
@@ -2919,28 +2487,37 @@ sub FetchDynamicProfile {
my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
- my $url = "$baseURL$path";
- my $fetch_timeout = undef;
- if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) {
- if ($path =~ m/[?]/) {
- $url .= "&";
+ my $url;
+ my $wget_timeout;
+ if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) {
+ if ($path =~ m/$PROFILE_PAGE/) {
+ $url = sprintf("http://$host:$port$path?seconds=%d",
+ $main::opt_seconds);
} else {
- $url .= "?";
+ if ($profile_name =~ m/[?]/) {
+ $profile_name .= "&"
+ } else {
+ $profile_name .= "?"
+ }
+ $url = sprintf("http://$profile_name" . "seconds=%d",
+ $main::opt_seconds);
}
- $url .= sprintf("seconds=%d", $main::opt_seconds);
- $fetch_timeout = $main::opt_seconds * 1.01 + 60;
+ $wget_timeout = sprintf("--timeout=%d",
+ int($main::opt_seconds * 1.01 + 60));
} else {
# For non-CPU profiles, we add a type-extension to
# the target profile file name.
my $suffix = $path;
$suffix =~ s,/,.,g;
- $profile_file .= $suffix;
+ $profile_file .= "$suffix";
+ $url = "http://$host:$port$path";
+ $wget_timeout = "";
}
my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof");
- if (! -d $profile_dir) {
+ if (!(-d $profile_dir)) {
mkdir($profile_dir)
- || die("Unable to create profile directory $profile_dir: $!\n");
+ || die("Unable to create profile directory $profile_dir: $!\n");
}
my $tmp_profile = "$profile_dir/.tmp.$profile_file";
my $real_profile = "$profile_dir/$profile_file";
@@ -2949,15 +2526,14 @@ sub FetchDynamicProfile {
return $real_profile;
}
- my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout);
- my $cmd = "$fetcher '$url' > '$tmp_profile'";
- if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/){
+ my $cmd = "$WGET $WGET_FLAGS $wget_timeout -q -O $tmp_profile '$url'";
+ if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){
print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n ${real_profile}\n";
if ($encourage_patience) {
print STDERR "Be patient...\n";
}
} else {
- print STDERR "Fetching $path profile from $url to\n ${real_profile}\n";
+ print STDERR "Fetching $path profile from $host:$port to\n ${real_profile}\n";
}
(system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
@@ -3004,7 +2580,6 @@ sub FetchDynamicProfilesRecurse {
} else {
$position = 1 | ($position << 1);
TryCollectProfile($maxlevel, $level, $position);
- cleanup();
exit(0);
}
}
@@ -3028,69 +2603,22 @@ sub TryCollectProfile {
# Provide a small streaming-read module to handle very large
# cpu-profile files. Stream in chunks along a sliding window.
-# Provides an interface to get one 'slot', correctly handling
-# endian-ness differences. A slot is one 32-bit or 64-bit word
-# (depending on the input profile). We tell endianness and bit-size
-# for the profile by looking at the first 8 bytes: in cpu profiles,
-# the second slot is always 3 (we'll accept anything that's not 0).
BEGIN {
package CpuProfileStream;
sub new {
- my ($class, $file, $fname) = @_;
- my $self = { file => $file,
- base => 0,
- stride => 512 * 1024, # must be a multiple of bitsize/8
- slots => [],
- unpack_code => "", # N for big-endian, V for little
+ my ($class, $file) = @_;
+ my $self = { file => $file,
+ base => 0,
+ stride => 512 * 1024, # must be a multiple of |long|
+ slots => []
};
bless $self, $class;
# Let unittests adjust the stride
if ($main::opt_test_stride > 0) {
$self->{stride} = $main::opt_test_stride;
}
- # Read the first two slots to figure out bitsize and endianness.
- my $slots = $self->{slots};
- my $str;
- read($self->{file}, $str, 8);
- # Set the global $address_length based on what we see here.
- # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars).
- $address_length = ($str eq (chr(0)x8)) ? 16 : 8;
- if ($address_length == 8) {
- if (substr($str, 6, 2) eq chr(0)x2) {
- $self->{unpack_code} = 'V'; # Little-endian.
- } elsif (substr($str, 4, 2) eq chr(0)x2) {
- $self->{unpack_code} = 'N'; # Big-endian
- } else {
- ::error("$fname: header size >= 2**16\n");
- }
- @$slots = unpack($self->{unpack_code} . "*", $str);
- } else {
- # If we're a 64-bit profile, make sure we're a 64-bit-capable
- # perl. Otherwise, each slot will be represented as a float
- # instead of an int64, losing precision and making all the
- # 64-bit addresses right. We *could* try to handle this with
- # software emulation of 64-bit ints, but that's added complexity
- # for no clear benefit (yet). We use 'Q' to test for 64-bit-ness;
- # perl docs say it's only available on 64-bit perl systems.
- my $has_q = 0;
- eval { $has_q = pack("Q", "1") ? 1 : 1; };
- if (!$has_q) {
- ::error("$fname: need a 64-bit perl to process this 64-bit profile.\n");
- }
- read($self->{file}, $str, 8);
- if (substr($str, 4, 4) eq chr(0)x4) {
- # We'd love to use 'Q', but it's a) not universal, b) not endian-proof.
- $self->{unpack_code} = 'V'; # Little-endian.
- } elsif (substr($str, 0, 4) eq chr(0)x4) {
- $self->{unpack_code} = 'N'; # Big-endian
- } else {
- ::error("$fname: header size >= 2**32\n");
- }
- my @pair = unpack($self->{unpack_code} . "*", $str);
- # Since we know one of the pair is 0, it's fine to just add them.
- @$slots = (0, $pair[0] + $pair[1]);
- }
+ $self->overflow();
return $self;
}
@@ -3101,25 +2629,7 @@ BEGIN {
$self->{base} += $#$slots + 1; # skip over data we're replacing
my $str;
read($self->{file}, $str, $self->{stride});
- if ($address_length == 8) { # the 32-bit case
- # This is the easy case: unpack provides 32-bit unpacking primitives.
- @$slots = unpack($self->{unpack_code} . "*", $str);
- } else {
- # We need to unpack 32 bits at a time and combine.
- my @b32_values = unpack($self->{unpack_code} . "*", $str);
- my @b64_values = ();
- for (my $i = 0; $i < $#b32_values; $i += 2) {
- # TODO(csilvers): if this is a 32-bit perl, the math below
- # could end up in a too-large int, which perl will promote
- # to a double, losing necessary precision. Deal with that.
- if ($self->{unpack_code} eq 'V') { # little-endian
- push(@b64_values, $b32_values[$i] + $b32_values[$i+1] * (2**32));
- } else {
- push(@b64_values, $b32_values[$i] * (2**32) + $b32_values[$i+1]);
- }
- }
- @$slots = @b64_values;
- }
+ @$slots = unpack("L*", $str);
}
# Access the i-th long in the file (logically), or -1 at EOF.
@@ -3128,16 +2638,16 @@ BEGIN {
my $slots = $self->{slots};
while ($#$slots >= 0) {
if ($idx < $self->{base}) {
- # The only time we expect a reference to $slots[$i - something]
- # after referencing $slots[$i] is reading the very first header.
- # Since $stride > |header|, that shouldn't cause any lookback
- # errors. And everything after the header is sequential.
- print STDERR "Unexpected look-back reading CPU profile";
- return -1; # shrug, don't know what better to return
+ # The only time we expect a reference to $slots[$i - something]
+ # after referencing $slots[$i] is reading the very first header.
+ # Since $stride > |header|, that shouldn't cause any lookback
+ # errors. And everything after the header is sequential.
+ print STDERR "Unexpected look-back reading CPU profile";
+ return -1; # shrug, don't know what better to return
} elsif ($idx > $self->{base} + $#$slots) {
- $self->overflow();
+ $self->overflow();
} else {
- return $slots->[$idx - $self->{base}];
+ return $slots->[$idx - $self->{base}];
}
}
# If we get here, $slots is [], which means we've reached EOF
@@ -3145,44 +2655,6 @@ BEGIN {
}
}
-# Return the next line from the profile file, assuming it's a text
-# line (which in this case means, doesn't start with a NUL byte). If
-# it's not a text line, return "". At EOF, return undef, like perl does.
-# Input file should be in binmode.
-sub ReadProfileLine {
- local *PROFILE = shift;
- my $firstchar = "";
- my $line = "";
- read(PROFILE, $firstchar, 1);
- seek(PROFILE, -1, 1); # unread the firstchar
- if ($firstchar eq "\0") {
- return "";
- }
- $line = <PROFILE>;
- if (defined($line)) {
- $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
- }
- return $line;
-}
-
-sub IsSymbolizedProfileFile {
- my $file_name = shift;
- if (!(-e $file_name) || !(-r $file_name)) {
- return 0;
- }
- # Check if the file contains a symbol-section marker.
- open(TFILE, "<$file_name");
- binmode TFILE;
- my $firstline = ReadProfileLine(*TFILE);
- close(TFILE);
- if (!$firstline) {
- return 0;
- }
- $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
- my $symbol_marker = $&;
- return $firstline =~ /^--- *$symbol_marker/;
-}
-
# Parse profile generated by common/profiler.cc and return a reference
# to a map:
# $result->{version} Version number of profile file
@@ -3217,17 +2689,28 @@ sub ReadProfile {
# whole firstline, since it may be gigabytes(!) of data.
open(PROFILE, "<$fname") || error("$fname: $!\n");
binmode PROFILE; # New perls do UTF-8 processing
- my $header = ReadProfileLine(*PROFILE);
- if (!defined($header)) { # means "at EOF"
- error("Profile is empty.\n");
+ my $firstchar = "";
+ my $header = "";
+ read(PROFILE, $firstchar, 1);
+ seek(PROFILE, -1, 1); # unread the firstchar
+ if ($firstchar ne "\0") {
+ $header = <PROFILE>;
+ $header =~ s/\r//g; # turn windows-looking lines into unix-looking lines
}
my $symbols;
if ($header =~ m/^--- *$symbol_marker/o) {
- # Read the symbol section of the symbolized profile file.
+ # read the symbol section of the symbolized profile file
$symbols = ReadSymbols(*PROFILE{IO});
- # Read the next line to get the header for the remaining profile.
- $header = ReadProfileLine(*PROFILE) || "";
+
+ # read the next line to get the header for the remaining profile
+ $header = "";
+ read(PROFILE, $firstchar, 1);
+ seek(PROFILE, -1, 1); # unread the firstchar
+ if ($firstchar ne "\0") {
+ $header = <PROFILE>;
+ $header =~ s/\r//g;
+ }
}
my $result;
@@ -3269,33 +2752,6 @@ sub ReadProfile {
return $result;
}
-# Subtract one from caller pc so we map back to call instr.
-# However, don't do this if we're reading a symbolized profile
-# file, in which case the subtract-one was done when the file
-# was written.
-#
-# We apply the same logic to all readers, though ReadCPUProfile uses an
-# independent implementation.
-sub FixCallerAddresses {
- my $stack = shift;
- if ($main::use_symbolized_profile) {
- return $stack;
- } else {
- $stack =~ /(\s)/;
- my $delimiter = $1;
- my @addrs = split(' ', $stack);
- my @fixedaddrs;
- $#fixedaddrs = $#addrs;
- if ($#addrs >= 0) {
- $fixedaddrs[0] = $addrs[0];
- }
- for (my $i = 1; $i <= $#addrs; $i++) {
- $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1");
- }
- return join $delimiter, @fixedaddrs;
- }
-}
-
# CPU profile reader
sub ReadCPUProfile {
my $prog = shift;
@@ -3307,7 +2763,10 @@ sub ReadCPUProfile {
my $pcs = {};
# Parse string into array of slots.
- my $slots = CpuProfileStream->new(*PROFILE, $fname);
+ # L! cannot be used because with a native 64-bit build, it will cause
+ # 1) a valid 64-bit profile to use the 32-bit codepath, and
+ # 2) a valid 32-bit profile to be unrecognized.
+ my $slots = CpuProfileStream->new(*PROFILE);
# Read header. The current header version is a 5-element structure
# containing:
@@ -3316,50 +2775,108 @@ sub ReadCPUProfile {
# 2: format version (0)
# 3: sampling period (usec)
# 4: unused padding (always 0)
+ # The header words are 32-bit or 64-bit depending on the ABI of the program
+ # that generated the profile. In the 64-bit case, since our x86-architecture
+ # machines are little-endian, the actual value of each of these elements is
+ # in the first 32-bit word, and the second is always zero. The @slots array
+ # above was read as a sequence of 32-bit words in both cases, so we need to
+ # explicitly check for both cases. A typical slot sequence for each is:
+ # 32-bit: 0 3 0 100 0
+ # 64-bit: 0 0 3 0 0 0 100 0 0 0
+ #
if ($slots->get(0) != 0 ) {
error("$fname: not a profile file, or old format profile file\n");
}
- $i = 2 + $slots->get(1);
- $version = $slots->get(2);
- $period = $slots->get(3);
- # Do some sanity checking on these header values.
- if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) {
- error("$fname: not a profile file, or corrupted profile file\n");
- }
-
- # Parse profile
- while ($slots->get($i) != -1) {
- my $n = $slots->get($i++);
- my $d = $slots->get($i++);
- if ($d > (2**16)) { # TODO(csilvers): what's a reasonable max-stack-depth?
- my $addr = sprintf("0%o", $i * ($address_length == 8 ? 4 : 8));
- print STDERR "At index $i (address $addr):\n";
- error("$fname: stack trace depth >= 2**32\n");
- }
- if ($slots->get($i) == 0) {
- # End of profile data marker
+ if ($slots->get(1) >= 3) {
+ # Normal 32-bit header:
+ $version = $slots->get(2);
+ $period = $slots->get(3);
+ $i = 2 + $slots->get(1);
+ $address_length = 8;
+
+ # Parse profile
+ while ($slots->get($i) != -1) {
+ my $n = $slots->get($i++);
+ my $d = $slots->get($i++);
+ if ($slots->get($i) == 0) {
+ # End of profile data marker
+ $i += $d;
+ last;
+ }
+
+ # Make key out of the stack entries
+ my @k = ();
+ for (my $j = 0; $j < $d; $j++) {
+ my $pc = sprintf("%08x", $slots->get($i+$j));
+ $pcs->{$pc} = 1;
+ push @k, $pc;
+ }
+
+ AddEntry($profile, (join "\n", @k), $n);
$i += $d;
- last;
}
- # Make key out of the stack entries
- my @k = ();
- for (my $j = 0; $j < $d; $j++) {
- my $pc = $slots->get($i+$j);
- # Subtract one from caller pc so we map back to call instr.
- # However, don't do this if we're reading a symbolized profile
- # file, in which case the subtract-one was done when the file
- # was written.
- if ($j > 0 && !$main::use_symbolized_profile) {
- $pc--;
+ # Normal 64-bit header: All entries are doubled in size. The first
+ # word (little-endian) should contain the real value, the second should
+ # be zero.
+ } elsif ($slots->get(1) != 0 ||
+ $slots->get(2) < 3 ||
+ $slots->get(3) != 0 ||
+ $slots->get(5) != 0 ||
+ $slots->get(7) != 0) {
+ error("$fname: not a profile file, or old format profile file\n");
+ } else {
+ $version = $slots->get(4);
+ $period = $slots->get(6);
+ $i = 4 + 2 * $slots->get(2);
+ $address_length = 16;
+
+ # Parse profile
+ while ($slots->get($i) != -1) {
+ my $n = $slots->get($i++);
+ my $nhi = $slots->get($i++);
+ # Huge counts may coerce to floating point, keeping scale, not precision
+ if ($nhi != 0) { $n += $nhi*(2**32); }
+ my $d = $slots->get($i++);
+ if ($slots->get($i++) != 0) {
+ my $addr = sprintf("%o", 4 * $i);
+ print STDERR "At index $i ($addr):\n";
+ error("$fname: stack trace depth >= 2**32\n");
}
- $pc = sprintf("%0*x", $address_length, $pc);
- $pcs->{$pc} = 1;
- push @k, $pc;
- }
+ if ($slots->get($i) == 0 && $slots->get($i+1) == 0) {
+ # End of profile data marker
+ $i += 2 * $d;
+ last;
+ }
+
+ # Make key out of the stack entries
+ my @k = ();
+ for (my $j = 0; $j < $d; $j++) {
+ my $pclo = $slots->get($i++);
+ my $pchi = $slots->get($i++);
+ if ($pclo == -1 || $pchi == -1) {
+ error("$fname: Unexpected EOF when reading stack of depth $d\n");
+ }
+
+ # Subtract one from caller pc so we map back to call instr.
+ # However, don't do this if we're reading a symbolized profile
+ # file, in which case the subtract-one was done when the file
+ # was written.
+ if ($j > 0 && !$main::use_symbolized_profile) {
+ if ($pclo == 0) {
+ $pchi--;
+ $pclo = 0xffffffff;
+ } else {
+ $pclo--;
+ }
+ }
- AddEntry($profile, (join "\n", @k), $n);
- $i += $d;
+ my $pc = sprintf("%08x%08x", $pchi, $pclo);
+ $pcs->{$pc} = 1;
+ push @k, $pc;
+ }
+ AddEntry($profile, (join "\n", @k), $n);
+ }
}
# Parse map
@@ -3430,18 +2947,18 @@ sub ReadHeapProfile {
# found for profiles generated locally, and the others for
# remote profiles.
if (($type eq "heapprofile") || ($type !~ /heap/) ) {
- # No need to adjust for the sampling rate with heap-profiler-derived data
- $sampling_algorithm = 0;
+ # No need to adjust for the sampling rate with heap-profiler-derived data
+ $sampling_algorithm = 0;
} elsif ($type =~ /_v2/) {
- $sampling_algorithm = 2; # version 2 sampling
+ $sampling_algorithm = 2; # version 2 sampling
if (defined($sample_period) && ($sample_period ne '')) {
- $sample_adjustment = int($sample_period);
- }
+ $sample_adjustment = int($sample_period);
+ }
} else {
- $sampling_algorithm = 1; # version 1 sampling
+ $sampling_algorithm = 1; # version 1 sampling
if (defined($sample_period) && ($sample_period ne '')) {
- $sample_adjustment = int($sample_period)/2;
- }
+ $sample_adjustment = int($sample_period)/2;
+ }
}
} else {
# We detect whether or not this is a remote-heap profile by checking
@@ -3453,7 +2970,7 @@ sub ReadHeapProfile {
my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
if (($n1 == $n2) && ($s1 == $s2)) {
# This is likely to be a remote-heap based sample profile
- $sampling_algorithm = 1;
+ $sampling_algorithm = 1;
}
}
}
@@ -3467,7 +2984,7 @@ sub ReadHeapProfile {
print STDERR "Adjusting heap profiles for 1-in-128KB sampling rate\n";
} else {
printf STDERR ("Adjusting heap profiles for 1-in-%d sampling rate\n",
- $sample_adjustment);
+ $sample_adjustment);
}
if ($sampling_algorithm > 1) {
# We don't bother printing anything for the original version (version 1)
@@ -3484,7 +3001,7 @@ sub ReadHeapProfile {
if (/^MAPPED_LIBRARIES:/) {
# Read the /proc/self/maps data
while (<PROFILE>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
+ s/\r//g; # turn windows-looking lines into unix-looking lines
$map .= $_;
}
last;
@@ -3494,7 +3011,7 @@ sub ReadHeapProfile {
# Read /proc/self/maps data as formatted by DumpAddressMap()
my $buildvar = "";
while (<PROFILE>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
+ s/\r//g; # turn windows-looking lines into unix-looking lines
# Parse "build=<dir>" specification if supplied
if (m/^\s*build=(.*)\n/) {
$buildvar = $1;
@@ -3549,7 +3066,7 @@ sub ReadHeapProfile {
}
my @counts = ($n1, $s1, $n2, $s2);
- AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
+ AddEntries($profile, $pcs, $stack, $counts[$index]);
}
}
@@ -3569,7 +3086,7 @@ sub ReadSynchProfile {
my $profile = {};
my $pcs = {};
my $sampling_period = 1;
- my $cyclespernanosec = 2.8; # Default assumption for old binaries
+ my $cyclespernanosec = 2.8; # Default assumption for old binaries
my $seen_clockrate = 0;
my $line;
@@ -3595,7 +3112,7 @@ sub ReadSynchProfile {
$count *= $sampling_period;
my @values = ($cycles, $count, $cycles / $count);
- AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]);
+ AddEntries($profile, $pcs, $stack, $values[$index]);
} elsif ( $line =~ /^(slow release).*thread \d+ \@\s*(.*?)\s*$/ ||
$line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) {
@@ -3610,7 +3127,7 @@ sub ReadSynchProfile {
# Adjust for sampling done by application
$cycles *= $sampling_period;
- AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles);
+ AddEntries($profile, $pcs, $stack, $cycles);
} elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) {
my ($variable, $value) = ($1,$2);
@@ -3791,8 +3308,8 @@ sub ParseTextSectionHeaderFromOtool {
} elsif ($line =~ /segname (\w+)/) {
$segname = $1;
} elsif (!(($cmd eq "LC_SEGMENT" || $cmd eq "LC_SEGMENT_64") &&
- $sectname eq "__text" &&
- $segname eq "__TEXT")) {
+ $sectname eq "__text" &&
+ $segname eq "__TEXT")) {
next;
} elsif ($line =~ /\baddr 0x([0-9a-fA-F]+)/) {
$vma = $1;
@@ -3852,7 +3369,7 @@ sub ParseLibraries {
my $finish;
my $offset;
my $lib;
- if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+\.(so|dll|dylib|bundle)((\.\d+)+\w*(\.\d+){0,3})?)$/i) {
+ if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+\.(so|dll|dylib|bundle)((\.\d+)+\w*)?)$/i) {
# Full line from /proc/self/maps. Example:
# 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so
$start = HexExtend($1);
@@ -4158,7 +3675,7 @@ sub MapToSymbols {
if ($debug) { print("---- $image ---\n"); }
for (my $i = 0; $i <= $#{$pclist}; $i++) {
# addr2line always reads hex addresses, and does not need '0x' prefix.
- if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); }
+ if ($debug) { printf("%s\n", $pclist->[$i]); }
printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
if (defined($sep_address)) {
printf ADDRESSES ("%s\n", $sep_address);
@@ -4210,7 +3727,7 @@ sub MapToSymbols {
$symbols->{$pcstr} = $sym;
}
unshift(@{$sym}, $function, $filelinenum, $fullfunction);
- if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
+ if ($debug) { printf("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
if (!defined($sep_address)) {
# Inlining is off, se this entry ends immediately
$count++;
@@ -4266,7 +3783,7 @@ sub MapSymbolsWithNM {
}
return 1;
}
-
+
sub ShortFunctionName {
my $function = shift;
while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types
@@ -4313,8 +3830,6 @@ sub ConfigureObjTools {
if ($file_type =~ /Mach-O/) {
# OS X uses otool to examine Mach-O files, rather than objdump.
$obj_tool_map{"otool"} = "otool";
- $obj_tool_map{"addr2line"} = "false"; # no addr2line
- $obj_tool_map{"objdump"} = "false"; # no objdump
}
# Go fill in %obj_tool_map with the pathnames to use:
@@ -4361,8 +3876,9 @@ sub ConfigureTool {
sub cleanup {
unlink($main::tmpfile_sym);
- unlink(keys %main::tempnames);
-
+ for (my $i = 0; $i < $main::next_tmpfile; $i++) {
+ unlink(PsTempName($i));
+ }
# We leave any collected profiles in $HOME/pprof in case the user wants
# to look at them later. We print a message informing them of this.
if ((scalar(@main::profile_files) > 0) &&
@@ -4405,7 +3921,7 @@ sub GetProcedureBoundariesViaNm {
my $routine = "";
while (<NM>) {
s/\r//g; # turn windows-looking lines into unix-looking lines
- if (m/^\s*([0-9a-f]+) (.) (..*)/) {
+ if (m/^([0-9a-f]+) (.) (..*)/) {
my $start_val = $1;
my $type = $2;
my $this_routine = $3;
@@ -4426,12 +3942,12 @@ sub GetProcedureBoundariesViaNm {
# we'll just go ahead and process the first entry (which never
# got touched in the queue), and ignore the others.
if ($start_val eq $last_start && $type =~ /t/i) {
- # We are the 'T' symbol at this address, replace previous symbol.
- $routine = $this_routine;
- next;
+ # We are the 'T' symbol at this address, replace previous symbol.
+ $routine = $this_routine;
+ next;
} elsif ($start_val eq $last_start) {
- # We're not the 'T' symbol at this address, so ignore us.
- next;
+ # We're not the 'T' symbol at this address, so ignore us.
+ next;
}
if ($this_routine eq $sep_symbol) {
@@ -4446,7 +3962,7 @@ sub GetProcedureBoundariesViaNm {
if (defined($routine) && $routine =~ m/$regexp/) {
$symbol_table->{$routine} = [HexExtend($last_start),
- HexExtend($start_val)];
+ HexExtend($start_val)];
}
$last_start = $start_val;
$routine = $this_routine;
@@ -4465,8 +3981,9 @@ sub GetProcedureBoundariesViaNm {
# TODO(csilvers): do better here.
if (defined($routine) && $routine =~ m/$regexp/) {
$symbol_table->{$routine} = [HexExtend($last_start),
- HexExtend($last_start)];
+ HexExtend($last_start)];
}
+
return $symbol_table;
}
@@ -4512,13 +4029,9 @@ sub GetProcedureBoundaries {
# -D to at least get *exported* symbols. If we can't use --demangle,
# we use c++filt instead, if it exists on this system.
my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" .
- " $image 2>/dev/null $cppfilt_flag",
- "$nm -D -n $flatten_flag $demangle_flag" .
- " $image 2>/dev/null $cppfilt_flag",
- # 6nm is for Go binaries
- "6nm $image 2>/dev/null | sort",
- );
-
+ " $image 2>/dev/null $cppfilt_flag",
+ "$nm -D -n $flatten_flag $demangle_flag" .
+ " $image 2>/dev/null $cppfilt_flag");
# If the executable is an MS Windows PDB-format executable, we'll
# have set up obj_tool_map("nm_pdb"). In this case, we actually
# want to use both unix nm and windows-specific nm_pdb, since
@@ -4750,3 +4263,4 @@ sub RunUnitTests {
}
exit ($error_count);
}
+
generated by cgit v1.1 at 2025-05-11 08:40:33 +0000