summaryrefslogtreecommitdiffstats
path: root/third_party/tcmalloc/vendor/src/pprof
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/tcmalloc/vendor/src/pprof')
-rw-r--r--third_party/tcmalloc/vendor/src/pprof1091
1 files changed, 784 insertions, 307 deletions
diff --git a/third_party/tcmalloc/vendor/src/pprof b/third_party/tcmalloc/vendor/src/pprof
index fec0c9e..d70ee30 100644
--- a/third_party/tcmalloc/vendor/src/pprof
+++ b/third_party/tcmalloc/vendor/src/pprof
@@ -89,11 +89,10 @@ 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 $WGET = "wget";
-my $WGET_FLAGS = "--no-http-keep-alive"; # only supported by some wgets
-my $CURL = "curl";
+my $URL_FETCHER = "curl -s";
# These are the web pages that servers need to support for dynamic profiles
my $HEAP_PAGE = "/pprof/heap";
@@ -175,12 +174,14 @@ 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)
@@ -223,6 +224,8 @@ 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
@@ -233,6 +236,9 @@ 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
@@ -292,10 +298,12 @@ 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;
@@ -330,13 +338,16 @@ 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,
@@ -355,9 +366,11 @@ 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,
@@ -380,8 +393,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
@@ -433,9 +446,11 @@ 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 +
@@ -510,20 +525,6 @@ 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);
@@ -634,9 +635,24 @@ sub Main() {
} else {
if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
if ($main::opt_gv) {
- RunGV(PsTempName($main::next_tmpfile), "");
+ 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);
+ }
}
} else {
+ cleanup();
exit(1);
}
}
@@ -667,7 +683,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
@@ -682,6 +698,43 @@ 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 (-f $b) {
+ 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 #####
@@ -689,10 +742,11 @@ sub InteractiveMode {
$| = 1; # Make output unbuffered for interactive mode
my ($orig_profile, $symbols, $libs, $total) = @_;
- print "Welcome to pprof! For help, type 'help'.\n";
+ print STDERR "Welcome to pprof! For help, type 'help'.\n";
- # Use ReadLine if it's installed.
- if ( !ReadlineMightFail() &&
+ # Use ReadLine if it's installed and input comes from a console.
+ if ( -t STDIN &&
+ !ReadlineMightFail() &&
defined(eval {require Term::ReadLine}) ) {
my $term = new Term::ReadLine 'pprof';
while ( defined ($_ = $term->readline('(pprof) '))) {
@@ -703,7 +757,7 @@ sub InteractiveMode {
}
} else { # don't have readline
while (1) {
- print "(pprof) ";
+ print STDERR "(pprof) ";
$_ = <STDIN>;
last if ! defined $_ ;
s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -727,13 +781,13 @@ sub InteractiveCommand {
my($orig_profile, $symbols, $libs, $total, $command) = @_;
$_ = $command; # just to make future m//'s easier
if (!defined($_)) {
- print "\n";
+ print STDERR "\n";
return 0;
}
- if (m/^ *quit/) {
+ if (m/^\s*quit/) {
return 0;
}
- if (m/^ *help/) {
+ if (m/^\s*help/) {
InteractiveHelpMessage();
return 1;
}
@@ -745,7 +799,7 @@ sub InteractiveCommand {
$main::opt_gv = 0;
$main::opt_cum = 0;
- if (m/^ *(text|top)(\d*) *(.*)/) {
+ if (m/^\s*(text|top)(\d*)\s*(.*)/) {
$main::opt_text = 1;
my $line_limit = ($2 ne "") ? int($2) : 10;
@@ -764,7 +818,24 @@ sub InteractiveCommand {
PrintText($symbols, $flat, $cumulative, $total, $line_limit);
return 1;
}
- if (m/^ *list *(.+)/) {
+ 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*(.+)/) {
$main::opt_list = 1;
my $routine;
@@ -781,7 +852,7 @@ sub InteractiveCommand {
PrintListing($libs, $flat, $cumulative, $routine);
return 1;
}
- if (m/^ *disasm *(.+)/) {
+ if (m/^\s*disasm\s*(.+)/) {
$main::opt_disasm = 1;
my $routine;
@@ -799,12 +870,18 @@ sub InteractiveCommand {
PrintDisassembly($libs, $flat, $cumulative, $routine, $total);
return 1;
}
- if (m/^ *gv *(.*)/) {
- $main::opt_gv = 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;
+ }
my $focus;
my $ignore;
- ($focus, $ignore) = ParseInteractiveArgs($1);
+ ($focus, $ignore) = ParseInteractiveArgs($2);
# Process current profile to account for various settings
my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore);
@@ -815,11 +892,19 @@ sub InteractiveCommand {
my $cumulative = CumulativeProfile($reduced);
if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
- RunGV(PsTempName($main::next_tmpfile), " &");
+ if ($main::opt_gv) {
+ RunGV(TempName($main::next_tmpfile, "ps"), " &");
+ } elsif ($main::opt_web) {
+ RunWeb(TempName($main::next_tmpfile, "svg"));
+ }
$main::next_tmpfile++;
}
return 1;
}
+ if (m/^\s*$/) {
+ return 1;
+ }
+ print STDERR "Unknown command: try 'help'.\n";
return 1;
}
@@ -856,7 +941,7 @@ sub ProcessProfile {
}
sub InteractiveHelpMessage {
- print <<ENDOFHELP;
+ print STDERR <<ENDOFHELP;
Interactive pprof mode
Commands:
@@ -868,6 +953,14 @@ 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"
@@ -882,6 +975,10 @@ 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
@@ -913,16 +1010,19 @@ sub ParseInteractiveArgs {
}
}
if ($ignore ne "") {
- print "Ignoring samples in call stacks that match '$ignore'\n";
+ print STDERR "Ignoring samples in call stacks that match '$ignore'\n";
}
return ($focus, $ignore);
}
##### Output code #####
-sub PsTempName {
+sub TempName {
my $fnum = shift;
- return "$main::tmpfile_ps" . "." . "$fnum" . ".ps";
+ my $ext = shift;
+ my $file = "$main::tmpfile_ps.$fnum.$ext";
+ $main::tempnames{$file} = 1;
+ return $file;
}
# Print profile data in packed binary format (64-bit) to standard out
@@ -1045,7 +1145,15 @@ sub PrintText {
# Print the call graph in a way that's suiteable for callgrind.
sub PrintCallgrind {
my $calls = shift;
- printf("events: Hits\n\n");
+ 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");
foreach my $call ( map { $_->[0] }
sort { $a->[1] cmp $b ->[1] ||
$a->[2] <=> $b->[2] }
@@ -1057,13 +1165,15 @@ sub PrintCallgrind {
my ( $caller_file, $caller_line, $caller_function,
$callee_file, $callee_line, $callee_function ) =
( $1, $2, $3, $5, $6, $7 );
- printf("fl=$caller_file\nfn=$caller_function\n");
+
+
+ printf CG ("fl=$caller_file\nfn=$caller_function\n");
if (defined $6) {
- printf("cfl=$callee_file\n");
- printf("cfn=$callee_function\n");
- printf("calls=$count $callee_line\n");
+ printf CG ("cfl=$callee_file\n");
+ printf CG ("cfn=$callee_function\n");
+ printf CG ("calls=$count $callee_line\n");
}
- printf("$caller_line $count\n\n");
+ printf CG ("$caller_line $count\n\n");
}
}
@@ -1385,7 +1495,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}, $_);
}
@@ -1477,8 +1587,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];
@@ -1490,16 +1600,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
@@ -1516,9 +1626,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);
}
}
@@ -1542,7 +1652,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) {
@@ -1554,7 +1664,6 @@ sub PrintDot {
}
if ($last < 0) {
print STDERR "No nodes to print\n";
- cleanup();
return 0;
}
@@ -1567,11 +1676,14 @@ sub PrintDot {
# Open DOT output file
my $output;
if ($main::opt_gv) {
- $output = "| $DOT -Tps2 >" . PsTempName($main::next_tmpfile);
+ $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps");
} 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 {
@@ -1682,7 +1794,10 @@ sub PrintDot {
my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0);
if ($fraction > 1) { $fraction = 1; }
my $w = $fraction * 2;
- #if ($w < 1) { $w = 1; }
+ if ($w < 1 && ($main::opt_web || $main::opt_svg)) {
+ # SVG output treats line widths < 1 poorly.
+ $w = 1;
+ }
# Dot sometimes segfaults if given edge weights that are too large, so
# we cap the weights at a large value
@@ -1706,11 +1821,312 @@ 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"));
+ }
+
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;
@@ -1806,7 +2222,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);
}
@@ -1947,42 +2363,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
}
@@ -1999,11 +2415,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 {
@@ -2042,10 +2458,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);
}
@@ -2070,8 +2486,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);
@@ -2265,28 +2681,11 @@ 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, "$WGET $WGET_FLAGS -qO- '$url' |");
+ open(SYMBOL, "$URL_FETCHER '$url' |");
my $line = <SYMBOL>;
$line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
close(SYMBOL);
@@ -2305,33 +2704,33 @@ sub CheckSymbolPage {
sub IsProfileURL {
my $profile_name = shift;
- my ($host, $port, $path) = ParseProfileURL($profile_name);
+ my ($host, $port, $prefix, $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 =~ 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
+ $profile_name =~ m,^(http://|)([^/:]+):(\d+)(|\@\d+)(|/|(.*?)($PROFILE_PAGE|$PMUPROFILE_PAGE|$HEAP_PAGE|$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|$FILTEREDPROFILE_PAGE))$,o) {
+ # $7 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);
+ # So "$7 || $5" is $PROFILE_PAGE/etc if there, or else it's "/" or "".
+ return ($2, $3, $6, $7 || $5);
}
return ();
}
# We fetch symbols from the first profile argument.
sub SymbolPageURL {
- my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
- return "http://$host:$port$SYMBOL_PAGE";
+ my ($host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]);
+ return "http://$host:$port$prefix$SYMBOL_PAGE";
}
sub FetchProgramName() {
- 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'";
+ my ($host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]);
+ my $url = "http://$host:$port$prefix$PROGRAM_NAME_PAGE";
+ my $command_line = "$URL_FETCHER '$url'";
open(CMDLINE, "$command_line |") or error($command_line);
my $cmdline = <CMDLINE>;
$cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -2348,7 +2747,7 @@ sub FetchProgramName() {
# curl. Redirection happens on borg hosts.
sub ResolveRedirectionForCurl {
my $url = shift;
- my $command_line = "$CURL -s --head '$url'";
+ my $command_line = "$URL_FETCHER --head '$url'";
open(CMDLINE, "$command_line |") or error($command_line);
while (<CMDLINE>) {
s/\r//g; # turn windows-looking lines into unix-looking lines
@@ -2360,6 +2759,20 @@ 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
@@ -2404,7 +2817,6 @@ sub FetchSymbols {
my $pcset = shift;
my $symbol_map = shift;
-
my %seen = ();
my @pcs = grep { !$seen{$_}++ } keys(%$pcset); # uniq
@@ -2414,12 +2826,16 @@ sub FetchSymbols {
open(POSTFILE, ">$main::tmpfile_sym");
print POSTFILE $post_data;
close(POSTFILE);
-
+
my $url = SymbolPageURL();
- # 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'";
+
+ 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'";
+ }
# 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);
@@ -2464,7 +2880,7 @@ sub BaseName {
sub MakeProfileBaseName {
my ($binary_name, $profile_name) = @_;
- my ($host, $port, $path) = ParseProfileURL($profile_name);
+ my ($host, $port, $prefix, $path) = ParseProfileURL($profile_name);
my $binary_shortname = BaseName($binary_name);
return sprintf("%s.%s.%s-port%s",
$binary_shortname, $main::op_time, $host, $port);
@@ -2479,7 +2895,7 @@ sub FetchDynamicProfile {
if (!IsProfileURL($profile_name)) {
return $profile_name;
} else {
- my ($host, $port, $path) = ParseProfileURL($profile_name);
+ my ($host, $port, $prefix, $path) = ParseProfileURL($profile_name);
if ($path eq "" || $path eq "/") {
# Missing type specifier defaults to cpu-profile
$path = $PROFILE_PAGE;
@@ -2488,10 +2904,10 @@ sub FetchDynamicProfile {
my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
my $url;
- my $wget_timeout;
+ my $fetch_timeout = undef;
if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) {
if ($path =~ m/$PROFILE_PAGE/) {
- $url = sprintf("http://$host:$port$path?seconds=%d",
+ $url = sprintf("http://$host:$port$prefix$path?seconds=%d",
$main::opt_seconds);
} else {
if ($profile_name =~ m/[?]/) {
@@ -2502,22 +2918,20 @@ sub FetchDynamicProfile {
$url = sprintf("http://$profile_name" . "seconds=%d",
$main::opt_seconds);
}
- $wget_timeout = sprintf("--timeout=%d",
- int($main::opt_seconds * 1.01 + 60));
+ $fetch_timeout = $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";
- $url = "http://$host:$port$path";
- $wget_timeout = "";
+ $url = "http://$host:$port$prefix$path";
}
my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof");
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";
@@ -2526,7 +2940,8 @@ sub FetchDynamicProfile {
return $real_profile;
}
- my $cmd = "$WGET $WGET_FLAGS $wget_timeout -q -O $tmp_profile '$url'";
+ my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout);
+ my $cmd = "$fetcher '$url' > '$tmp_profile'";
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) {
@@ -2580,6 +2995,7 @@ sub FetchDynamicProfilesRecurse {
} else {
$position = 1 | ($position << 1);
TryCollectProfile($maxlevel, $level, $position);
+ cleanup();
exit(0);
}
}
@@ -2603,22 +3019,69 @@ 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) = @_;
- my $self = { file => $file,
- base => 0,
- stride => 512 * 1024, # must be a multiple of |long|
- slots => []
+ 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
};
bless $self, $class;
# Let unittests adjust the stride
if ($main::opt_test_stride > 0) {
$self->{stride} = $main::opt_test_stride;
}
- $self->overflow();
+ # 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]);
+ }
return $self;
}
@@ -2629,7 +3092,25 @@ BEGIN {
$self->{base} += $#$slots + 1; # skip over data we're replacing
my $str;
read($self->{file}, $str, $self->{stride});
- @$slots = unpack("L*", $str);
+ 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;
+ }
}
# Access the i-th long in the file (logically), or -1 at EOF.
@@ -2638,16 +3119,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
@@ -2655,6 +3136,44 @@ 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
@@ -2689,28 +3208,17 @@ 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 $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 $header = ReadProfileLine(*PROFILE);
+ if (!defined($header)) { # means "at EOF"
+ error("Profile is empty.\n");
}
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 = "";
- read(PROFILE, $firstchar, 1);
- seek(PROFILE, -1, 1); # unread the firstchar
- if ($firstchar ne "\0") {
- $header = <PROFILE>;
- $header =~ s/\r//g;
- }
+ # Read the next line to get the header for the remaining profile.
+ $header = ReadProfileLine(*PROFILE) || "";
}
my $result;
@@ -2752,6 +3260,33 @@ 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;
@@ -2763,10 +3298,7 @@ sub ReadCPUProfile {
my $pcs = {};
# Parse string into array of slots.
- # 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);
+ my $slots = CpuProfileStream->new(*PROFILE, $fname);
# Read header. The current header version is a 5-element structure
# containing:
@@ -2775,108 +3307,50 @@ 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");
}
- 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 = 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
$i += $d;
+ last;
}
- # 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");
- }
- 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--;
- }
- }
-
- my $pc = sprintf("%08x%08x", $pchi, $pclo);
- $pcs->{$pc} = 1;
- push @k, $pc;
+ # 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--;
}
- AddEntry($profile, (join "\n", @k), $n);
+ $pc = sprintf("%0*x", $address_length, $pc);
+ $pcs->{$pc} = 1;
+ push @k, $pc;
}
+
+ AddEntry($profile, (join "\n", @k), $n);
+ $i += $d;
}
# Parse map
@@ -2947,18 +3421,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
@@ -2970,7 +3444,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;
}
}
}
@@ -2984,7 +3458,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)
@@ -3001,7 +3475,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;
@@ -3011,7 +3485,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;
@@ -3066,7 +3540,7 @@ sub ReadHeapProfile {
}
my @counts = ($n1, $s1, $n2, $s2);
- AddEntries($profile, $pcs, $stack, $counts[$index]);
+ AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
}
}
@@ -3086,7 +3560,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;
@@ -3112,7 +3586,7 @@ sub ReadSynchProfile {
$count *= $sampling_period;
my @values = ($cycles, $count, $cycles / $count);
- AddEntries($profile, $pcs, $stack, $values[$index]);
+ AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]);
} elsif ( $line =~ /^(slow release).*thread \d+ \@\s*(.*?)\s*$/ ||
$line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) {
@@ -3127,7 +3601,7 @@ sub ReadSynchProfile {
# Adjust for sampling done by application
$cycles *= $sampling_period;
- AddEntries($profile, $pcs, $stack, $cycles);
+ AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles);
} elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) {
my ($variable, $value) = ($1,$2);
@@ -3308,8 +3782,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;
@@ -3369,7 +3843,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*)?)$/i) {
+ 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) {
# Full line from /proc/self/maps. Example:
# 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so
$start = HexExtend($1);
@@ -3675,7 +4149,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("%s\n", $pclist->[$i]); }
+ if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); }
printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
if (defined($sep_address)) {
printf ADDRESSES ("%s\n", $sep_address);
@@ -3727,7 +4201,7 @@ sub MapToSymbols {
$symbols->{$pcstr} = $sym;
}
unshift(@{$sym}, $function, $filelinenum, $fullfunction);
- if ($debug) { printf("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
+ if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
if (!defined($sep_address)) {
# Inlining is off, se this entry ends immediately
$count++;
@@ -3783,7 +4257,7 @@ sub MapSymbolsWithNM {
}
return 1;
}
-
+
sub ShortFunctionName {
my $function = shift;
while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types
@@ -3830,6 +4304,8 @@ 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:
@@ -3876,9 +4352,8 @@ sub ConfigureTool {
sub cleanup {
unlink($main::tmpfile_sym);
- for (my $i = 0; $i < $main::next_tmpfile; $i++) {
- unlink(PsTempName($i));
- }
+ unlink(keys %main::tempnames);
+
# 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) &&
@@ -3921,7 +4396,7 @@ sub GetProcedureBoundariesViaNm {
my $routine = "";
while (<NM>) {
s/\r//g; # turn windows-looking lines into unix-looking lines
- if (m/^([0-9a-f]+) (.) (..*)/) {
+ if (m/^\s*([0-9a-f]+) (.) (..*)/) {
my $start_val = $1;
my $type = $2;
my $this_routine = $3;
@@ -3942,12 +4417,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) {
@@ -3962,7 +4437,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;
@@ -3981,9 +4456,8 @@ 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;
}
@@ -4029,9 +4503,13 @@ 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");
+ " $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",
+ );
+
# 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
@@ -4263,4 +4741,3 @@ sub RunUnitTests {
}
exit ($error_count);
}
-
generated by cgit v1.1 at 2025-01-29 10:57:24 +0000