You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@quickstep.apache.org by hb...@apache.org on 2017/01/17 19:31:06 UTC
[12/51] [partial] incubator-quickstep git commit: Added shell script
to download prerequisite third party libs
http://git-wip-us.apache.org/repos/asf/incubator-quickstep/blob/bb3371c3/third_party/gperftools/src/pprof
----------------------------------------------------------------------
diff --git a/third_party/gperftools/src/pprof b/third_party/gperftools/src/pprof
deleted file mode 100755
index c23299d..0000000
--- a/third_party/gperftools/src/pprof
+++ /dev/null
@@ -1,5504 +0,0 @@
-#! /usr/bin/env perl
-
-# Copyright (c) 1998-2007, Google Inc.
-# All rights reserved.
-#
-# Redistribution and use in source and binary forms, with or without
-# modification, are permitted provided that the following conditions are
-# met:
-#
-# * Redistributions of source code must retain the above copyright
-# notice, this list of conditions and the following disclaimer.
-# * 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.
-# * Neither the name of Google Inc. nor the names of its
-# contributors may be used to endorse or promote products derived from
-# this software without specific prior written permission.
-#
-# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-# "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 THE COPYRIGHT
-# OWNER 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.
-
-# ---
-# Program for printing the profile generated by common/profiler.cc,
-# or by the heap profiler (common/debugallocation.cc)
-#
-# The profile contains a sequence of entries of the form:
-# <count> <stack trace>
-# This program parses the profile, and generates user-readable
-# output.
-#
-# Examples:
-#
-# % tools/pprof "program" "profile"
-# Enters "interactive" mode
-#
-# % tools/pprof --text "program" "profile"
-# Generates one line per procedure
-#
-# % tools/pprof --gv "program" "profile"
-# Generates annotated call-graph and displays via "gv"
-#
-# % tools/pprof --gv --focus=Mutex "program" "profile"
-# Restrict to code paths that involve an entry that matches "Mutex"
-#
-# % tools/pprof --gv --focus=Mutex --ignore=string "program" "profile"
-# Restrict to code paths that involve an entry that matches "Mutex"
-# and does not match "string"
-#
-# % tools/pprof --list=IBF_CheckDocid "program" "profile"
-# Generates disassembly listing of all routines with at least one
-# sample that match the --list=<regexp> pattern. The listing is
-# annotated with the flat and cumulative sample counts at each line.
-#
-# % tools/pprof --disasm=IBF_CheckDocid "program" "profile"
-# Generates disassembly listing of all routines with at least one
-# sample that match the --disasm=<regexp> pattern. The listing is
-# annotated with the flat and cumulative sample counts at each PC value.
-#
-# TODO: Use color to indicate files?
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Cwd;
-use POSIX;
-
-my $PPROF_VERSION = "2.0";
-
-# These are the object tools we use which can come from a
-# user-specified location using --tools, from the PPROF_TOOLS
-# environment variable, or from the environment.
-my %obj_tool_map = (
- "objdump" => "objdump",
- "nm" => "nm",
- "addr2line" => "addr2line",
- "c++filt" => "c++filt",
- ## ConfigureObjTools may add architecture-specific entries:
- #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables
- #"addr2line_pdb" => "addr2line-pdb", # ditto
- #"otool" => "otool", # equivalent of objdump on OS X
-);
-# NOTE: these are lists, so you can put in commandline flags if you want.
-my @DOT = ("dot"); # leave non-absolute, since it may be in /usr/local
-my @GV = ("gv");
-my @EVINCE = ("evince"); # could also be xpdf or perhaps acroread
-my @KCACHEGRIND = ("kcachegrind");
-my @PS2PDF = ("ps2pdf");
-# These are used for dynamic profiles
-my @URL_FETCHER = ("curl", "-s");
-
-# These are the web pages that servers need to support for dynamic profiles
-my $HEAP_PAGE = "/pprof/heap";
-my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#"
-my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param
- # ?seconds=#&event=x&period=n
-my $GROWTH_PAGE = "/pprof/growth";
-my $CONTENTION_PAGE = "/pprof/contention";
-my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter
-my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?";
-my $CENSUSPROFILE_PAGE = "/pprof/censusprofile(?:\\?.*)?"; # must support cgi-param
- # "?seconds=#",
- # "?tags_regexp=#" and
- # "?type=#".
-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|$CENSUSPROFILE_PAGE)";
-
-# default binary name
-my $UNKNOWN_BINARY = "(unknown)";
-
-# There is a pervasive dependency on the length (in hex characters,
-# i.e., nibbles) of an address, distinguishing between 32-bit and
-# 64-bit profiles. To err on the safe size, default to 64-bit here:
-my $address_length = 16;
-
-my $dev_null = "/dev/null";
-if (! -e $dev_null && $^O =~ /MSWin/) { # $^O is the OS perl was built for
- $dev_null = "nul";
-}
-
-# A list of paths to search for shared object files
-my @prefix_list = ();
-
-# Special routine name that should not have any symbols.
-# Used as separator to parse "addr2line -i" output.
-my $sep_symbol = '_fini';
-my $sep_address = undef;
-
-my @stackTraces;
-
-##### Argument parsing #####
-
-sub usage_string {
- return <<EOF;
-Usage:
-pprof [options] <program> <profiles>
- <profiles> is a space separated list of profile names.
-pprof [options] <symbolized-profiles>
- <symbolized-profiles> is a list of profile files where each file contains
- the necessary symbol mappings as well as profile data (likely generated
- with --raw).
-pprof [options] <profile>
- <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE
-
- Each name can be:
- /path/to/profile - a path to a profile file
- host:port[/<service>] - a location of a service to get profile from
-
- The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile,
- $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall,
- $CENSUSPROFILE_PAGE, or /pprof/filteredprofile.
- For instance:
- pprof http://myserver.com:80$HEAP_PAGE
- If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profiling).
-pprof --symbols <program>
- Maps addresses to symbol names. In this mode, stdin should be a
- list of library mappings, in the same format as is found in the heap-
- and cpu-profile files (this loosely matches that of /proc/self/maps
- on linux), followed by a list of hex addresses to map, one per line.
-
- For more help with querying remote servers, including how to add the
- necessary server-side support code, see this filename (or one like it):
-
- /usr/doc/gperftools-$PPROF_VERSION/pprof_remote_servers.html
-
-Options:
- --cum Sort by cumulative data
- --base=<base> Subtract <base> from <profile> before display
- --interactive Run in interactive mode (interactive "help" gives help) [default]
- --seconds=<n> Length of time for dynamic profiles [default=30 secs]
- --add_lib=<file> Read additional symbols and line info from the given library
- --lib_prefix=<dir> Comma separated list of library path prefixes
- --no_strip_temp Do not strip template arguments from function names
-
-Reporting Granularity:
- --addresses Report at address level
- --lines Report at source line level
- --functions Report at function level [default]
- --files Report at source file level
-
-Output type:
- --text Generate text report
- --stacks Generate stack traces similar to the heap profiler (requires --text)
- --callgrind Generate callgrind format to stdout
- --gv Generate Postscript and display
- --evince Generate PDF 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)
-
-Heap-Profile Options:
- --inuse_space Display in-use (mega)bytes [default]
- --inuse_objects Display in-use objects
- --alloc_space Display allocated (mega)bytes
- --alloc_objects Display allocated objects
- --show_bytes Display space in bytes
- --drop_negative Ignore negative differences
-
-Contention-profile options:
- --total_delay Display total delay at each region [default]
- --contentions Display number of delays at each region
- --mean_delay Display mean delay at each region
-
-Call-graph Options:
- --nodecount=<n> Show at most so many nodes [default=80]
- --nodefraction=<f> Hide nodes below <f>*total [default=.005]
- --edgefraction=<f> Hide edges below <f>*total [default=.001]
- --maxdegree=<n> Max incoming/outgoing edges per node [default=8]
- --focus=<regexp> Focus on nodes matching <regexp>
- --ignore=<regexp> Ignore nodes matching <regexp>
- --scale=<n> Set GV scaling [default=0]
- --heapcheck Make nodes with non-0 object counts
- (i.e. direct leak generators) more visible
-
-Miscellaneous:
- --no-auto-signal-frm Automatically drop 2nd frame that is always same (cpu-only)
- (assuming that it is artifact of bad stack captures
- which include signal handler frames)
- --show_addresses Always show addresses when applicable
- --tools=<prefix or binary:fullpath>[,...] \$PATH for object tool pathnames
- --test Run unit tests
- --help This message
- --version Version information
-
-Environment Variables:
- PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof
- PPROF_TOOLS Prefix for object tools pathnames
-
-Examples:
-
-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
- Restricts to code paths including a .*Mutex.* entry
-pprof --gv --focus=Mutex --ignore=string /bin/ls ls.prof
- Code paths including Mutex but not string
-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
-pprof --text ./local.raw
- Fetches a remote profile for later analysis and then
- analyzes it in text mode.
-EOF
-}
-
-sub version_string {
- return <<EOF
-pprof (part of gperftools $PPROF_VERSION)
-
-Copyright 1998-2007 Google Inc.
-
-This is BSD licensed software; see the source for copying conditions
-and license information.
-There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE.
-EOF
-}
-
-sub usage {
- my $msg = shift;
- print STDERR "$msg\n\n";
- print STDERR usage_string();
- exit(1);
-}
-
-sub Init() {
- # Setup tmp-file name and handler to clean it up.
- # We do this in the very beginning so that we can use
- # error() and cleanup() function anytime here after.
- $main::tmpfile_sym = "/tmp/pprof$$.sym";
- $main::tmpfile_ps = "/tmp/pprof$$";
- $main::next_tmpfile = 0;
- $SIG{'INT'} = \&sighandler;
-
- # Cache from filename/linenumber to source code
- $main::source_cache = ();
-
- $main::opt_help = 0;
- $main::opt_version = 0;
- $main::opt_show_addresses = 0;
- $main::opt_no_auto_signal_frames = 0;
-
- $main::opt_cum = 0;
- $main::opt_base = '';
- $main::opt_addresses = 0;
- $main::opt_lines = 0;
- $main::opt_functions = 0;
- $main::opt_files = 0;
- $main::opt_lib_prefix = "";
-
- $main::opt_text = 0;
- $main::opt_stacks = 0;
- $main::opt_callgrind = 0;
- $main::opt_list = "";
- $main::opt_disasm = "";
- $main::opt_symbols = 0;
- $main::opt_gv = 0;
- $main::opt_evince = 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;
- $main::opt_nodefraction = 0.005;
- $main::opt_edgefraction = 0.001;
- $main::opt_maxdegree = 8;
- $main::opt_focus = '';
- $main::opt_ignore = '';
- $main::opt_scale = 0;
- $main::opt_heapcheck = 0;
- $main::opt_seconds = 30;
- $main::opt_lib = "";
-
- $main::opt_inuse_space = 0;
- $main::opt_inuse_objects = 0;
- $main::opt_alloc_space = 0;
- $main::opt_alloc_objects = 0;
- $main::opt_show_bytes = 0;
- $main::opt_drop_negative = 0;
- $main::opt_interactive = 0;
-
- $main::opt_total_delay = 0;
- $main::opt_contentions = 0;
- $main::opt_mean_delay = 0;
-
- $main::opt_tools = "";
- $main::opt_debug = 0;
- $main::opt_test = 0;
-
- # Do not strip template argument in function names
- $main::opt_no_strip_temp = 0;
-
- # These are undocumented flags used only by unittests.
- $main::opt_test_stride = 0;
-
- # 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"
-
- GetOptions("help!" => \$main::opt_help,
- "version!" => \$main::opt_version,
- "show_addresses!"=> \$main::opt_show_addresses,
- "no-auto-signal-frm!"=> \$main::opt_no_auto_signal_frames,
- "cum!" => \$main::opt_cum,
- "base=s" => \$main::opt_base,
- "seconds=i" => \$main::opt_seconds,
- "add_lib=s" => \$main::opt_lib,
- "lib_prefix=s" => \$main::opt_lib_prefix,
- "functions!" => \$main::opt_functions,
- "lines!" => \$main::opt_lines,
- "addresses!" => \$main::opt_addresses,
- "files!" => \$main::opt_files,
- "text!" => \$main::opt_text,
- "stacks!" => \$main::opt_stacks,
- "callgrind!" => \$main::opt_callgrind,
- "list=s" => \$main::opt_list,
- "disasm=s" => \$main::opt_disasm,
- "symbols!" => \$main::opt_symbols,
- "gv!" => \$main::opt_gv,
- "evince!" => \$main::opt_evince,
- "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,
- "nodecount=i" => \$main::opt_nodecount,
- "nodefraction=f" => \$main::opt_nodefraction,
- "edgefraction=f" => \$main::opt_edgefraction,
- "maxdegree=i" => \$main::opt_maxdegree,
- "focus=s" => \$main::opt_focus,
- "ignore=s" => \$main::opt_ignore,
- "scale=i" => \$main::opt_scale,
- "heapcheck" => \$main::opt_heapcheck,
- "inuse_space!" => \$main::opt_inuse_space,
- "inuse_objects!" => \$main::opt_inuse_objects,
- "alloc_space!" => \$main::opt_alloc_space,
- "alloc_objects!" => \$main::opt_alloc_objects,
- "show_bytes!" => \$main::opt_show_bytes,
- "drop_negative!" => \$main::opt_drop_negative,
- "total_delay!" => \$main::opt_total_delay,
- "contentions!" => \$main::opt_contentions,
- "mean_delay!" => \$main::opt_mean_delay,
- "tools=s" => \$main::opt_tools,
- "no_strip_temp!" => \$main::opt_no_strip_temp,
- "test!" => \$main::opt_test,
- "debug!" => \$main::opt_debug,
- # Undocumented flags used only by unittests:
- "test_stride=i" => \$main::opt_test_stride,
- ) || usage("Invalid option(s)");
-
- # Deal with the standard --help and --version
- if ($main::opt_help) {
- print usage_string();
- exit(0);
- }
-
- if ($main::opt_version) {
- print version_string();
- exit(0);
- }
-
- # Disassembly/listing/symbols mode requires address-level info
- if ($main::opt_disasm || $main::opt_list || $main::opt_symbols) {
- $main::opt_functions = 0;
- $main::opt_lines = 0;
- $main::opt_addresses = 1;
- $main::opt_files = 0;
- }
-
- # Check heap-profiling flags
- if ($main::opt_inuse_space +
- $main::opt_inuse_objects +
- $main::opt_alloc_space +
- $main::opt_alloc_objects > 1) {
- usage("Specify at most on of --inuse/--alloc options");
- }
-
- # Check output granularities
- my $grains =
- $main::opt_functions +
- $main::opt_lines +
- $main::opt_addresses +
- $main::opt_files +
- 0;
- if ($grains > 1) {
- usage("Only specify one output granularity option");
- }
- if ($grains == 0) {
- $main::opt_functions = 1;
- }
-
- # Check output modes
- my $modes =
- $main::opt_text +
- $main::opt_callgrind +
- ($main::opt_list eq '' ? 0 : 1) +
- ($main::opt_disasm eq '' ? 0 : 1) +
- ($main::opt_symbols == 0 ? 0 : 1) +
- $main::opt_gv +
- $main::opt_evince +
- $main::opt_web +
- $main::opt_dot +
- $main::opt_ps +
- $main::opt_pdf +
- $main::opt_svg +
- $main::opt_gif +
- $main::opt_raw +
- $main::opt_interactive +
- 0;
- if ($modes > 1) {
- usage("Only specify one output mode");
- }
- if ($modes == 0) {
- if (-t STDOUT) { # If STDOUT is a tty, activate interactive mode
- $main::opt_interactive = 1;
- } else {
- $main::opt_text = 1;
- }
- }
-
- if ($main::opt_test) {
- RunUnitTests();
- # Should not return
- exit(1);
- }
-
- # Binary name and profile arguments list
- $main::prog = "";
- @main::pfile_args = ();
-
- # Remote profiling without a binary (using $SYMBOL_PAGE instead)
- if (@ARGV > 0) {
- if (IsProfileURL($ARGV[0])) {
- printf STDERR "Using remote profile at $ARGV[0].\n";
- $main::use_symbol_page = 1;
- } elsif (IsSymbolizedProfileFile($ARGV[0])) {
- $main::use_symbolized_profile = 1;
- $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file
- }
- }
-
- if ($main::use_symbol_page || $main::use_symbolized_profile) {
- # We don't need a binary!
- my %disabled = ('--lines' => $main::opt_lines,
- '--disasm' => $main::opt_disasm);
- for my $option (keys %disabled) {
- usage("$option cannot be used without a binary") if $disabled{$option};
- }
- # Set $main::prog later...
- scalar(@ARGV) || usage("Did not specify profile file");
- } elsif ($main::opt_symbols) {
- # --symbols needs a binary-name (to run nm on, etc) but not profiles
- $main::prog = shift(@ARGV) || usage("Did not specify program");
- } else {
- $main::prog = shift(@ARGV) || usage("Did not specify program");
- scalar(@ARGV) || usage("Did not specify profile file");
- }
-
- # Parse profile file/location arguments
- foreach my $farg (@ARGV) {
- if ($farg =~ m/(.*)\@([0-9]+)(|\/.*)$/ ) {
- my $machine = $1;
- my $num_machines = $2;
- my $path = $3;
- for (my $i = 0; $i < $num_machines; $i++) {
- unshift(@main::pfile_args, "$i.$machine$path");
- }
- } else {
- unshift(@main::pfile_args, $farg);
- }
- }
-
- if ($main::use_symbol_page) {
- unless (IsProfileURL($main::pfile_args[0])) {
- error("The first profile should be a remote form to use $SYMBOL_PAGE\n");
- }
- CheckSymbolPage();
- $main::prog = FetchProgramName();
- } elsif (!$main::use_symbolized_profile) { # may not need objtools!
- ConfigureObjTools($main::prog)
- }
-
- # Break the opt_lib_prefix into the prefix_list array
- @prefix_list = split (',', $main::opt_lib_prefix);
-
- # Remove trailing / from the prefixes, in the list to prevent
- # searching things like /my/path//lib/mylib.so
- foreach (@prefix_list) {
- s|/+$||;
- }
-}
-
-sub Main() {
- Init();
- $main::collected_profile = undef;
- @main::profile_files = ();
- $main::op_time = time();
-
- # Printing symbols is special and requires a lot less info that most.
- if ($main::opt_symbols) {
- PrintSymbols(*STDIN); # Get /proc/maps and symbols output from stdin
- return;
- }
-
- # Fetch all profile data
- FetchDynamicProfiles();
-
- # this will hold symbols that we read from the profile files
- my $symbol_map = {};
-
- # Read one profile, pick the last item on the list
- my $data = ReadProfile($main::prog, pop(@main::profile_files));
- my $profile = $data->{profile};
- my $pcs = $data->{pcs};
- my $libs = $data->{libs}; # Info about main program and shared libraries
- $symbol_map = MergeSymbols($symbol_map, $data->{symbols});
-
- # Add additional profiles, if available.
- if (scalar(@main::profile_files) > 0) {
- foreach my $pname (@main::profile_files) {
- my $data2 = ReadProfile($main::prog, $pname);
- $profile = AddProfile($profile, $data2->{profile});
- $pcs = AddPcs($pcs, $data2->{pcs});
- $symbol_map = MergeSymbols($symbol_map, $data2->{symbols});
- }
- }
-
- # Subtract base from profile, if specified
- if ($main::opt_base ne '') {
- my $base = ReadProfile($main::prog, $main::opt_base);
- $profile = SubtractProfile($profile, $base->{profile});
- $pcs = AddPcs($pcs, $base->{pcs});
- $symbol_map = MergeSymbols($symbol_map, $base->{symbols});
- }
-
- # Get total data in profile
- my $total = TotalProfile($profile);
-
- # Collect symbols
- my $symbols;
- if ($main::use_symbolized_profile) {
- $symbols = FetchSymbols($pcs, $symbol_map);
- } elsif ($main::use_symbol_page) {
- $symbols = FetchSymbols($pcs);
- } else {
- # TODO(csilvers): $libs uses the /proc/self/maps data from profile1,
- # which may differ from the data from subsequent profiles, especially
- # if they were run on different machines. Use appropriate libs for
- # each pc somehow.
- $symbols = ExtractSymbols($libs, $pcs);
- }
-
- # Remove uniniteresting stack items
- $profile = RemoveUninterestingFrames($symbols, $profile);
-
- # Focus?
- if ($main::opt_focus ne '') {
- $profile = FocusProfile($symbols, $profile, $main::opt_focus);
- }
-
- # Ignore?
- if ($main::opt_ignore ne '') {
- $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore);
- }
-
- my $calls = ExtractCalls($symbols, $profile);
-
- # Reduce profiles to required output granularity, and also clean
- # each stack trace so a given entry exists at most once.
- my $reduced = ReduceProfile($symbols, $profile);
-
- # Get derived profiles
- my $flat = FlatProfile($reduced);
- my $cumulative = CumulativeProfile($reduced);
-
- # Print
- if (!$main::opt_interactive) {
- if ($main::opt_disasm) {
- PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm);
- } elsif ($main::opt_list) {
- PrintListing($total, $libs, $flat, $cumulative, $main::opt_list, 0);
- } elsif ($main::opt_text) {
- # Make sure the output is empty when have nothing to report
- # (only matters when --heapcheck is given but we must be
- # compatible with old branches that did not pass --heapcheck always):
- if ($total != 0) {
- printf("Total: %s %s\n", Unparse($total), Units());
- }
- if ($main::opt_stacks) {
- printf("Stacks:\n\n");
- PrintStacksForText($symbols, $profile);
- }
- PrintText($symbols, $flat, $cumulative, -1);
- } elsif ($main::opt_raw) {
- PrintSymbolizedProfile($symbols, $profile, $main::prog);
- } elsif ($main::opt_callgrind) {
- PrintCallgrind($calls);
- } else {
- if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
- if ($main::opt_gv) {
- RunGV(TempName($main::next_tmpfile, "ps"), "");
- } elsif ($main::opt_evince) {
- RunEvince(TempName($main::next_tmpfile, "pdf"), "");
- } 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);
- }
- }
- } else {
- InteractiveMode($profile, $symbols, $libs, $total);
- }
-
- cleanup();
- exit(0);
-}
-
-##### Entry Point #####
-
-Main();
-
-# Temporary code to detect if we're running on a Goobuntu system.
-# These systems don't have the right stuff installed for the special
-# Readline libraries to work, so as a temporary workaround, we default
-# to using the normal stdio code, rather than the fancier readline-based
-# code
-sub ReadlineMightFail {
- if (-e '/lib/libtermcap.so.2') {
- return 0; # libtermcap exists, so readline should be okay
- } else {
- return 1;
- }
-}
-
-sub RunGV {
- my $fname = shift;
- my $bg = shift; # "" or " &" if we should run in background
- if (!system(ShellEscape(@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
- # postscript files with large dimensions.
- # TODO: Maybe we should not pass the --noantialias flag
- # if the gv version is known to work properly without the flag.
- system(ShellEscape(@GV, "--scale=$main::opt_scale", "--noantialias", $fname)
- . $bg);
- } else {
- # Old gv version - only supports options that use single dash.
- print STDERR ShellEscape(@GV, "-scale", $main::opt_scale) . "\n";
- system(ShellEscape(@GV, "-scale", "$main::opt_scale", $fname) . $bg);
- }
-}
-
-sub RunEvince {
- my $fname = shift;
- my $bg = shift; # "" or " &" if we should run in background
- system(ShellEscape(@EVINCE, $fname) . $bg);
-}
-
-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;
- }
-
- if (`uname` =~ /MINGW/) {
- # Windows(MinGW): open will use standard preference for SVG files.
- system("cmd", "/c", "start", $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(ShellEscape(@KCACHEGRIND, $fname) . $bg);
-}
-
-
-##### Interactive helper routines #####
-
-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";
-
- # 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) '))) {
- $term->addhistory($_) if /\S/;
- if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {
- last; # exit when we get an interactive command to quit
- }
- }
- } else { # don't have readline
- while (1) {
- print STDERR "(pprof) ";
- $_ = <STDIN>;
- last if ! defined $_ ;
- s/\r//g; # turn windows-looking lines into unix-looking lines
-
- # Save some flags that might be reset by InteractiveCommand()
- my $save_opt_lines = $main::opt_lines;
-
- if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {
- last; # exit when we get an interactive command to quit
- }
-
- # Restore flags
- $main::opt_lines = $save_opt_lines;
- }
- }
-}
-
-# Takes two args: orig profile, and command to run.
-# Returns 1 if we should keep going, or 0 if we were asked to quit
-sub InteractiveCommand {
- my($orig_profile, $symbols, $libs, $total, $command) = @_;
- $_ = $command; # just to make future m//'s easier
- if (!defined($_)) {
- print STDERR "\n";
- return 0;
- }
- if (m/^\s*quit/) {
- return 0;
- }
- if (m/^\s*help/) {
- InteractiveHelpMessage();
- return 1;
- }
- # Clear all the mode options -- mode is controlled by "$command"
- $main::opt_text = 0;
- $main::opt_callgrind = 0;
- $main::opt_disasm = 0;
- $main::opt_list = 0;
- $main::opt_gv = 0;
- $main::opt_evince = 0;
- $main::opt_cum = 0;
-
- if (m/^\s*(text|top)(\d*)\s*(.*)/) {
- $main::opt_text = 1;
-
- my $line_limit = ($2 ne "") ? int($2) : 10;
-
- my $routine;
- my $ignore;
- ($routine, $ignore) = ParseInteractiveArgs($3);
-
- my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
- my $reduced = ReduceProfile($symbols, $profile);
-
- # Get derived profiles
- my $flat = FlatProfile($reduced);
- my $cumulative = CumulativeProfile($reduced);
-
- PrintText($symbols, $flat, $cumulative, $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*(web)?list\s*(.+)/) {
- my $html = (defined($1) && ($1 eq "web"));
- $main::opt_list = 1;
-
- my $routine;
- my $ignore;
- ($routine, $ignore) = ParseInteractiveArgs($2);
-
- my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
- my $reduced = ReduceProfile($symbols, $profile);
-
- # Get derived profiles
- my $flat = FlatProfile($reduced);
- my $cumulative = CumulativeProfile($reduced);
-
- PrintListing($total, $libs, $flat, $cumulative, $routine, $html);
- return 1;
- }
- if (m/^\s*disasm\s*(.+)/) {
- $main::opt_disasm = 1;
-
- my $routine;
- my $ignore;
- ($routine, $ignore) = ParseInteractiveArgs($1);
-
- # Process current profile to account for various settings
- my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
- my $reduced = ReduceProfile($symbols, $profile);
-
- # Get derived profiles
- my $flat = FlatProfile($reduced);
- my $cumulative = CumulativeProfile($reduced);
-
- PrintDisassembly($libs, $flat, $cumulative, $routine);
- return 1;
- }
- if (m/^\s*(gv|web|evince)\s*(.*)/) {
- $main::opt_gv = 0;
- $main::opt_evince = 0;
- $main::opt_web = 0;
- if ($1 eq "gv") {
- $main::opt_gv = 1;
- } elsif ($1 eq "evince") {
- $main::opt_evince = 1;
- } elsif ($1 eq "web") {
- $main::opt_web = 1;
- }
-
- my $focus;
- my $ignore;
- ($focus, $ignore) = ParseInteractiveArgs($2);
-
- # Process current profile to account for various settings
- my $profile = ProcessProfile($total, $orig_profile, $symbols,
- $focus, $ignore);
- my $reduced = ReduceProfile($symbols, $profile);
-
- # Get derived profiles
- my $flat = FlatProfile($reduced);
- 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_evince) {
- RunEvince(TempName($main::next_tmpfile, "pdf"), " &");
- } 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;
-}
-
-
-sub ProcessProfile {
- my $total_count = shift;
- my $orig_profile = shift;
- my $symbols = shift;
- my $focus = shift;
- my $ignore = shift;
-
- # Process current profile to account for various settings
- my $profile = $orig_profile;
- printf("Total: %s %s\n", Unparse($total_count), Units());
- if ($focus ne '') {
- $profile = FocusProfile($symbols, $profile, $focus);
- my $focus_count = TotalProfile($profile);
- printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n",
- $focus,
- Unparse($focus_count), Units(),
- Unparse($total_count), ($focus_count*100.0) / $total_count);
- }
- if ($ignore ne '') {
- $profile = IgnoreProfile($symbols, $profile, $ignore);
- my $ignore_count = TotalProfile($profile);
- printf("After ignoring '%s': %s %s of %s (%0.1f%%)\n",
- $ignore,
- Unparse($ignore_count), Units(),
- Unparse($total_count),
- ($ignore_count*100.0) / $total_count);
- }
-
- return $profile;
-}
-
-sub InteractiveHelpMessage {
- print STDERR <<ENDOFHELP;
-Interactive pprof mode
-
-Commands:
- gv
- gv [focus] [-ignore1] [-ignore2]
- Show graphical hierarchical display of current profile. Without
- any arguments, shows all samples in the profile. With the optional
- "focus" argument, restricts the samples shown to just those where
- 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"
-
- weblist [routine_regexp] [-ignore1] [-ignore2]
- Displays a source listing of routines whose names match "routine_regexp"
- in a web browser. You can click on source lines to view the
- corresponding disassembly.
-
- top [--cum] [-ignore1] [-ignore2]
- top20 [--cum] [-ignore1] [-ignore2]
- top37 [--cum] [-ignore1] [-ignore2]
- Show top lines ordered by flat profile count, or cumulative count
- if --cum is specified. If a number is present after 'top', the
- top K routines will be shown (defaults to showing the top 10)
-
- disasm [routine_regexp] [-ignore1] [-ignore2]
- 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
-
-For commands that accept optional -ignore tags, samples where any routine in
-the stack trace matches the regular expression in any of the -ignore
-parameters will be ignored.
-
-Further pprof details are available at this location (or one similar):
-
- /usr/doc/gperftools-$PPROF_VERSION/cpu_profiler.html
- /usr/doc/gperftools-$PPROF_VERSION/heap_profiler.html
-
-ENDOFHELP
-}
-sub ParseInteractiveArgs {
- my $args = shift;
- my $focus = "";
- my $ignore = "";
- my @x = split(/ +/, $args);
- foreach $a (@x) {
- if ($a =~ m/^(--|-)lines$/) {
- $main::opt_lines = 1;
- } elsif ($a =~ m/^(--|-)cum$/) {
- $main::opt_cum = 1;
- } elsif ($a =~ m/^-(.*)/) {
- $ignore .= (($ignore ne "") ? "|" : "" ) . $1;
- } else {
- $focus .= (($focus ne "") ? "|" : "" ) . $a;
- }
- }
- if ($ignore ne "") {
- print STDERR "Ignoring samples in call stacks that match '$ignore'\n";
- }
- return ($focus, $ignore);
-}
-
-##### Output code #####
-
-sub TempName {
- my $fnum = shift;
- 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
-sub PrintProfileData {
- my $profile = shift;
- my $big_endian = pack("L", 1) eq pack("N", 1);
- # print header (64-bit style)
- # (zero) (header-size) (version) (sample-period) (zero)
- if ($big_endian) {
- print pack('L*', 0, 0, 0, 3, 0, 0, 0, 1, 0, 0);
- }
- else {
- print pack('L*', 0, 0, 3, 0, 0, 0, 1, 0, 0, 0);
- }
-
- foreach my $k (keys(%{$profile})) {
- my $count = $profile->{$k};
- my @addrs = split(/\n/, $k);
- if ($#addrs >= 0) {
- my $depth = $#addrs + 1;
- # int(foo / 2**32) is the only reliable way to get rid of bottom
- # 32 bits on both 32- and 64-bit systems.
- if ($big_endian) {
- print pack('L*', int($count / 2**32), $count & 0xFFFFFFFF);
- print pack('L*', int($depth / 2**32), $depth & 0xFFFFFFFF);
- }
- else {
- print pack('L*', $count & 0xFFFFFFFF, int($count / 2**32));
- print pack('L*', $depth & 0xFFFFFFFF, int($depth / 2**32));
- }
-
- foreach my $full_addr (@addrs) {
- my $addr = $full_addr;
- $addr =~ s/0x0*//; # strip off leading 0x, zeroes
- if (length($addr) > 16) {
- print STDERR "Invalid address in profile: $full_addr\n";
- next;
- }
- my $low_addr = substr($addr, -8); # get last 8 hex chars
- my $high_addr = substr($addr, -16, 8); # get up to 8 more hex chars
- if ($big_endian) {
- print pack('L*', hex('0x' . $high_addr), hex('0x' . $low_addr));
- }
- else {
- print pack('L*', hex('0x' . $low_addr), hex('0x' . $high_addr));
- }
- }
- }
- }
-}
-
-# Print symbols and profile data
-sub PrintSymbolizedProfile {
- my $symbols = shift;
- my $profile = shift;
- my $prog = shift;
-
- $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
- my $symbol_marker = $&;
-
- print '--- ', $symbol_marker, "\n";
- if (defined($prog)) {
- print 'binary=', $prog, "\n";
- }
- while (my ($pc, $name) = each(%{$symbols})) {
- my $sep = ' ';
- print '0x', $pc;
- # We have a list of function names, which include the inlined
- # calls. They are separated (and terminated) by --, which is
- # illegal in function names.
- for (my $j = 2; $j <= $#{$name}; $j += 3) {
- print $sep, $name->[$j];
- $sep = '--';
- }
- print "\n";
- }
- print '---', "\n";
-
- $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash
- my $profile_marker = $&;
- print '--- ', $profile_marker, "\n";
- if (defined($main::collected_profile)) {
- # if used with remote fetch, simply dump the collected profile to output.
- open(SRC, "<$main::collected_profile");
- while (<SRC>) {
- print $_;
- }
- close(SRC);
- } else {
- # dump a cpu-format profile to standard out
- PrintProfileData($profile);
- }
-}
-
-# Print text output
-sub PrintText {
- my $symbols = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $line_limit = shift;
-
- if ($main::opt_stacks && @stackTraces) {
- foreach (sort { (split " ", $b)[1] <=> (split " ", $a)[1]; } @stackTraces) {
- print "$_\n" if $main::opt_debug;
- my ($n1, $s1, $n2, $s2, @addrs) = split;
- print "Leak of $s1 bytes in $n1 objects allocated from:\n";
- foreach my $pcstr (@addrs) {
- $pcstr =~ s/^0x//;
- my $sym;
- if (! defined $symbols->{$pcstr}) {
- $sym = "unknown";
- } else {
- $sym = "$symbols->{$pcstr}[0] $symbols->{$pcstr}[1]";
- }
- print "\t@ $pcstr $sym\n";
- }
- }
- print "\n";
- }
-
- my $total = TotalProfile($flat);
-
- # Which profile to sort by?
- my $s = $main::opt_cum ? $cumulative : $flat;
-
- my $running_sum = 0;
- my $lines = 0;
- foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b }
- keys(%{$cumulative})) {
- my $f = GetEntry($flat, $k);
- my $c = GetEntry($cumulative, $k);
- $running_sum += $f;
-
- my $sym = $k;
- if (exists($symbols->{$k})) {
- $sym = $symbols->{$k}->[0] . " " . $symbols->{$k}->[1];
- if ($main::opt_addresses) {
- $sym = $k . " " . $sym;
- }
- }
-
- if ($f != 0 || $c != 0) {
- printf("%8s %6s %6s %8s %6s %s\n",
- Unparse($f),
- Percent($f, $total),
- Percent($running_sum, $total),
- Unparse($c),
- Percent($c, $total),
- $sym);
- }
- $lines++;
- last if ($line_limit >= 0 && $lines >= $line_limit);
- }
-}
-
-# Callgrind format has a compression for repeated function and file
-# names. You show the name the first time, and just use its number
-# subsequently. This can cut down the file to about a third or a
-# quarter of its uncompressed size. $key and $val are the key/value
-# pair that would normally be printed by callgrind; $map is a map from
-# value to number.
-sub CompressedCGName {
- my($key, $val, $map) = @_;
- my $idx = $map->{$val};
- # For very short keys, providing an index hurts rather than helps.
- if (length($val) <= 3) {
- return "$key=$val\n";
- } elsif (defined($idx)) {
- return "$key=($idx)\n";
- } else {
- # scalar(keys $map) gives the number of items in the map.
- $idx = scalar(keys(%{$map})) + 1;
- $map->{$val} = $idx;
- return "$key=($idx) $val\n";
- }
-}
-
-# Print the call graph in a way that's suiteable for callgrind.
-sub PrintCallgrind {
- my $calls = shift;
- my $filename;
- my %filename_to_index_map;
- my %fnname_to_index_map;
-
- 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] }
- map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
- [$_, $1, $2] }
- keys %$calls ) {
- my $count = int($calls->{$call});
- $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
- my ( $caller_file, $caller_line, $caller_function,
- $callee_file, $callee_line, $callee_function ) =
- ( $1, $2, $3, $5, $6, $7 );
-
- # TODO(csilvers): for better compression, collect all the
- # caller/callee_files and functions first, before printing
- # anything, and only compress those referenced more than once.
- printf CG CompressedCGName("fl", $caller_file, \%filename_to_index_map);
- printf CG CompressedCGName("fn", $caller_function, \%fnname_to_index_map);
- if (defined $6) {
- printf CG CompressedCGName("cfl", $callee_file, \%filename_to_index_map);
- printf CG CompressedCGName("cfn", $callee_function, \%fnname_to_index_map);
- printf CG ("calls=$count $callee_line\n");
- }
- printf CG ("$caller_line $count\n\n");
- }
-}
-
-# Print disassembly for all all routines that match $main::opt_disasm
-sub PrintDisassembly {
- my $libs = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $disasm_opts = shift;
-
- my $total = TotalProfile($flat);
-
- foreach my $lib (@{$libs}) {
- my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts);
- my $offset = AddressSub($lib->[1], $lib->[3]);
- foreach my $routine (sort ByName keys(%{$symbol_table})) {
- my $start_addr = $symbol_table->{$routine}->[0];
- my $end_addr = $symbol_table->{$routine}->[1];
- # See if there are any samples in this routine
- my $length = hex(AddressSub($end_addr, $start_addr));
- my $addr = AddressAdd($start_addr, $offset);
- for (my $i = 0; $i < $length; $i++) {
- if (defined($cumulative->{$addr})) {
- PrintDisassembledFunction($lib->[0], $offset,
- $routine, $flat, $cumulative,
- $start_addr, $end_addr, $total);
- last;
- }
- $addr = AddressInc($addr);
- }
- }
- }
-}
-
-# Return reference to array of tuples of the form:
-# [start_address, filename, linenumber, instruction, limit_address]
-# E.g.,
-# ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"]
-sub Disassemble {
- my $prog = shift;
- my $offset = shift;
- my $start_addr = shift;
- my $end_addr = shift;
-
- my $objdump = $obj_tool_map{"objdump"};
- my $cmd = ShellEscape($objdump, "-C", "-d", "-l", "--no-show-raw-insn",
- "--start-address=0x$start_addr",
- "--stop-address=0x$end_addr", $prog);
- open(OBJDUMP, "$cmd |") || error("$cmd: $!\n");
- my @result = ();
- my $filename = "";
- my $linenumber = -1;
- my $last = ["", "", "", ""];
- while (<OBJDUMP>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
- chop;
- if (m|\s*([^:\s]+):(\d+)\s*$|) {
- # Location line of the form:
- # <filename>:<linenumber>
- $filename = $1;
- $linenumber = $2;
- } elsif (m/^ +([0-9a-f]+):\s*(.*)/) {
- # Disassembly line -- zero-extend address to full length
- my $addr = HexExtend($1);
- my $k = AddressAdd($addr, $offset);
- $last->[4] = $k; # Store ending address for previous instruction
- $last = [$k, $filename, $linenumber, $2, $end_addr];
- push(@result, $last);
- }
- }
- close(OBJDUMP);
- return @result;
-}
-
-# The input file should contain lines of the form /proc/maps-like
-# output (same format as expected from the profiles) or that looks
-# like hex addresses (like "0xDEADBEEF"). We will parse all
-# /proc/maps output, and for all the hex addresses, we will output
-# "short" symbol names, one per line, in the same order as the input.
-sub PrintSymbols {
- my $maps_and_symbols_file = shift;
-
- # ParseLibraries expects pcs to be in a set. Fine by us...
- my @pclist = (); # pcs in sorted order
- my $pcs = {};
- my $map = "";
- foreach my $line (<$maps_and_symbols_file>) {
- $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
- if ($line =~ /\b(0x[0-9a-f]+)\b/i) {
- push(@pclist, HexExtend($1));
- $pcs->{$pclist[-1]} = 1;
- } else {
- $map .= $line;
- }
- }
-
- my $libs = ParseLibraries($main::prog, $map, $pcs);
- my $symbols = ExtractSymbols($libs, $pcs);
-
- foreach my $pc (@pclist) {
- # ->[0] is the shortname, ->[2] is the full name
- print(($symbols->{$pc}->[0] || "??") . "\n");
- }
-}
-
-
-# For sorting functions by name
-sub ByName {
- return ShortFunctionName($a) cmp ShortFunctionName($b);
-}
-
-# Print source-listing for all all routines that match $list_opts
-sub PrintListing {
- my $total = shift;
- my $libs = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $list_opts = shift;
- my $html = shift;
-
- my $output = \*STDOUT;
- my $fname = "";
-
- if ($html) {
- # Arrange to write the output to a temporary file
- $fname = TempName($main::next_tmpfile, "html");
- $main::next_tmpfile++;
- if (!open(TEMP, ">$fname")) {
- print STDERR "$fname: $!\n";
- return;
- }
- $output = \*TEMP;
- print $output HtmlListingHeader();
- printf $output ("<div class=\"legend\">%s<br>Total: %s %s</div>\n",
- $main::prog, Unparse($total), Units());
- }
-
- my $listed = 0;
- foreach my $lib (@{$libs}) {
- my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts);
- my $offset = AddressSub($lib->[1], $lib->[3]);
- foreach my $routine (sort ByName keys(%{$symbol_table})) {
- # Print if there are any samples in this routine
- my $start_addr = $symbol_table->{$routine}->[0];
- my $end_addr = $symbol_table->{$routine}->[1];
- my $length = hex(AddressSub($end_addr, $start_addr));
- my $addr = AddressAdd($start_addr, $offset);
- for (my $i = 0; $i < $length; $i++) {
- if (defined($cumulative->{$addr})) {
- $listed += PrintSource(
- $lib->[0], $offset,
- $routine, $flat, $cumulative,
- $start_addr, $end_addr,
- $html,
- $output);
- last;
- }
- $addr = AddressInc($addr);
- }
- }
- }
-
- if ($html) {
- if ($listed > 0) {
- print $output HtmlListingFooter();
- close($output);
- RunWeb($fname);
- } else {
- close($output);
- unlink($fname);
- }
- }
-}
-
-sub HtmlListingHeader {
- return <<'EOF';
-<DOCTYPE html>
-<html>
-<head>
-<title>Pprof listing</title>
-<style type="text/css">
-body {
- font-family: sans-serif;
-}
-h1 {
- font-size: 1.5em;
- margin-bottom: 4px;
-}
-.legend {
- font-size: 1.25em;
-}
-.line {
- color: #aaaaaa;
-}
-.nop {
- color: #aaaaaa;
-}
-.unimportant {
- color: #cccccc;
-}
-.disasmloc {
- color: #000000;
-}
-.deadsrc {
- cursor: pointer;
-}
-.deadsrc:hover {
- background-color: #eeeeee;
-}
-.livesrc {
- color: #0000ff;
- cursor: pointer;
-}
-.livesrc:hover {
- background-color: #eeeeee;
-}
-.asm {
- color: #008800;
- display: none;
-}
-</style>
-<script type="text/javascript">
-function pprof_toggle_asm(e) {
- var target;
- if (!e) e = window.event;
- if (e.target) target = e.target;
- else if (e.srcElement) target = e.srcElement;
-
- if (target) {
- var asm = target.nextSibling;
- if (asm && asm.className == "asm") {
- asm.style.display = (asm.style.display == "block" ? "" : "block");
- e.preventDefault();
- return false;
- }
- }
-}
-</script>
-</head>
-<body>
-EOF
-}
-
-sub HtmlListingFooter {
- return <<'EOF';
-</body>
-</html>
-EOF
-}
-
-sub HtmlEscape {
- my $text = shift;
- $text =~ s/&/&/g;
- $text =~ s/</</g;
- $text =~ s/>/>/g;
- return $text;
-}
-
-# Returns the indentation of the line, if it has any non-whitespace
-# characters. Otherwise, returns -1.
-sub Indentation {
- my $line = shift;
- if (m/^(\s*)\S/) {
- return length($1);
- } else {
- return -1;
- }
-}
-
-# If the symbol table contains inlining info, Disassemble() may tag an
-# instruction with a location inside an inlined function. But for
-# source listings, we prefer to use the location in the function we
-# are listing. So use MapToSymbols() to fetch full location
-# information for each instruction and then pick out the first
-# location from a location list (location list contains callers before
-# callees in case of inlining).
-#
-# After this routine has run, each entry in $instructions contains:
-# [0] start address
-# [1] filename for function we are listing
-# [2] line number for function we are listing
-# [3] disassembly
-# [4] limit address
-# [5] most specific filename (may be different from [1] due to inlining)
-# [6] most specific line number (may be different from [2] due to inlining)
-sub GetTopLevelLineNumbers {
- my ($lib, $offset, $instructions) = @_;
- my $pcs = [];
- for (my $i = 0; $i <= $#{$instructions}; $i++) {
- push(@{$pcs}, $instructions->[$i]->[0]);
- }
- my $symbols = {};
- MapToSymbols($lib, $offset, $pcs, $symbols);
- for (my $i = 0; $i <= $#{$instructions}; $i++) {
- my $e = $instructions->[$i];
- push(@{$e}, $e->[1]);
- push(@{$e}, $e->[2]);
- my $addr = $e->[0];
- my $sym = $symbols->{$addr};
- if (defined($sym)) {
- if ($#{$sym} >= 2 && $sym->[1] =~ m/^(.*):(\d+)$/) {
- $e->[1] = $1; # File name
- $e->[2] = $2; # Line number
- }
- }
- }
-}
-
-# Print source-listing for one routine
-sub PrintSource {
- my $prog = shift;
- my $offset = shift;
- my $routine = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $start_addr = shift;
- my $end_addr = shift;
- my $html = shift;
- my $output = shift;
-
- # Disassemble all instructions (just to get line numbers)
- my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);
- GetTopLevelLineNumbers($prog, $offset, \@instructions);
-
- # Hack 1: assume that the first source file encountered in the
- # disassembly contains the routine
- my $filename = undef;
- for (my $i = 0; $i <= $#instructions; $i++) {
- if ($instructions[$i]->[2] >= 0) {
- $filename = $instructions[$i]->[1];
- last;
- }
- }
- if (!defined($filename)) {
- print STDERR "no filename found in $routine\n";
- return 0;
- }
-
- # Hack 2: assume that the largest line number from $filename is the
- # end of the procedure. This is typically safe since if P1 contains
- # an inlined call to P2, then P2 usually occurs earlier in the
- # source file. If this does not work, we might have to compute a
- # density profile or just print all regions we find.
- my $lastline = 0;
- for (my $i = 0; $i <= $#instructions; $i++) {
- my $f = $instructions[$i]->[1];
- my $l = $instructions[$i]->[2];
- if (($f eq $filename) && ($l > $lastline)) {
- $lastline = $l;
- }
- }
-
- # Hack 3: assume the first source location from "filename" is the start of
- # the source code.
- my $firstline = 1;
- for (my $i = 0; $i <= $#instructions; $i++) {
- if ($instructions[$i]->[1] eq $filename) {
- $firstline = $instructions[$i]->[2];
- last;
- }
- }
-
- # Hack 4: Extend last line forward until its indentation is less than
- # the indentation we saw on $firstline
- my $oldlastline = $lastline;
- {
- if (!open(FILE, "<$filename")) {
- print STDERR "$filename: $!\n";
- return 0;
- }
- my $l = 0;
- my $first_indentation = -1;
- while (<FILE>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
- $l++;
- my $indent = Indentation($_);
- if ($l >= $firstline) {
- if ($first_indentation < 0 && $indent >= 0) {
- $first_indentation = $indent;
- last if ($first_indentation == 0);
- }
- }
- if ($l >= $lastline && $indent >= 0) {
- if ($indent >= $first_indentation) {
- $lastline = $l+1;
- } else {
- last;
- }
- }
- }
- close(FILE);
- }
-
- # Assign all samples to the range $firstline,$lastline,
- # Hack 4: If an instruction does not occur in the range, its samples
- # are moved to the next instruction that occurs in the range.
- my $samples1 = {}; # Map from line number to flat count
- my $samples2 = {}; # Map from line number to cumulative count
- my $running1 = 0; # Unassigned flat counts
- my $running2 = 0; # Unassigned cumulative counts
- my $total1 = 0; # Total flat counts
- my $total2 = 0; # Total cumulative counts
- my %disasm = (); # Map from line number to disassembly
- my $running_disasm = ""; # Unassigned disassembly
- my $skip_marker = "---\n";
- if ($html) {
- $skip_marker = "";
- for (my $l = $firstline; $l <= $lastline; $l++) {
- $disasm{$l} = "";
- }
- }
- my $last_dis_filename = '';
- my $last_dis_linenum = -1;
- my $last_touched_line = -1; # To detect gaps in disassembly for a line
- foreach my $e (@instructions) {
- # Add up counts for all address that fall inside this instruction
- my $c1 = 0;
- my $c2 = 0;
- for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
- $c1 += GetEntry($flat, $a);
- $c2 += GetEntry($cumulative, $a);
- }
-
- if ($html) {
- my $dis = sprintf(" %6s %6s \t\t%8s: %s ",
- HtmlPrintNumber($c1),
- HtmlPrintNumber($c2),
- UnparseAddress($offset, $e->[0]),
- CleanDisassembly($e->[3]));
-
- # Append the most specific source line associated with this instruction
- if (length($dis) < 80) { $dis .= (' ' x (80 - length($dis))) };
- $dis = HtmlEscape($dis);
- my $f = $e->[5];
- my $l = $e->[6];
- if ($f ne $last_dis_filename) {
- $dis .= sprintf("<span class=disasmloc>%s:%d</span>",
- HtmlEscape(CleanFileName($f)), $l);
- } elsif ($l ne $last_dis_linenum) {
- # De-emphasize the unchanged file name portion
- $dis .= sprintf("<span class=unimportant>%s</span>" .
- "<span class=disasmloc>:%d</span>",
- HtmlEscape(CleanFileName($f)), $l);
- } else {
- # De-emphasize the entire location
- $dis .= sprintf("<span class=unimportant>%s:%d</span>",
- HtmlEscape(CleanFileName($f)), $l);
- }
- $last_dis_filename = $f;
- $last_dis_linenum = $l;
- $running_disasm .= $dis;
- $running_disasm .= "\n";
- }
-
- $running1 += $c1;
- $running2 += $c2;
- $total1 += $c1;
- $total2 += $c2;
- my $file = $e->[1];
- my $line = $e->[2];
- if (($file eq $filename) &&
- ($line >= $firstline) &&
- ($line <= $lastline)) {
- # Assign all accumulated samples to this line
- AddEntry($samples1, $line, $running1);
- AddEntry($samples2, $line, $running2);
- $running1 = 0;
- $running2 = 0;
- if ($html) {
- if ($line != $last_touched_line && $disasm{$line} ne '') {
- $disasm{$line} .= "\n";
- }
- $disasm{$line} .= $running_disasm;
- $running_disasm = '';
- $last_touched_line = $line;
- }
- }
- }
-
- # Assign any leftover samples to $lastline
- AddEntry($samples1, $lastline, $running1);
- AddEntry($samples2, $lastline, $running2);
- if ($html) {
- if ($lastline != $last_touched_line && $disasm{$lastline} ne '') {
- $disasm{$lastline} .= "\n";
- }
- $disasm{$lastline} .= $running_disasm;
- }
-
- if ($html) {
- printf $output (
- "<h1>%s</h1>%s\n<pre onClick=\"pprof_toggle_asm()\">\n" .
- "Total:%6s %6s (flat / cumulative %s)\n",
- HtmlEscape(ShortFunctionName($routine)),
- HtmlEscape(CleanFileName($filename)),
- Unparse($total1),
- Unparse($total2),
- Units());
- } else {
- printf $output (
- "ROUTINE ====================== %s in %s\n" .
- "%6s %6s Total %s (flat / cumulative)\n",
- ShortFunctionName($routine),
- CleanFileName($filename),
- Unparse($total1),
- Unparse($total2),
- Units());
- }
- if (!open(FILE, "<$filename")) {
- print STDERR "$filename: $!\n";
- return 0;
- }
- my $l = 0;
- while (<FILE>) {
- s/\r//g; # turn windows-looking lines into unix-looking lines
- $l++;
- if ($l >= $firstline - 5 &&
- (($l <= $oldlastline + 5) || ($l <= $lastline))) {
- chop;
- my $text = $_;
- if ($l == $firstline) { print $output $skip_marker; }
- my $n1 = GetEntry($samples1, $l);
- my $n2 = GetEntry($samples2, $l);
- if ($html) {
- # Emit a span that has one of the following classes:
- # livesrc -- has samples
- # deadsrc -- has disassembly, but with no samples
- # nop -- has no matching disasembly
- # Also emit an optional span containing disassembly.
- my $dis = $disasm{$l};
- my $asm = "";
- if (defined($dis) && $dis ne '') {
- $asm = "<span class=\"asm\">" . $dis . "</span>";
- }
- my $source_class = (($n1 + $n2 > 0)
- ? "livesrc"
- : (($asm ne "") ? "deadsrc" : "nop"));
- printf $output (
- "<span class=\"line\">%5d</span> " .
- "<span class=\"%s\">%6s %6s %s</span>%s\n",
- $l, $source_class,
- HtmlPrintNumber($n1),
- HtmlPrintNumber($n2),
- HtmlEscape($text),
- $asm);
- } else {
- printf $output(
- "%6s %6s %4d: %s\n",
- UnparseAlt($n1),
- UnparseAlt($n2),
- $l,
- $text);
- }
- if ($l == $lastline) { print $output $skip_marker; }
- };
- }
- close(FILE);
- if ($html) {
- print $output "</pre>\n";
- }
- return 1;
-}
-
-# Return the source line for the specified file/linenumber.
-# Returns undef if not found.
-sub SourceLine {
- my $file = shift;
- my $line = shift;
-
- # Look in cache
- if (!defined($main::source_cache{$file})) {
- if (100 < scalar keys(%main::source_cache)) {
- # Clear the cache when it gets too big
- $main::source_cache = ();
- }
-
- # Read all lines from the file
- if (!open(FILE, "<$file")) {
- print STDERR "$file: $!\n";
- $main::source_cache{$file} = []; # Cache the negative result
- return undef;
- }
- my $lines = [];
- push(@{$lines}, ""); # So we can use 1-based line numbers as indices
- while (<FILE>) {
- push(@{$lines}, $_);
- }
- close(FILE);
-
- # Save the lines in the cache
- $main::source_cache{$file} = $lines;
- }
-
- my $lines = $main::source_cache{$file};
- if (($line < 0) || ($line > $#{$lines})) {
- return undef;
- } else {
- return $lines->[$line];
- }
-}
-
-# Print disassembly for one routine with interspersed source if available
-sub PrintDisassembledFunction {
- my $prog = shift;
- my $offset = shift;
- my $routine = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $start_addr = shift;
- my $end_addr = shift;
- my $total = shift;
-
- # Disassemble all instructions
- my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);
-
- # Make array of counts per instruction
- my @flat_count = ();
- my @cum_count = ();
- my $flat_total = 0;
- my $cum_total = 0;
- foreach my $e (@instructions) {
- # Add up counts for all address that fall inside this instruction
- my $c1 = 0;
- my $c2 = 0;
- for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
- $c1 += GetEntry($flat, $a);
- $c2 += GetEntry($cumulative, $a);
- }
- push(@flat_count, $c1);
- push(@cum_count, $c2);
- $flat_total += $c1;
- $cum_total += $c2;
- }
-
- # Print header with total counts
- printf("ROUTINE ====================== %s\n" .
- "%6s %6s %s (flat, cumulative) %.1f%% of total\n",
- ShortFunctionName($routine),
- Unparse($flat_total),
- Unparse($cum_total),
- Units(),
- ($cum_total * 100.0) / $total);
-
- # Process instructions in order
- my $current_file = "";
- for (my $i = 0; $i <= $#instructions; ) {
- my $e = $instructions[$i];
-
- # Print the new file name whenever we switch files
- if ($e->[1] ne $current_file) {
- $current_file = $e->[1];
- my $fname = $current_file;
- $fname =~ s|^\./||; # Trim leading "./"
-
- # Shorten long file names
- if (length($fname) >= 58) {
- $fname = "..." . substr($fname, -55);
- }
- printf("-------------------- %s\n", $fname);
- }
-
- # TODO: Compute range of lines to print together to deal with
- # small reorderings.
- my $first_line = $e->[2];
- my $last_line = $first_line;
- my %flat_sum = ();
- my %cum_sum = ();
- for (my $l = $first_line; $l <= $last_line; $l++) {
- $flat_sum{$l} = 0;
- $cum_sum{$l} = 0;
- }
-
- # 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)) {
- $e = $instructions[$i];
- $flat_sum{$e->[2]} += $flat_count[$i];
- $cum_sum{$e->[2]} += $cum_count[$i];
- $i++;
- }
- my $last_inst = $i - 1;
-
- # Print source lines
- for (my $l = $first_line; $l <= $last_line; $l++) {
- my $line = SourceLine($current_file, $l);
- if (!defined($line)) {
- $line = "?\n";
- next;
- } else {
- $line =~ s/^\s+//;
- }
- printf("%6s %6s %5d: %s",
- UnparseAlt($flat_sum{$l}),
- UnparseAlt($cum_sum{$l}),
- $l,
- $line);
- }
-
- # Print disassembly
- for (my $x = $first_inst; $x <= $last_inst; $x++) {
- my $e = $instructions[$x];
- printf("%6s %6s %8s: %6s\n",
- UnparseAlt($flat_count[$x]),
- UnparseAlt($cum_count[$x]),
- UnparseAddress($offset, $e->[0]),
- CleanDisassembly($e->[3]));
- }
- }
-}
-
-# Print DOT graph
-sub PrintDot {
- my $prog = shift;
- my $symbols = shift;
- my $raw = shift;
- my $flat = shift;
- my $cumulative = shift;
- my $overall_total = shift;
-
- # Get total
- my $local_total = TotalProfile($flat);
- my $nodelimit = int($main::opt_nodefraction * $local_total);
- my $edgelimit = int($main::opt_edgefraction * $local_total);
- my $nodecount = $main::opt_nodecount;
-
- # Find nodes to include
- my @list = (sort { abs(GetEntry($cumulative, $b)) <=>
- abs(GetEntry($cumulative, $a))
- || $a cmp $b }
- keys(%{$cumulative}));
- my $last = $nodecount - 1;
- if ($last > $#list) {
- $last = $#list;
- }
- while (($last >= 0) &&
- (abs(GetEntry($cumulative, $list[$last])) <= $nodelimit)) {
- $last--;
- }
- if ($last < 0) {
- print STDERR "No nodes to print\n";
- return 0;
- }
-
- if ($nodelimit > 0 || $edgelimit > 0) {
- printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n",
- Unparse($nodelimit), Units(),
- Unparse($edgelimit), Units());
- }
-
- # Open DOT output file
- my $output;
- my $escaped_dot = ShellEscape(@DOT);
- my $escaped_ps2pdf = ShellEscape(@PS2PDF);
- if ($main::opt_gv) {
- my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "ps"));
- $output = "| $escaped_dot -Tps2 >$escaped_outfile";
- } elsif ($main::opt_evince) {
- my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "pdf"));
- $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - $escaped_outfile";
- } elsif ($main::opt_ps) {
- $output = "| $escaped_dot -Tps2";
- } elsif ($main::opt_pdf) {
- $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - -";
- } elsif ($main::opt_web || $main::opt_svg) {
- # We need to post-process the SVG, so write to a temporary file always.
- my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "svg"));
- $output = "| $escaped_dot -Tsvg >$escaped_outfile";
- } elsif ($main::opt_gif) {
- $output = "| $escaped_dot -Tgif";
- } else {
- $output = ">&STDOUT";
- }
- open(DOT, $output) || error("$output: $!\n");
-
- # Title
- printf DOT ("digraph \"%s; %s %s\" {\n",
- $prog,
- Unparse($overall_total),
- Units());
- if ($main::opt_pdf) {
- # The output is more printable if we set the page size for dot.
- printf DOT ("size=\"8,11\"\n");
- }
- printf DOT ("node [width=0.375,height=0.25];\n");
-
- # Print legend
- printf DOT ("Legend [shape=box,fontsize=24,shape=plaintext," .
- "label=\"%s\\l%s\\l%s\\l%s\\l%s\\l\"];\n",
- $prog,
- sprintf("Total %s: %s", Units(), Unparse($overall_total)),
- sprintf("Focusing on: %s", Unparse($local_total)),
- sprintf("Dropped nodes with <= %s abs(%s)",
- Unparse($nodelimit), Units()),
- sprintf("Dropped edges with <= %s %s",
- Unparse($edgelimit), Units())
- );
-
- # Print nodes
- my %node = ();
- my $nextnode = 1;
- foreach my $a (@list[0..$last]) {
- # Pick font size
- my $f = GetEntry($flat, $a);
- my $c = GetEntry($cumulative, $a);
-
- my $fs = 8;
- if ($local_total > 0) {
- $fs = 8 + (50.0 * sqrt(abs($f * 1.0 / $local_total)));
- }
-
- $node{$a} = $nextnode++;
- my $sym = $a;
- $sym =~ s/\s+/\\n/g;
- $sym =~ s/::/\\n/g;
-
- # Extra cumulative info to print for non-leaves
- my $extra = "";
- if ($f != $c) {
- $extra = sprintf("\\rof %s (%s)",
- Unparse($c),
- Percent($c, $local_total));
- }
- my $style = "";
- if ($main::opt_heapcheck) {
- if ($f > 0) {
- # make leak-causing nodes more visible (add a background)
- $style = ",style=filled,fillcolor=gray"
- } elsif ($f < 0) {
- # make anti-leak-causing nodes (which almost never occur)
- # stand out as well (triple border)
- $style = ",peripheries=3"
- }
- }
-
- printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" .
- "\",shape=box,fontsize=%.1f%s];\n",
- $node{$a},
- $sym,
- Unparse($f),
- Percent($f, $local_total),
- $extra,
- $fs,
- $style,
- );
- }
-
- # Get edges and counts per edge
- my %edge = ();
- my $n;
- my $fullname_to_shortname_map = {};
- FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
- foreach my $k (keys(%{$raw})) {
- # TODO: omit low %age edges
- $n = $raw->{$k};
- my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k);
- for (my $i = 1; $i <= $#translated; $i++) {
- my $src = $translated[$i];
- my $dst = $translated[$i-1];
- #next if ($src eq $dst); # Avoid self-edges?
- if (exists($node{$src}) && exists($node{$dst})) {
- my $edge_label = "$src\001$dst";
- if (!exists($edge{$edge_label})) {
- $edge{$edge_label} = 0;
- }
- $edge{$edge_label} += $n;
- }
- }
- }
-
- # Print edges (process in order of decreasing counts)
- my %indegree = (); # Number of incoming edges added per node so far
- my %outdegree = (); # Number of outgoing edges added per node so far
- foreach my $e (sort { $edge{$b} <=> $edge{$a} } keys(%edge)) {
- my @x = split(/\001/, $e);
- $n = $edge{$e};
-
- # Initialize degree of kept incoming and outgoing edges if necessary
- my $src = $x[0];
- my $dst = $x[1];
- if (!exists($outdegree{$src})) { $outdegree{$src} = 0; }
- if (!exists($indegree{$dst})) { $indegree{$dst} = 0; }
-
- my $keep;
- if ($indegree{$dst} == 0) {
- # Keep edge if needed for reachability
- $keep = 1;
- } elsif (abs($n) <= $edgelimit) {
- # Drop if we are below --edgefraction
- $keep = 0;
- } elsif ($outdegree{$src} >= $main::opt_maxdegree ||
- $indegree{$dst} >= $main::opt_maxdegree) {
- # Keep limited number of in/out edges per node
- $keep = 0;
- } else {
- $keep = 1;
- }
-
- if ($keep) {
- $outdegree{$src}++;
- $indegree{$dst}++;
-
- # Compute line width based on edge count
- 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;
- }
-
- # Dot sometimes segfaults if given edge weights that are too large, so
- # we cap the weights at a large value
- my $edgeweight = abs($n) ** 0.7;
- if ($edgeweight > 100000) { $edgeweight = 100000; }
- $edgeweight = int($edgeweight);
-
- my $style = sprintf("setlinewidth(%f)", $w);
- if ($x[1] =~ m/\(inline\)/) {
- $style .= ",dashed";
- }
-
- # Use a slightly squashed function of the edge count as the weight
- printf DOT ("N%s -> N%s [label=%s, weight=%d, style=\"%s\"];\n",
- $node{$x[0]},
- $node{$x[1]},
- Unparse($n),
- $edgeweight,
- $style);
- }
- }
-
- 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....@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
-}
-
-# Provides a map from fullname to shortname for cases where the
-# shortname is ambiguous. The symlist has both the fullname and
-# shortname for all symbols, which is usually fine, but sometimes --
-# such as overloaded functions -- two different fullnames can map to
-# the same shortname. In that case, we use the address of the
-# function to disambiguate the two. This function fills in a map that
-# maps fullnames to modified shortnames in such cases. If a fullname
-# is not present in the map, the 'normal' shortname provided by the
-# symlist is the appropriate one to use.
-sub FillFullnameToShortnameMap {
- my $symbols = shift;
- my $fullname_to_shortname_map = shift;
- my $shortnames_seen_once = {};
- my $shortnames_seen_more_than_once = {};
-
- foreach my $symlist (values(%{$symbols})) {
- # TODO(csilvers): deal with inlined symbols too.
- my $shortname = $symlist->[0];
- my $fullname = $symlist->[2];
- if ($fullname !~ /<[0-9a-fA-F]+>$/) { # fullname doesn't end in an address
- next; # the only collisions we care about are when addresses differ
- }
- if (defined($shortnames_seen_once->{$shortname}) &&
- $shortnames_seen_once->{$shortname} ne $fullname) {
- $shortnames_seen_more_than_once->{$shortname} = 1;
- } else {
- $shortnames_seen_once->{$shortname} = $fullname;
- }
- }
-
- foreach my $symlist (values(%{$symbols})) {
- my $shortname = $symlist->[0];
- my $fullname = $symlist->[2];
- # TODO(csilvers): take in a list of addresses we care about, and only
- # store in the map if $symlist->[1] is in that list. Saves space.
- next if defined($fullname_to_shortname_map->{$fullname});
- if (defined($shortnames_seen_more_than_once->{$shortname})) {
- if ($fullname =~ /<0*([^>]*)>$/) { # fullname has address at end of it
- $fullname_to_shortname_map->{$fullname} = "$shortname\@$1";
- }
- }
- }
-}
-
-# Return a small number that identifies the argument.
-# Multiple calls with the same argument will return the same number.
-# Calls with different arguments will return different numbers.
-sub ShortIdFor {
- my $key = shift;
- my $id = $main::uniqueid{$key};
- if (!defined($id)) {
- $id = keys(%main::uniqueid) + 1;
- $main::uniqueid{$key} = $id;
- }
- return $id;
-}
-
-# Translate a stack of addresses into a stack of symbols
-sub TranslateStack {
- my $symbols = shift;
- my $fullname_to_shortname_map = shift;
- my $k = shift;
-
- my @addrs = split(/\n/, $k);
- my @result = ();
- for (my $i = 0; $i <= $#addrs; $i++) {
- my $a = $addrs[$i];
-
- # Skip large addresses since they sometimes show up as fake entries on RH9
- if (length($a) > 8 && $a gt "7fffffffffffffff") {
- next;
- }
-
- if ($main::opt_disasm || $main::opt_list) {
- # We want just the address for the key
- push(@result, $a);
- next;
- }
-
- my $symlist = $symbols->{$a};
- if (!defined($symlist)) {
- $symlist = [$a, "", $a];
- }
-
- # We can have a sequence of symbols for a particular entry
- # (more than one symbol in the case of inlining). Callers
- # come before callees in symlist, so walk backwards since
- # the translated stack should contain callees before callers.
- for (my $j = $#{$symlist}; $j >= 2; $j -= 3) {
- my $func = $symlist->[$j-2];
- my $fileline = $symlist->[$j-1];
- my $fullfunc = $symlist->[$j];
- if (defined($fullname_to_shortname_map->{$fullfunc})) {
- $func = $fullname_to_shortname_map->{$fullfunc};
- }
- if ($j > 2) {
- $func = "$func (inline)";
- }
-
- # Do not merge nodes corresponding to Callback::Run since that
- # causes confusing cycles in dot display. Instead, we synthesize
- # a unique name for this frame per caller.
- if ($func =~ m/Callback.*::Run$/) {
- my $caller = ($i > 0) ? $addrs[$i-1] : 0;
- $func = "Run#" . ShortIdFor($caller);
- }
-
- if ($main::opt_addresses) {
- push(@result, "$a $func $fileline");
- } elsif ($main::opt_lines) {
- if ($func eq '??' && $fileline eq '??:0') {
- push(@result, "$a");
- } elsif (!$main::opt_show_addresses) {
- push(@result, "$func $fileline");
- } else {
- push(@result, "$func $fileline ($a)");
- }
- } elsif ($main::opt_functions) {
- if ($func eq '??') {
- push(@result, "$a");
- } elsif (!$main::opt_show_addresses) {
- push(@result, $func);
- } else {
- push(@result, "$func ($a)");
- }
- } elsif ($main::opt_files) {
- if ($fileline eq '??:0' || $fileline eq '') {
- push(@result, "$a");
- } else {
- my $f = $fileline;
- $f =~ s/:\d+$//;
- push(@result, $f);
- }
- } else {
- push(@result, $a);
- last; # Do not print inlined info
- }
- }
- }
-
- # print join(",", @addrs), " => ", join(",", @result), "\n";
- return @result;
-}
-
-# Generate percent string for a number and a total
-sub Percent {
- my $num = shift;
- my $tot = shift;
- if ($tot != 0) {
- return sprintf("%.1f%%", $num * 100.0 / $tot);
- } else {
- return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf");
- }
-}
-
-# Generate pretty-printed form of number
-sub Unparse {
- my $num = shift;
- if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
- if ($main::opt_inuse_objects || $main::opt_alloc_objects) {
- return sprintf("%d", $num);
- } else {
- if ($main::opt_show_bytes) {
- return sprintf("%d", $num);
- } else {
- return sprintf("%.1f", $num / 1048576.0);
- }
- }
- } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {
- return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds
- } else {
- return sprintf("%d", $num);
- }
-}
-
-# Alternate pretty-printed form: 0 maps to "."
-sub UnparseAlt {
- my $num = shift;
- if ($num == 0) {
- return ".";
- } else {
- return Unparse($num);
- }
-}
-
-# Alternate pretty-printed form: 0 maps to ""
-sub HtmlPrintNumber {
- my $num = shift;
- if ($num == 0) {
- return "";
- } else {
- return Unparse($num);
- }
-}
-
-# Return output units
-sub Units {
- if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
- if ($main::opt_inuse_objects || $main::opt_alloc_objects) {
- return "objects";
- } else {
- if ($main::opt_show_by
<TRUNCATED>