The Tor Browser: comparison memory/jemalloc/src/bin/pprof

--1:000000000000
+:0399e8c5c288
+#! /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;
+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;
+##### 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
+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
+--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:
+--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();
+print STDERR "\nFATAL ERROR: $msg\n";    # just as a reminder
+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_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_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;
+# 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,
+"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,
+"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,
+"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])) {
+$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());
+}
+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;
+}
+# 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;
+# print header (64-bit style)
+# (zero) (header-size) (version) (sample-period) (zero)
+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.
+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
+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;
+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/&/&amp;/g;
+$text =~ s/</&lt;/g;
+$text =~ s/>/&gt;/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.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
+}
+# 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");
+} else {
+push(@result, "$func $fileline");
+}
+} elsif ($main::opt_functions) {
+if ($func eq '??') {
+push(@result, "$a");
+} else {
+push(@result, $func);
+}
+} 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_bytes) {
+return "B";
+} else {
+return "MB";
+}
+}
+} elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {
+return "seconds";
+} else {
+return "samples";
+}
+}
+##### Profile manipulation code #####
+# Generate flattened profile:
+# If count is charged to stack [a,b,c,d], in generated profile,
+# it will be charged to [a]
+sub FlatProfile {
+my $profile = shift;
+my $result = {};
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+if ($#addrs >= 0) {
+AddEntry($result, $addrs[0], $count);
+}
+}
+return $result;
+}
+# Generate cumulative profile:
+# If count is charged to stack [a,b,c,d], in generated profile,
+# it will be charged to [a], [b], [c], [d]
+sub CumulativeProfile {
+my $profile = shift;
+my $result = {};
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+foreach my $a (@addrs) {
+AddEntry($result, $a, $count);
+}
+}
+return $result;
+}
+# If the second-youngest PC on the stack is always the same, returns
+# that pc.  Otherwise, returns undef.
+sub IsSecondPcAlwaysTheSame {
+my $profile = shift;
+my $second_pc = undef;
+foreach my $k (keys(%{$profile})) {
+my @addrs = split(/\n/, $k);
+if ($#addrs < 1) {
+return undef;
+}
+if (not defined $second_pc) {
+$second_pc = $addrs[1];
+} else {
+if ($second_pc ne $addrs[1]) {
+return undef;
+}
+}
+}
+return $second_pc;
+}
+sub ExtractSymbolLocation {
+my $symbols = shift;
+my $address = shift;
+# 'addr2line' outputs "??:0" for unknown locations; we do the
+# same to be consistent.
+my $location = "??:0:unknown";
+if (exists $symbols->{$address}) {
+my $file = $symbols->{$address}->[1];
+if ($file eq "?") {
+$file = "??:0"
+}
+$location = $file . ":" . $symbols->{$address}->[0];
+}
+return $location;
+}
+# Extracts a graph of calls.
+sub ExtractCalls {
+my $symbols = shift;
+my $profile = shift;
+my $calls = {};
+while( my ($stack_trace, $count) = each %$profile ) {
+my @address = split(/\n/, $stack_trace);
+my $destination = ExtractSymbolLocation($symbols, $address[0]);
+AddEntry($calls, $destination, $count);
+for (my $i = 1; $i <= $#address; $i++) {
+my $source = ExtractSymbolLocation($symbols, $address[$i]);
+my $call = "$source -> $destination";
+AddEntry($calls, $call, $count);
+$destination = $source;
+}
+}
+return $calls;
+}
+sub RemoveUninterestingFrames {
+my $symbols = shift;
+my $profile = shift;
+# List of function names to skip
+my %skip = ();
+my $skip_regexp = 'NOMATCH';
+if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
+foreach my $name ('calloc',
+'cfree',
+'malloc',
+'free',
+'memalign',
+'posix_memalign',
+'pvalloc',
+'valloc',
+'realloc',
+'tc_calloc',
+'tc_cfree',
+'tc_malloc',
+'tc_free',
+'tc_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',
+'::do_malloc',   # new name -- got moved to an unnamed ns
+'::do_malloc_or_cpp_alloc',
+'DoSampledAllocation',
+'simple_alloc::allocate',
+'__malloc_alloc_template::allocate',
+'__builtin_delete',
+'__builtin_new',
+'__builtin_vec_delete',
+'__builtin_vec_new',
+'operator new',
+'operator new[]',
+# The entry to our memory-allocation routines on OS X
+'malloc_zone_malloc',
+'malloc_zone_calloc',
+'malloc_zone_valloc',
+'malloc_zone_realloc',
+'malloc_zone_memalign',
+'malloc_zone_free',
+# 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
+}
+# TODO: Remove TCMalloc once everything has been
+# moved into the tcmalloc:: namespace and we have flushed
+# old code out of the system.
+$skip_regexp = "TCMalloc|^tcmalloc::";
+} elsif ($main::profile_type eq 'contention') {
+foreach my $vname ('base::RecordLockProfileData',
+'base::SubmitMutexProfileData',
+'base::SubmitSpinLockProfileData',
+'Mutex::Unlock',
+'Mutex::UnlockSlow',
+'Mutex::ReaderUnlock',
+'MutexLock::~MutexLock',
+'SpinLock::Unlock',
+'SpinLock::SlowUnlock',
+'SpinLockHolder::~SpinLockHolder') {
+$skip{$vname} = 1;
+}
+} elsif ($main::profile_type eq 'cpu') {
+# Drop signal handlers used for CPU profile collection
+# 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',
+'__FRAME_END__',
+'__pthread_sighandler',
+'__restore') {
+$skip{$name} = 1;
+}
+} else {
+# Nothing skipped for unknown types
+}
+if ($main::profile_type eq 'cpu') {
+# If all the second-youngest program counters are the same,
+# this STRONGLY suggests that it is an artifact of measurement,
+# i.e., stack frames pushed by the CPU profiler signal handler.
+# Hence, we delete them.
+# (The topmost PC is read from the signal structure, not from
+# the stack, so it does not get involved.)
+while (my $second_pc = IsSecondPcAlwaysTheSame($profile)) {
+my $result = {};
+my $func = '';
+if (exists($symbols->{$second_pc})) {
+$second_pc = $symbols->{$second_pc}->[0];
+}
+print STDERR "Removing $second_pc from all stack traces.\n";
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+splice @addrs, 1, 1;
+my $reduced_path = join("\n", @addrs);
+AddEntry($result, $reduced_path, $count);
+}
+$profile = $result;
+}
+}
+my $result = {};
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+my @path = ();
+foreach my $a (@addrs) {
+if (exists($symbols->{$a})) {
+my $func = $symbols->{$a}->[0];
+if ($skip{$func} || ($func =~ m/$skip_regexp/)) {
+next;
+}
+}
+push(@path, $a);
+}
+my $reduced_path = join("\n", @path);
+AddEntry($result, $reduced_path, $count);
+}
+return $result;
+}
+# Reduce profile to granularity given by user
+sub ReduceProfile {
+my $symbols = shift;
+my $profile = shift;
+my $result = {};
+my $fullname_to_shortname_map = {};
+FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k);
+my @path = ();
+my %seen = ();
+$seen{''} = 1;      # So that empty keys are skipped
+foreach my $e (@translated) {
+# 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);
+}
+}
+my $reduced_path = join("\n", @path);
+AddEntry($result, $reduced_path, $count);
+}
+return $result;
+}
+# Does the specified symbol array match the regexp?
+sub SymbolMatches {
+my $sym = shift;
+my $re = shift;
+if (defined($sym)) {
+for (my $i = 0; $i < $#{$sym}; $i += 3) {
+if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) {
+return 1;
+}
+}
+}
+return 0;
+}
+# Focus only on paths involving specified regexps
+sub FocusProfile {
+my $symbols = shift;
+my $profile = shift;
+my $focus = shift;
+my $result = {};
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+foreach my $a (@addrs) {
+# Reply if it matches either the address/shortname/fileline
+if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) {
+AddEntry($result, $k, $count);
+last;
+}
+}
+}
+return $result;
+}
+# Focus only on paths not involving specified regexps
+sub IgnoreProfile {
+my $symbols = shift;
+my $profile = shift;
+my $ignore = shift;
+my $result = {};
+foreach my $k (keys(%{$profile})) {
+my $count = $profile->{$k};
+my @addrs = split(/\n/, $k);
+my $matched = 0;
+foreach my $a (@addrs) {
+# Reply if it matches either the address/shortname/fileline
+if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) {
+$matched = 1;
+last;
+}
+}
+if (!$matched) {
+AddEntry($result, $k, $count);
+}
+}
+return $result;
+}
+# Get total count in profile
+sub TotalProfile {
+my $profile = shift;
+my $result = 0;
+foreach my $k (keys(%{$profile})) {
+$result += $profile->{$k};
+}
+return $result;
+}
+# Add A to B
+sub AddProfile {
+my $A = shift;
+my $B = shift;
+my $R = {};
+# add all keys in A
+foreach my $k (keys(%{$A})) {
+my $v = $A->{$k};
+AddEntry($R, $k, $v);
+}
+# add all keys in B
+foreach my $k (keys(%{$B})) {
+my $v = $B->{$k};
+AddEntry($R, $k, $v);
+}
+return $R;
+}
+# Merges symbol maps
+sub MergeSymbols {
+my $A = shift;
+my $B = shift;
+my $R = {};
+foreach my $k (keys(%{$A})) {
+$R->{$k} = $A->{$k};
+}
+if (defined($B)) {
+foreach my $k (keys(%{$B})) {
+$R->{$k} = $B->{$k};
+}
+}
+return $R;
+}
+# Add A to B
+sub AddPcs {
+my $A = shift;
+my $B = shift;
+my $R = {};
+# add all keys in A
+foreach my $k (keys(%{$A})) {
+$R->{$k} = 1
+}
+# add all keys in B
+foreach my $k (keys(%{$B})) {
+$R->{$k} = 1
+}
+return $R;
+}
+# Subtract B from A
+sub SubtractProfile {
+my $A = shift;
+my $B = shift;
+my $R = {};
+foreach my $k (keys(%{$A})) {
+my $v = $A->{$k} - GetEntry($B, $k);
+if ($v < 0 && $main::opt_drop_negative) {
+$v = 0;
+}
+AddEntry($R, $k, $v);
+}
+if (!$main::opt_drop_negative) {
+# Take care of when subtracted profile has more entries
+foreach my $k (keys(%{$B})) {
+if (!exists($A->{$k})) {
+AddEntry($R, $k, 0 - $B->{$k});
+}
+}
+}
+return $R;
+}
+# Get entry from profile; zero if not present
+sub GetEntry {
+my $profile = shift;
+my $k = shift;
+if (exists($profile->{$k})) {
+return $profile->{$k};
+} else {
+return 0;
+}
+}
+# Add entry to specified profile
+sub AddEntry {
+my $profile = shift;
+my $k = shift;
+my $n = shift;
+if (!exists($profile->{$k})) {
+$profile->{$k} = 0;
+}
+$profile->{$k} += $n;
+}
+# Add a stack of entries to specified profile, and add them to the $pcs
+# list.
+sub AddEntries {
+my $profile = shift;
+my $pcs = shift;
+my $stack = shift;
+my $count = shift;
+my @k = ();
+foreach my $e (split(/\s+/, $stack)) {
+my $pc = HexExtend($e);
+$pcs->{$pc} = 1;
+push @k, $pc;
+}
+AddEntry($profile, (join "\n", @k), $count);
+}
+##### Code to profile a server dynamically #####
+sub CheckSymbolPage {
+my $url = SymbolPageURL();
+my $command = ShellEscape(@URL_FETCHER, $url);
+open(SYMBOL, "$command |") or error($command);
+my $line = <SYMBOL>;
+$line =~ s/\r//g;         # turn windows-looking lines into unix-looking lines
+close(SYMBOL);
+unless (defined($line)) {
+error("$url doesn't exist\n");
+}
+if ($line =~ /^num_symbols:\s+(\d+)$/) {
+if ($1 == 0) {
+error("Stripped binary. No symbols available.\n");
+}
+} else {
+error("Failed to get the number of symbols from $url\n");
+}
+}
+sub IsProfileURL {
+my $profile_name = shift;
+if (-f $profile_name) {
+printf STDERR "Using local file $profile_name.\n";
+return 0;
+}
+return 1;
+}
+sub ParseProfileURL {
+my $profile_name = shift;
+if (!defined($profile_name) || $profile_name eq "") {
+return ();
+}
+# Split profile URL - matches all non-empty strings, so no test.
+$profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,;
+my $proto = $1 || "http://";
+my $hostport = $2;
+my $prefix = $3;
+my $profile = $4 || "/";
+my $host = $hostport;
+$host =~ s/:.*//;
+my $baseurl = "$proto$hostport$prefix";
+return ($host, $baseurl, $profile);
+}
+# We fetch symbols from the first profile argument.
+sub SymbolPageURL {
+my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
+return "$baseURL$SYMBOL_PAGE";
+}
+sub FetchProgramName() {
+my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
+my $url = "$baseURL$PROGRAM_NAME_PAGE";
+my $command_line = ShellEscape(@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
+close(CMDLINE);
+error("Failed to get program name from $url\n") unless defined($cmdline);
+$cmdline =~ s/\x00.+//;  # Remove argv[1] and latters.
+$cmdline =~ s!\n!!g;  # Remove LFs.
+return $cmdline;
+}
+# Gee, curl's -L (--location) option isn't reliable at least
+# with its 7.12.3 version.  Curl will forget to post data if
+# there is a redirection.  This function is a workaround for
+# curl.  Redirection happens on borg hosts.
+sub ResolveRedirectionForCurl {
+my $url = shift;
+my $command_line = ShellEscape(@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
+if (/^Location: (.*)/) {
+$url = $1;
+}
+}
+close(CMDLINE);
+return $url;
+}
+# Add a timeout flat to URL_FETCHER.  Returns a new list.
+sub AddFetchTimeout {
+my $timeout = shift;
+my @fetcher = shift;
+if (defined($timeout)) {
+if (join(" ", @fetcher) =~ m/\bcurl -s/) {
+push(@fetcher, "--max-time", sprintf("%d", $timeout));
+} elsif (join(" ", @fetcher) =~ m/\brpcget\b/) {
+push(@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
+# $main::prog to have the correct program name.
+sub ReadSymbols {
+my $in = shift;
+my $map = {};
+while (<$in>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+# Removes all the leading zeroes from the symbols, see comment below.
+if (m/^0x0*([0-9a-f]+)\s+(.+)/) {
+$map->{$1} = $2;
+} elsif (m/^---/) {
+last;
+} elsif (m/^([a-z][^=]*)=(.*)$/ ) {
+my ($variable, $value) = ($1, $2);
+for ($variable, $value) {
+s/^\s+//;
+s/\s+$//;
+}
+if ($variable eq "binary") {
+if ($main::prog ne $UNKNOWN_BINARY && $main::prog ne $value) {
+printf STDERR ("Warning: Mismatched binary name '%s', using '%s'.\n",
+$main::prog, $value);
+}
+$main::prog = $value;
+} else {
+printf STDERR ("Ignoring unknown variable in symbols list: " .
+"'%s' = '%s'\n", $variable, $value);
+}
+}
+}
+return $map;
+}
+# Fetches and processes symbols to prepare them for use in the profile output
+# code.  If the optional 'symbol_map' arg is not given, fetches symbols from
+# $SYMBOL_PAGE for all PC values found in profile.  Otherwise, the raw symbols
+# are assumed to have already been fetched into 'symbol_map' and are simply
+# extracted and processed.
+sub FetchSymbols {
+my $pcset = shift;
+my $symbol_map = shift;
+my %seen = ();
+my @pcs = grep { !$seen{$_}++ } keys(%$pcset);  # uniq
+if (!defined($symbol_map)) {
+my $post_data = join("+", sort((map {"0x" . "$_"} @pcs)));
+open(POSTFILE, ">$main::tmpfile_sym");
+print POSTFILE $post_data;
+close(POSTFILE);
+my $url = SymbolPageURL();
+my $command_line;
+if (join(" ", @URL_FETCHER) =~ m/\bcurl -s/) {
+$url = ResolveRedirectionForCurl($url);
+$command_line = ShellEscape(@URL_FETCHER, "-d", "\@$main::tmpfile_sym",
+$url);
+} else {
+$command_line = (ShellEscape(@URL_FETCHER, "--post", $url)
+. " < " . ShellEscape($main::tmpfile_sym));
+}
+# We use c++filt in case $SYMBOL_PAGE gives us mangled symbols.
+my $escaped_cppfilt = ShellEscape($obj_tool_map{"c++filt"});
+open(SYMBOL, "$command_line | $escaped_cppfilt |") or error($command_line);
+$symbol_map = ReadSymbols(*SYMBOL{IO});
+close(SYMBOL);
+}
+my $symbols = {};
+foreach my $pc (@pcs) {
+my $fullname;
+# For 64 bits binaries, symbols are extracted with 8 leading zeroes.
+# Then /symbol reads the long symbols in as uint64, and outputs
+# the result with a "0x%08llx" format which get rid of the zeroes.
+# By removing all the leading zeroes in both $pc and the symbols from
+# /symbol, the symbols match and are retrievable from the map.
+my $shortpc = $pc;
+$shortpc =~ s/^0*//;
+# Each line may have a list of names, which includes the function
+# and also other functions it has inlined.  They are separated (in
+# PrintSymbolizedProfile), by --, which is illegal in function names.
+my $fullnames;
+if (defined($symbol_map->{$shortpc})) {
+$fullnames = $symbol_map->{$shortpc};
+} else {
+$fullnames = "0x" . $pc;  # Just use addresses
+}
+my $sym = [];
+$symbols->{$pc} = $sym;
+foreach my $fullname (split("--", $fullnames)) {
+my $name = ShortFunctionName($fullname);
+push(@{$sym}, $name, "?", $fullname);
+}
+}
+return $symbols;
+}
+sub BaseName {
+my $file_name = shift;
+$file_name =~ s!^.*/!!;  # Remove directory name
+return $file_name;
+}
+sub MakeProfileBaseName {
+my ($binary_name, $profile_name) = @_;
+my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
+my $binary_shortname = BaseName($binary_name);
+return sprintf("%s.%s.%s",
+$binary_shortname, $main::op_time, $host);
+}
+sub FetchDynamicProfile {
+my $binary_name = shift;
+my $profile_name = shift;
+my $fetch_name_only = shift;
+my $encourage_patience = shift;
+if (!IsProfileURL($profile_name)) {
+return $profile_name;
+} else {
+my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
+if ($path eq "" || $path eq "/") {
+# Missing type specifier defaults to cpu-profile
+$path = $PROFILE_PAGE;
+}
+my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
+my $url = "$baseURL$path";
+my $fetch_timeout = undef;
+if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) {
+if ($path =~ m/[?]/) {
+$url .= "&";
+} else {
+$url .= "?";
+}
+$url .= sprintf("seconds=%d", $main::opt_seconds);
+$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;
+}
+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");
+}
+my $tmp_profile = "$profile_dir/.tmp.$profile_file";
+my $real_profile = "$profile_dir/$profile_file";
+if ($fetch_name_only > 0) {
+return $real_profile;
+}
+my @fetcher = AddFetchTimeout($fetch_timeout, @URL_FETCHER);
+my $cmd = ShellEscape(@fetcher, $url) . " > " . ShellEscape($tmp_profile);
+if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){
+print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n  ${real_profile}\n";
+if ($encourage_patience) {
+print STDERR "Be patient...\n";
+}
+} else {
+print STDERR "Fetching $path profile from $url to\n  ${real_profile}\n";
+}
+(system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
+(system("mv", $tmp_profile, $real_profile) == 0) || error("Unable to rename profile\n");
+print STDERR "Wrote profile to $real_profile\n";
+$main::collected_profile = $real_profile;
+return $main::collected_profile;
+}
+}
+# Collect profiles in parallel
+sub FetchDynamicProfiles {
+my $items = scalar(@main::pfile_args);
+my $levels = log($items) / log(2);
+if ($items == 1) {
+$main::profile_files[0] = FetchDynamicProfile($main::prog, $main::pfile_args[0], 0, 1);
+} else {
+# math rounding issues
+if ((2 ** $levels) < $items) {
+$levels++;
+}
+my $count = scalar(@main::pfile_args);
+for (my $i = 0; $i < $count; $i++) {
+$main::profile_files[$i] = FetchDynamicProfile($main::prog, $main::pfile_args[$i], 1, 0);
+}
+print STDERR "Fetching $count profiles, Be patient...\n";
+FetchDynamicProfilesRecurse($levels, 0, 0);
+$main::collected_profile = join(" \\\n    ", @main::profile_files);
+}
+}
+# Recursively fork a process to get enough processes
+# collecting profiles
+sub FetchDynamicProfilesRecurse {
+my $maxlevel = shift;
+my $level = shift;
+my $position = shift;
+if (my $pid = fork()) {
+$position = 0 | ($position << 1);
+TryCollectProfile($maxlevel, $level, $position);
+wait;
+} else {
+$position = 1 | ($position << 1);
+TryCollectProfile($maxlevel, $level, $position);
+cleanup();
+exit(0);
+}
+}
+# Collect a single profile
+sub TryCollectProfile {
+my $maxlevel = shift;
+my $level = shift;
+my $position = shift;
+if ($level >= ($maxlevel - 1)) {
+if ($position < scalar(@main::pfile_args)) {
+FetchDynamicProfile($main::prog, $main::pfile_args[$position], 0, 0);
+}
+} else {
+FetchDynamicProfilesRecurse($maxlevel, $level+1, $position);
+}
+}
+##### Parsing code #####
+# Provide a small streaming-read module to handle very large
+# cpu-profile files.  Stream in chunks along a sliding window.
+# Provides an interface to get one 'slot', correctly handling
+# endian-ness differences.  A slot is one 32-bit or 64-bit word
+# (depending on the input profile).  We tell endianness and bit-size
+# for the profile by looking at the first 8 bytes: in cpu profiles,
+# the second slot is always 3 (we'll accept anything that's not 0).
+BEGIN {
+package CpuProfileStream;
+sub new {
+my ($class, $file, $fname) = @_;
+my $self = { file        => $file,
+base        => 0,
+stride      => 512 * 1024,   # must be a multiple of bitsize/8
+slots       => [],
+unpack_code => "",           # N for big-endian, V for little
+perl_is_64bit => 1,          # matters if profile is 64-bit
+};
+bless $self, $class;
+# Let unittests adjust the stride
+if ($main::opt_test_stride > 0) {
+$self->{stride} = $main::opt_test_stride;
+}
+# Read the first two slots to figure out bitsize and endianness.
+my $slots = $self->{slots};
+my $str;
+read($self->{file}, $str, 8);
+# Set the global $address_length based on what we see here.
+# 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars).
+$address_length = ($str eq (chr(0)x8)) ? 16 : 8;
+if ($address_length == 8) {
+if (substr($str, 6, 2) eq chr(0)x2) {
+$self->{unpack_code} = 'V';  # Little-endian.
+} elsif (substr($str, 4, 2) eq chr(0)x2) {
+$self->{unpack_code} = 'N';  # Big-endian
+} else {
+::error("$fname: header size >= 2**16\n");
+}
+@$slots = unpack($self->{unpack_code} . "*", $str);
+} else {
+# If we're a 64-bit profile, check if 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 wrong.  We won't complain yet, but will
+# later if we ever see a value that doesn't fit in 32 bits.
+my $has_q = 0;
+eval { $has_q = pack("Q", "1") ? 1 : 1; };
+if (!$has_q) {
+$self->{perl_is_64bit} = 0;
+}
+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;
+}
+# Load more data when we access slots->get(X) which is not yet in memory.
+sub overflow {
+my ($self) = @_;
+my $slots = $self->{slots};
+$self->{base} += $#$slots + 1;   # skip over data we're replacing
+my $str;
+read($self->{file}, $str, $self->{stride});
+if ($address_length == 8) {      # the 32-bit case
+# This is the easy case: unpack provides 32-bit unpacking primitives.
+@$slots = unpack($self->{unpack_code} . "*", $str);
+} else {
+# We need to unpack 32 bits at a time and combine.
+my @b32_values = unpack($self->{unpack_code} . "*", $str);
+my @b64_values = ();
+for (my $i = 0; $i < $#b32_values; $i += 2) {
+# TODO(csilvers): if this is a 32-bit perl, the math below
+#    could end up in a too-large int, which perl will promote
+#    to a double, losing necessary precision.  Deal with that.
+#    Right now, we just die.
+my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]);
+if ($self->{unpack_code} eq 'N') {    # big-endian
+($lo, $hi) = ($hi, $lo);
+}
+my $value = $lo + $hi * (2**32);
+if (!$self->{perl_is_64bit} &&   # check value is exactly represented
+(($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) {
+::error("Need a 64-bit perl to process this 64-bit profile.\n");
+}
+push(@b64_values, $value);
+}
+@$slots = @b64_values;
+}
+}
+# Access the i-th long in the file (logically), or -1 at EOF.
+sub get {
+my ($self, $idx) = @_;
+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
+} elsif ($idx > $self->{base} + $#$slots) {
+$self->overflow();
+} else {
+return $slots->[$idx - $self->{base}];
+}
+}
+# If we get here, $slots is [], which means we've reached EOF
+return -1;  # unique since slots is supposed to hold unsigned numbers
+}
+}
+# Reads the top, 'header' section of a profile, and returns the last
+# line of the header, commonly called a 'header line'.  The header
+# section of a profile consists of zero or more 'command' lines that
+# are instructions to pprof, which pprof executes when reading the
+# header.  All 'command' lines start with a %.  After the command
+# lines is the 'header line', which is a profile-specific line that
+# indicates what type of profile it is, and perhaps other global
+# information about the profile.  For instance, here's a header line
+# for a heap profile:
+#   heap profile:     53:    38236 [  5525:  1284029] @ heapprofile
+# For historical reasons, the CPU profile does not contain a text-
+# readable header line.  If the profile looks like a CPU profile,
+# this function returns "".  If no header line could be found, this
+# function returns undef.
+#
+# The following commands are recognized:
+#   %warn -- emit the rest of this line to stderr, prefixed by 'WARNING:'
+#
+# The input file should be in binmode.
+sub ReadProfileHeader {
+local *PROFILE = shift;
+my $firstchar = "";
+my $line = "";
+read(PROFILE, $firstchar, 1);
+seek(PROFILE, -1, 1);                    # unread the firstchar
+if ($firstchar !~ /[[:print:]]/) {       # is not a text character
+return "";
+}
+while (defined($line = <PROFILE>)) {
+$line =~ s/\r//g;   # turn windows-looking lines into unix-looking lines
+if ($line =~ /^%warn\s+(.*)/) {        # 'warn' command
+# Note this matches both '%warn blah\n' and '%warn\n'.
+print STDERR "WARNING: $1\n";        # print the rest of the line
+} elsif ($line =~ /^%/) {
+print STDERR "Ignoring unknown command from profile header: $line";
+} else {
+# End of commands, must be the header line.
+return $line;
+}
+}
+return undef;     # got to EOF without seeing a header 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 = ReadProfileHeader(*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
+#      $result->{period}      Sampling period (in microseconds)
+#      $result->{profile}     Profile object
+#      $result->{map}         Memory map info from profile
+#      $result->{pcs}         Hash of all PC values seen, key is hex address
+sub ReadProfile {
+my $prog = shift;
+my $fname = shift;
+my $result;            # return value
+$CONTENTION_PAGE =~ m,[^/]+$,;    # matches everything after the last slash
+my $contention_marker = $&;
+$GROWTH_PAGE  =~ m,[^/]+$,;    # matches everything after the last slash
+my $growth_marker = $&;
+$SYMBOL_PAGE =~ m,[^/]+$,;    # matches everything after the last slash
+my $symbol_marker = $&;
+$PROFILE_PAGE =~ m,[^/]+$,;    # matches everything after the last slash
+my $profile_marker = $&;
+# Look at first line to see if it is a heap or a CPU profile.
+# CPU profile may start with no header at all, and just binary data
+# (starting with \0\0\0\0) -- in that case, don't try to read the
+# whole firstline, since it may be gigabytes(!) of data.
+open(PROFILE, "<$fname") || error("$fname: $!\n");
+binmode PROFILE;      # New perls do UTF-8 processing
+my $header = ReadProfileHeader(*PROFILE);
+if (!defined($header)) {   # means "at EOF"
+error("Profile is empty.\n");
+}
+my $symbols;
+if ($header =~ m/^--- *$symbol_marker/o) {
+# Verify that the user asked for a symbolized profile
+if (!$main::use_symbolized_profile) {
+# we have both a binary and symbolized profiles, abort
+error("FATAL ERROR: Symbolized profile\n   $fname\ncannot be used with " .
+"a binary arg. Try again without passing\n   $prog\n");
+}
+# 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 = ReadProfileHeader(*PROFILE) || "";
+}
+$main::profile_type = '';
+if ($header =~ m/^heap profile:.*$growth_marker/o) {
+$main::profile_type = 'growth';
+$result =  ReadHeapProfile($prog, *PROFILE, $header);
+} elsif ($header =~ m/^heap profile:/) {
+$main::profile_type = 'heap';
+$result =  ReadHeapProfile($prog, *PROFILE, $header);
+} elsif ($header =~ m/^--- *$contention_marker/o) {
+$main::profile_type = 'contention';
+$result = ReadSynchProfile($prog, *PROFILE);
+} elsif ($header =~ m/^--- *Stacks:/) {
+print STDERR
+"Old format contention profile: mistakenly reports " .
+"condition variable signals as lock contentions.\n";
+$main::profile_type = 'contention';
+$result = ReadSynchProfile($prog, *PROFILE);
+} elsif ($header =~ m/^--- *$profile_marker/) {
+# the binary cpu profile data starts immediately after this line
+$main::profile_type = 'cpu';
+$result = ReadCPUProfile($prog, $fname, *PROFILE);
+} else {
+if (defined($symbols)) {
+# a symbolized profile contains a format we don't recognize, bail out
+error("$fname: Cannot recognize profile section after symbols.\n");
+}
+# no ascii header present -- must be a CPU profile
+$main::profile_type = 'cpu';
+$result = ReadCPUProfile($prog, $fname, *PROFILE);
+}
+close(PROFILE);
+# if we got symbols along with the profile, return those as well
+if (defined($symbols)) {
+$result->{symbols} = $symbols;
+}
+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;
+my $fname = shift;       # just used for logging
+local *PROFILE = shift;
+my $version;
+my $period;
+my $i;
+my $profile = {};
+my $pcs = {};
+# Parse string into array of slots.
+my $slots = CpuProfileStream->new(*PROFILE, $fname);
+# Read header.  The current header version is a 5-element structure
+# containing:
+#   0: header count (always 0)
+#   1: header "words" (after this one: 3)
+#   2: format version (0)
+#   3: sampling period (usec)
+#   4: unused padding (always 0)
+if ($slots->get(0) != 0 ) {
+error("$fname: not a profile file, or old format profile file\n");
+}
+$i = 2 + $slots->get(1);
+$version = $slots->get(2);
+$period = $slots->get(3);
+# Do some sanity checking on these header values.
+if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) {
+error("$fname: not a profile file, or corrupted profile file\n");
+}
+# Parse profile
+while ($slots->get($i) != -1) {
+my $n = $slots->get($i++);
+my $d = $slots->get($i++);
+if ($d > (2**16)) {  # TODO(csilvers): what's a reasonable max-stack-depth?
+my $addr = sprintf("0%o", $i * ($address_length == 8 ? 4 : 8));
+print STDERR "At index $i (address $addr):\n";
+error("$fname: stack trace depth >= 2**32\n");
+}
+if ($slots->get($i) == 0) {
+# End of profile data marker
+$i += $d;
+last;
+}
+# Make key out of the stack entries
+my @k = ();
+for (my $j = 0; $j < $d; $j++) {
+my $pc = $slots->get($i+$j);
+# Subtract one from caller pc so we map back to call instr.
+# However, don't do this if we're reading a symbolized profile
+# file, in which case the subtract-one was done when the file
+# was written.
+if ($j > 0 && !$main::use_symbolized_profile) {
+$pc--;
+}
+$pc = sprintf("%0*x", $address_length, $pc);
+$pcs->{$pc} = 1;
+push @k, $pc;
+}
+AddEntry($profile, (join "\n", @k), $n);
+$i += $d;
+}
+# Parse map
+my $map = '';
+seek(PROFILE, $i * 4, 0);
+read(PROFILE, $map, (stat PROFILE)[7]);
+my $r = {};
+$r->{version} = $version;
+$r->{period} = $period;
+$r->{profile} = $profile;
+$r->{libs} = ParseLibraries($prog, $map, $pcs);
+$r->{pcs} = $pcs;
+return $r;
+}
+sub ReadHeapProfile {
+my $prog = shift;
+local *PROFILE = shift;
+my $header = shift;
+my $index = 1;
+if ($main::opt_inuse_space) {
+$index = 1;
+} elsif ($main::opt_inuse_objects) {
+$index = 0;
+} elsif ($main::opt_alloc_space) {
+$index = 3;
+} elsif ($main::opt_alloc_objects) {
+$index = 2;
+}
+# Find the type of this profile.  The header line looks like:
+#    heap profile:   1246:  8800744 [  1246:  8800744] @ <heap-url>/266053
+# There are two pairs <count: size>, the first inuse objects/space, and the
+# second allocated objects/space.  This is followed optionally by a profile
+# type, and if that is present, optionally by a sampling frequency.
+# For remote heap profiles (v1):
+# The interpretation of the sampling frequency is that the profiler, for
+# each sample, calculates a uniformly distributed random integer less than
+# the given value, and records the next sample after that many bytes have
+# been allocated.  Therefore, the expected sample interval is half of the
+# given frequency.  By default, if not specified, the expected sample
+# interval is 128KB.  Only remote-heap-page profiles are adjusted for
+# sample size.
+# For remote heap profiles (v2):
+# The sampling frequency is the rate of a Poisson process. This means that
+# the probability of sampling an allocation of size X with sampling rate Y
+# is 1 - exp(-X/Y)
+# For version 2, a typical header line might look like this:
+# heap profile:   1922: 127792360 [  1922: 127792360] @ <heap-url>_v2/524288
+# the trailing number (524288) is the sampling rate. (Version 1 showed
+# double the 'rate' here)
+my $sampling_algorithm = 0;
+my $sample_adjustment = 0;
+chomp($header);
+my $type = "unknown";
+if ($header =~ m"^heap profile:\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\](\s*@\s*([^/]*)(/(\d+))?)?") {
+if (defined($6) && ($6 ne '')) {
+$type = $6;
+my $sample_period = $8;
+# $type is "heapprofile" for profiles generated by the
+# heap-profiler, and either "heap" or "heap_v2" for profiles
+# generated by sampling directly within tcmalloc.  It can also
+# be "growth" for heap-growth profiles.  The first is typically
+# 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;
+} elsif ($type =~ /_v2/) {
+$sampling_algorithm = 2;     # version 2 sampling
+if (defined($sample_period) && ($sample_period ne '')) {
+$sample_adjustment = int($sample_period);
+}
+} else {
+$sampling_algorithm = 1;     # version 1 sampling
+if (defined($sample_period) && ($sample_period ne '')) {
+$sample_adjustment = int($sample_period)/2;
+}
+}
+} else {
+# We detect whether or not this is a remote-heap profile by checking
+# that the total-allocated stats ($n2,$s2) are exactly the
+# same as the in-use stats ($n1,$s1).  It is remotely conceivable
+# that a non-remote-heap profile may pass this check, but it is hard
+# to imagine how that could happen.
+# In this case it's so old it's guaranteed to be remote-heap version 1.
+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;
+}
+}
+}
+if ($sampling_algorithm > 0) {
+# For remote-heap generated profiles, adjust the counts and sizes to
+# account for the sample rate (we sample once every 128KB by default).
+if ($sample_adjustment == 0) {
+# Turn on profile adjustment.
+$sample_adjustment = 128*1024;
+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);
+}
+if ($sampling_algorithm > 1) {
+# We don't bother printing anything for the original version (version 1)
+printf STDERR "Heap version $sampling_algorithm\n";
+}
+}
+my $profile = {};
+my $pcs = {};
+my $map = "";
+while (<PROFILE>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+if (/^MAPPED_LIBRARIES:/) {
+# Read the /proc/self/maps data
+while (<PROFILE>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+$map .= $_;
+}
+last;
+}
+if (/^--- Memory map:/) {
+# Read /proc/self/maps data as formatted by DumpAddressMap()
+my $buildvar = "";
+while (<PROFILE>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+# Parse "build=<dir>" specification if supplied
+if (m/^\s*build=(.*)\n/) {
+$buildvar = $1;
+}
+# Expand "$build" variable if available
+$_ =~ s/\$build\b/$buildvar/g;
+$map .= $_;
+}
+last;
+}
+# Read entry of the form:
+#  <count1>: <bytes1> [<count2>: <bytes2>] @ a1 a2 a3 ... an
+s/^\s*//;
+s/\s*$//;
+if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) {
+my $stack = $5;
+my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
+if ($sample_adjustment) {
+if ($sampling_algorithm == 2) {
+# Remote-heap version 2
+# The sampling frequency is the rate of a Poisson process.
+# This means that the probability of sampling an allocation of
+# size X with sampling rate Y is 1 - exp(-X/Y)
+if ($n1 != 0) {
+my $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
+my $scale_factor = 1/(1 - exp(-$ratio));
+$n1 *= $scale_factor;
+$s1 *= $scale_factor;
+}
+if ($n2 != 0) {
+my $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
+my $scale_factor = 1/(1 - exp(-$ratio));
+$n2 *= $scale_factor;
+$s2 *= $scale_factor;
+}
+} else {
+# Remote-heap version 1
+my $ratio;
+$ratio = (($s1*1.0)/$n1)/($sample_adjustment);
+if ($ratio < 1) {
+$n1 /= $ratio;
+$s1 /= $ratio;
+}
+$ratio = (($s2*1.0)/$n2)/($sample_adjustment);
+if ($ratio < 1) {
+$n2 /= $ratio;
+$s2 /= $ratio;
+}
+}
+}
+my @counts = ($n1, $s1, $n2, $s2);
+AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
+}
+}
+my $r = {};
+$r->{version} = "heap";
+$r->{period} = 1;
+$r->{profile} = $profile;
+$r->{libs} = ParseLibraries($prog, $map, $pcs);
+$r->{pcs} = $pcs;
+return $r;
+}
+sub ReadSynchProfile {
+my $prog = shift;
+local *PROFILE = shift;
+my $header = shift;
+my $map = '';
+my $profile = {};
+my $pcs = {};
+my $sampling_period = 1;
+my $cyclespernanosec = 2.8;   # Default assumption for old binaries
+my $seen_clockrate = 0;
+my $line;
+my $index = 0;
+if ($main::opt_total_delay) {
+$index = 0;
+} elsif ($main::opt_contentions) {
+$index = 1;
+} elsif ($main::opt_mean_delay) {
+$index = 2;
+}
+while ( $line = <PROFILE> ) {
+$line =~ s/\r//g;      # turn windows-looking lines into unix-looking lines
+if ( $line =~ /^\s*(\d+)\s+(\d+) \@\s*(.*?)\s*$/ ) {
+my ($cycles, $count, $stack) = ($1, $2, $3);
+# Convert cycles to nanoseconds
+$cycles /= $cyclespernanosec;
+# Adjust for sampling done by application
+$cycles *= $sampling_period;
+$count *= $sampling_period;
+my @values = ($cycles, $count, $cycles / $count);
+AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]);
+} elsif ( $line =~ /^(slow release).*thread \d+  \@\s*(.*?)\s*$/ ||
+$line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) {
+my ($cycles, $stack) = ($1, $2);
+if ($cycles !~ /^\d+$/) {
+next;
+}
+# Convert cycles to nanoseconds
+$cycles /= $cyclespernanosec;
+# Adjust for sampling done by application
+$cycles *= $sampling_period;
+AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles);
+} elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) {
+my ($variable, $value) = ($1,$2);
+for ($variable, $value) {
+s/^\s+//;
+s/\s+$//;
+}
+if ($variable eq "cycles/second") {
+$cyclespernanosec = $value / 1e9;
+$seen_clockrate = 1;
+} elsif ($variable eq "sampling period") {
+$sampling_period = $value;
+} elsif ($variable eq "ms since reset") {
+# Currently nothing is done with this value in pprof
+# So we just silently ignore it for now
+} elsif ($variable eq "discarded samples") {
+# Currently nothing is done with this value in pprof
+# So we just silently ignore it for now
+} else {
+printf STDERR ("Ignoring unnknown variable in /contention output: " .
+"'%s' = '%s'\n",$variable,$value);
+}
+} else {
+# Memory map entry
+$map .= $line;
+}
+}
+if (!$seen_clockrate) {
+printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n",
+$cyclespernanosec);
+}
+my $r = {};
+$r->{version} = 0;
+$r->{period} = $sampling_period;
+$r->{profile} = $profile;
+$r->{libs} = ParseLibraries($prog, $map, $pcs);
+$r->{pcs} = $pcs;
+return $r;
+}
+# Given a hex value in the form "0x1abcd" or "1abcd", return either
+# "0001abcd" or "000000000001abcd", depending on the current (global)
+# address length.
+sub HexExtend {
+my $addr = shift;
+$addr =~ s/^(0x)?0*//;
+my $zeros_needed = $address_length - length($addr);
+if ($zeros_needed < 0) {
+printf STDERR "Warning: address $addr is longer than address length $address_length\n";
+return $addr;
+}
+return ("0" x $zeros_needed) . $addr;
+}
+##### Symbol extraction #####
+# Aggressively search the lib_prefix values for the given library
+# If all else fails, just return the name of the library unmodified.
+# If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so"
+# it will search the following locations in this order, until it finds a file:
+#   /my/path/lib/dir/mylib.so
+#   /other/path/lib/dir/mylib.so
+#   /my/path/dir/mylib.so
+#   /other/path/dir/mylib.so
+#   /my/path/mylib.so
+#   /other/path/mylib.so
+#   /lib/dir/mylib.so              (returned as last resort)
+sub FindLibrary {
+my $file = shift;
+my $suffix = $file;
+# Search for the library as described above
+do {
+foreach my $prefix (@prefix_list) {
+my $fullpath = $prefix . $suffix;
+if (-e $fullpath) {
+return $fullpath;
+}
+}
+} while ($suffix =~ s|^/[^/]+/|/|);
+return $file;
+}
+# Return path to library with debugging symbols.
+# For libc libraries, the copy in /usr/lib/debug contains debugging symbols
+sub DebuggingLibrary {
+my $file = shift;
+if ($file =~ m|^/| && -f "/usr/lib/debug$file") {
+return "/usr/lib/debug$file";
+}
+return undef;
+}
+# Parse text section header of a library using objdump
+sub ParseTextSectionHeaderFromObjdump {
+my $lib = shift;
+my $size = undef;
+my $vma;
+my $file_offset;
+# Get objdump output from the library file to figure out how to
+# map between mapped addresses and addresses in the library.
+my $cmd = ShellEscape($obj_tool_map{"objdump"}, "-h", $lib);
+open(OBJDUMP, "$cmd |") || error("$cmd: $!\n");
+while (<OBJDUMP>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+# Idx Name          Size      VMA       LMA       File off  Algn
+#  10 .text         00104b2c  420156f0  420156f0  000156f0  2**4
+# For 64-bit objects, VMA and LMA will be 16 hex digits, size and file
+# offset may still be 8.  But AddressSub below will still handle that.
+my @x = split;
+if (($#x >= 6) && ($x[1] eq '.text')) {
+$size = $x[2];
+$vma = $x[3];
+$file_offset = $x[5];
+last;
+}
+}
+close(OBJDUMP);
+if (!defined($size)) {
+return undef;
+}
+my $r = {};
+$r->{size} = $size;
+$r->{vma} = $vma;
+$r->{file_offset} = $file_offset;
+return $r;
+}
+# Parse text section header of a library using otool (on OS X)
+sub ParseTextSectionHeaderFromOtool {
+my $lib = shift;
+my $size = undef;
+my $vma = undef;
+my $file_offset = undef;
+# Get otool output from the library file to figure out how to
+# map between mapped addresses and addresses in the library.
+my $command = ShellEscape($obj_tool_map{"otool"}, "-l", $lib);
+open(OTOOL, "$command |") || error("$command: $!\n");
+my $cmd = "";
+my $sectname = "";
+my $segname = "";
+foreach my $line (<OTOOL>) {
+$line =~ s/\r//g;      # turn windows-looking lines into unix-looking lines
+# Load command <#>
+#       cmd LC_SEGMENT
+# [...]
+# Section
+#   sectname __text
+#    segname __TEXT
+#       addr 0x000009f8
+#       size 0x00018b9e
+#     offset 2552
+#      align 2^2 (4)
+# We will need to strip off the leading 0x from the hex addresses,
+# and convert the offset into hex.
+if ($line =~ /Load command/) {
+$cmd = "";
+$sectname = "";
+$segname = "";
+} elsif ($line =~ /Section/) {
+$sectname = "";
+$segname = "";
+} elsif ($line =~ /cmd (\w+)/) {
+$cmd = $1;
+} elsif ($line =~ /sectname (\w+)/) {
+$sectname = $1;
+} elsif ($line =~ /segname (\w+)/) {
+$segname = $1;
+} elsif (!(($cmd eq "LC_SEGMENT" || $cmd eq "LC_SEGMENT_64") &&
+$sectname eq "__text" &&
+$segname eq "__TEXT")) {
+next;
+} elsif ($line =~ /\baddr 0x([0-9a-fA-F]+)/) {
+$vma = $1;
+} elsif ($line =~ /\bsize 0x([0-9a-fA-F]+)/) {
+$size = $1;
+} elsif ($line =~ /\boffset ([0-9]+)/) {
+$file_offset = sprintf("%016x", $1);
+}
+if (defined($vma) && defined($size) && defined($file_offset)) {
+last;
+}
+}
+close(OTOOL);
+if (!defined($vma) || !defined($size) || !defined($file_offset)) {
+return undef;
+}
+my $r = {};
+$r->{size} = $size;
+$r->{vma} = $vma;
+$r->{file_offset} = $file_offset;
+return $r;
+}
+sub ParseTextSectionHeader {
+# obj_tool_map("otool") is only defined if we're in a Mach-O environment
+if (defined($obj_tool_map{"otool"})) {
+my $r = ParseTextSectionHeaderFromOtool(@_);
+if (defined($r)){
+return $r;
+}
+}
+# If otool doesn't work, or we don't have it, fall back to objdump
+return ParseTextSectionHeaderFromObjdump(@_);
+}
+# Split /proc/pid/maps dump into a list of libraries
+sub ParseLibraries {
+return if $main::use_symbol_page;  # We don't need libraries info.
+my $prog = shift;
+my $map = shift;
+my $pcs = shift;
+my $result = [];
+my $h = "[a-f0-9]+";
+my $zero_offset = HexExtend("0");
+my $buildvar = "";
+foreach my $l (split("\n", $map)) {
+if ($l =~ m/^\s*build=(.*)$/) {
+$buildvar = $1;
+}
+my $start;
+my $finish;
+my $offset;
+my $lib;
+if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+\.(so|dll|dylib|bundle)((\.\d+)+\w*(\.\d+){0,3})?)$/i) {
+# Full line from /proc/self/maps.  Example:
+#   40000000-40015000 r-xp 00000000 03:01 12845071   /lib/ld-2.3.2.so
+$start = HexExtend($1);
+$finish = HexExtend($2);
+$offset = HexExtend($3);
+$lib = $4;
+$lib =~ s|\\|/|g;     # turn windows-style paths into unix-style paths
+} elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) {
+# Cooked line from DumpAddressMap.  Example:
+#   40000000-40015000: /lib/ld-2.3.2.so
+$start = HexExtend($1);
+$finish = HexExtend($2);
+$offset = $zero_offset;
+$lib = $3;
+} else {
+next;
+}
+# Expand "$build" variable if available
+$lib =~ s/\$build\b/$buildvar/g;
+$lib = FindLibrary($lib);
+# Check for pre-relocated libraries, which use pre-relocated symbol tables
+# and thus require adjusting the offset that we'll use to translate
+# VM addresses into symbol table addresses.
+# Only do this if we're not going to fetch the symbol table from a
+# debugging copy of the library.
+if (!DebuggingLibrary($lib)) {
+my $text = ParseTextSectionHeader($lib);
+if (defined($text)) {
+my $vma_offset = AddressSub($text->{vma}, $text->{file_offset});
+$offset = AddressAdd($offset, $vma_offset);
+}
+}
+push(@{$result}, [$lib, $start, $finish, $offset]);
+}
+# Append special entry for additional library (not relocated)
+if ($main::opt_lib ne "") {
+my $text = ParseTextSectionHeader($main::opt_lib);
+if (defined($text)) {
+my $start = $text->{vma};
+my $finish = AddressAdd($start, $text->{size});
+push(@{$result}, [$main::opt_lib, $start, $finish, $start]);
+}
+}
+# Append special entry for the main program.  This covers
+# 0..max_pc_value_seen, so that we assume pc values not found in one
+# of the library ranges will be treated as coming from the main
+# program binary.
+my $min_pc = HexExtend("0");
+my $max_pc = $min_pc;          # find the maximal PC value in any sample
+foreach my $pc (keys(%{$pcs})) {
+if (HexExtend($pc) gt $max_pc) { $max_pc = HexExtend($pc); }
+}
+push(@{$result}, [$prog, $min_pc, $max_pc, $zero_offset]);
+return $result;
+}
+# Add two hex addresses of length $address_length.
+# Run pprof --test for unit test if this is changed.
+sub AddressAdd {
+my $addr1 = shift;
+my $addr2 = shift;
+my $sum;
+if ($address_length == 8) {
+# Perl doesn't cope with wraparound arithmetic, so do it explicitly:
+$sum = (hex($addr1)+hex($addr2)) % (0x10000000 * 16);
+return sprintf("%08x", $sum);
+} else {
+# Do the addition in 7-nibble chunks to trivialize carry handling.
+if ($main::opt_debug and $main::opt_test) {
+print STDERR "AddressAdd $addr1 + $addr2 = ";
+}
+my $a1 = substr($addr1,-7);
+$addr1 = substr($addr1,0,-7);
+my $a2 = substr($addr2,-7);
+$addr2 = substr($addr2,0,-7);
+$sum = hex($a1) + hex($a2);
+my $c = 0;
+if ($sum > 0xfffffff) {
+$c = 1;
+$sum -= 0x10000000;
+}
+my $r = sprintf("%07x", $sum);
+$a1 = substr($addr1,-7);
+$addr1 = substr($addr1,0,-7);
+$a2 = substr($addr2,-7);
+$addr2 = substr($addr2,0,-7);
+$sum = hex($a1) + hex($a2) + $c;
+$c = 0;
+if ($sum > 0xfffffff) {
+$c = 1;
+$sum -= 0x10000000;
+}
+$r = sprintf("%07x", $sum) . $r;
+$sum = hex($addr1) + hex($addr2) + $c;
+if ($sum > 0xff) { $sum -= 0x100; }
+$r = sprintf("%02x", $sum) . $r;
+if ($main::opt_debug and $main::opt_test) { print STDERR "$r\n"; }
+return $r;
+}
+}
+# Subtract two hex addresses of length $address_length.
+# Run pprof --test for unit test if this is changed.
+sub AddressSub {
+my $addr1 = shift;
+my $addr2 = shift;
+my $diff;
+if ($address_length == 8) {
+# Perl doesn't cope with wraparound arithmetic, so do it explicitly:
+$diff = (hex($addr1)-hex($addr2)) % (0x10000000 * 16);
+return sprintf("%08x", $diff);
+} else {
+# Do the addition in 7-nibble chunks to trivialize borrow handling.
+# if ($main::opt_debug) { print STDERR "AddressSub $addr1 - $addr2 = "; }
+my $a1 = hex(substr($addr1,-7));
+$addr1 = substr($addr1,0,-7);
+my $a2 = hex(substr($addr2,-7));
+$addr2 = substr($addr2,0,-7);
+my $b = 0;
+if ($a2 > $a1) {
+$b = 1;
+$a1 += 0x10000000;
+}
+$diff = $a1 - $a2;
+my $r = sprintf("%07x", $diff);
+$a1 = hex(substr($addr1,-7));
+$addr1 = substr($addr1,0,-7);
+$a2 = hex(substr($addr2,-7)) + $b;
+$addr2 = substr($addr2,0,-7);
+$b = 0;
+if ($a2 > $a1) {
+$b = 1;
+$a1 += 0x10000000;
+}
+$diff = $a1 - $a2;
+$r = sprintf("%07x", $diff) . $r;
+$a1 = hex($addr1);
+$a2 = hex($addr2) + $b;
+if ($a2 > $a1) { $a1 += 0x100; }
+$diff = $a1 - $a2;
+$r = sprintf("%02x", $diff) . $r;
+# if ($main::opt_debug) { print STDERR "$r\n"; }
+return $r;
+}
+}
+# Increment a hex addresses of length $address_length.
+# Run pprof --test for unit test if this is changed.
+sub AddressInc {
+my $addr = shift;
+my $sum;
+if ($address_length == 8) {
+# Perl doesn't cope with wraparound arithmetic, so do it explicitly:
+$sum = (hex($addr)+1) % (0x10000000 * 16);
+return sprintf("%08x", $sum);
+} else {
+# Do the addition in 7-nibble chunks to trivialize carry handling.
+# We are always doing this to step through the addresses in a function,
+# and will almost never overflow the first chunk, so we check for this
+# case and exit early.
+# if ($main::opt_debug) { print STDERR "AddressInc $addr1 = "; }
+my $a1 = substr($addr,-7);
+$addr = substr($addr,0,-7);
+$sum = hex($a1) + 1;
+my $r = sprintf("%07x", $sum);
+if ($sum <= 0xfffffff) {
+$r = $addr . $r;
+# if ($main::opt_debug) { print STDERR "$r\n"; }
+return HexExtend($r);
+} else {
+$r = "0000000";
+}
+$a1 = substr($addr,-7);
+$addr = substr($addr,0,-7);
+$sum = hex($a1) + 1;
+$r = sprintf("%07x", $sum) . $r;
+if ($sum <= 0xfffffff) {
+$r = $addr . $r;
+# if ($main::opt_debug) { print STDERR "$r\n"; }
+return HexExtend($r);
+} else {
+$r = "00000000000000";
+}
+$sum = hex($addr) + 1;
+if ($sum > 0xff) { $sum -= 0x100; }
+$r = sprintf("%02x", $sum) . $r;
+# if ($main::opt_debug) { print STDERR "$r\n"; }
+return $r;
+}
+}
+# Extract symbols for all PC values found in profile
+sub ExtractSymbols {
+my $libs = shift;
+my $pcset = shift;
+my $symbols = {};
+# Map each PC value to the containing library.  To make this faster,
+# we sort libraries by their starting pc value (highest first), and
+# advance through the libraries as we advance the pc.  Sometimes the
+# addresses of libraries may overlap with the addresses of the main
+# binary, so to make sure the libraries 'win', we iterate over the
+# libraries in reverse order (which assumes the binary doesn't start
+# in the middle of a library, which seems a fair assumption).
+my @pcs = (sort { $a cmp $b } keys(%{$pcset}));  # pcset is 0-extended strings
+foreach my $lib (sort {$b->[1] cmp $a->[1]} @{$libs}) {
+my $libname = $lib->[0];
+my $start = $lib->[1];
+my $finish = $lib->[2];
+my $offset = $lib->[3];
+# Get list of pcs that belong in this library.
+my $contained = [];
+my ($start_pc_index, $finish_pc_index);
+# Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index].
+for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0;
+$finish_pc_index--) {
+last if $pcs[$finish_pc_index - 1] le $finish;
+}
+# Find smallest start_pc_index such that $start <= $pc[$start_pc_index].
+for ($start_pc_index = $finish_pc_index; $start_pc_index > 0;
+$start_pc_index--) {
+last if $pcs[$start_pc_index - 1] lt $start;
+}
+# This keeps PC values higher than $pc[$finish_pc_index] in @pcs,
+# in case there are overlaps in libraries and the main binary.
+@{$contained} = splice(@pcs, $start_pc_index,
+$finish_pc_index - $start_pc_index);
+# Map to symbols
+MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols);
+}
+return $symbols;
+}
+# Map list of PC values to symbols for a given image
+sub MapToSymbols {
+my $image = shift;
+my $offset = shift;
+my $pclist = shift;
+my $symbols = shift;
+my $debug = 0;
+# Ignore empty binaries
+if ($#{$pclist} < 0) { return; }
+# Figure out the addr2line command to use
+my $addr2line = $obj_tool_map{"addr2line"};
+my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image);
+if (exists $obj_tool_map{"addr2line_pdb"}) {
+$addr2line = $obj_tool_map{"addr2line_pdb"};
+$cmd = ShellEscape($addr2line, "--demangle", "-f", "-C", "-e", $image);
+}
+# If "addr2line" isn't installed on the system at all, just use
+# nm to get what info we can (function names, but not line numbers).
+if (system(ShellEscape($addr2line, "--help") . " >$dev_null 2>&1") != 0) {
+MapSymbolsWithNM($image, $offset, $pclist, $symbols);
+return;
+}
+# "addr2line -i" can produce a variable number of lines per input
+# address, with no separator that allows us to tell when data for
+# the next address starts.  So we find the address for a special
+# symbol (_fini) and interleave this address between all real
+# addresses passed to addr2line.  The name of this special symbol
+# can then be used as a separator.
+$sep_address = undef;  # May be filled in by MapSymbolsWithNM()
+my $nm_symbols = {};
+MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);
+if (defined($sep_address)) {
+# Only add " -i" to addr2line if the binary supports it.
+# addr2line --help returns 0, but not if it sees an unknown flag first.
+if (system("$cmd -i --help >$dev_null 2>&1") == 0) {
+$cmd .= " -i";
+} else {
+$sep_address = undef;   # no need for sep_address if we don't support -i
+}
+}
+# Make file with all PC values with intervening 'sep_address' so
+# that we can reliably detect the end of inlined function list
+open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
+if ($debug) { print("---- $image ---\n"); }
+for (my $i = 0; $i <= $#{$pclist}; $i++) {
+# addr2line always reads hex addresses, and does not need '0x' prefix.
+if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); }
+printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
+if (defined($sep_address)) {
+printf ADDRESSES ("%s\n", $sep_address);
+}
+}
+close(ADDRESSES);
+if ($debug) {
+print("----\n");
+system("cat", $main::tmpfile_sym);
+print("----\n");
+system("$cmd < " . ShellEscape($main::tmpfile_sym));
+print("----\n");
+}
+open(SYMBOLS, "$cmd <" . ShellEscape($main::tmpfile_sym) . " |")
+|| error("$cmd: $!\n");
+my $count = 0;   # Index in pclist
+while (<SYMBOLS>) {
+# Read fullfunction and filelineinfo from next pair of lines
+s/\r?\n$//g;
+my $fullfunction = $_;
+$_ = <SYMBOLS>;
+s/\r?\n$//g;
+my $filelinenum = $_;
+if (defined($sep_address) && $fullfunction eq $sep_symbol) {
+# Terminating marker for data for this address
+$count++;
+next;
+}
+$filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths
+my $pcstr = $pclist->[$count];
+my $function = ShortFunctionName($fullfunction);
+my $nms = $nm_symbols->{$pcstr};
+if (defined($nms)) {
+if ($fullfunction eq '??') {
+# nm found a symbol for us.
+$function = $nms->[0];
+$fullfunction = $nms->[2];
+} else {
+	# MapSymbolsWithNM tags each routine with its starting address,
+	# useful in case the image has multiple occurrences of this
+	# routine.  (It uses a syntax that resembles template paramters,
+	# that are automatically stripped out by ShortFunctionName().)
+	# addr2line does not provide the same information.  So we check
+	# if nm disambiguated our symbol, and if so take the annotated
+	# (nm) version of the routine-name.  TODO(csilvers): this won't
+	# catch overloaded, inlined symbols, which nm doesn't see.
+	# Better would be to do a check similar to nm's, in this fn.
+	if ($nms->[2] =~ m/^\Q$function\E/) {  # sanity check it's the right fn
+	  $function = $nms->[0];
+	  $fullfunction = $nms->[2];
+	}
+}
+}
+# Prepend to accumulated symbols for pcstr
+# (so that caller comes before callee)
+my $sym = $symbols->{$pcstr};
+if (!defined($sym)) {
+$sym = [];
+$symbols->{$pcstr} = $sym;
+}
+unshift(@{$sym}, $function, $filelinenum, $fullfunction);
+if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
+if (!defined($sep_address)) {
+# Inlining is off, so this entry ends immediately
+$count++;
+}
+}
+close(SYMBOLS);
+}
+# Use nm to map the list of referenced PCs to symbols.  Return true iff we
+# are able to read procedure information via nm.
+sub MapSymbolsWithNM {
+my $image = shift;
+my $offset = shift;
+my $pclist = shift;
+my $symbols = shift;
+# Get nm output sorted by increasing address
+my $symbol_table = GetProcedureBoundaries($image, ".");
+if (!%{$symbol_table}) {
+return 0;
+}
+# Start addresses are already the right length (8 or 16 hex digits).
+my @names = sort { $symbol_table->{$a}->[0] cmp $symbol_table->{$b}->[0] }
+keys(%{$symbol_table});
+if ($#names < 0) {
+# No symbols: just use addresses
+foreach my $pc (@{$pclist}) {
+my $pcstr = "0x" . $pc;
+$symbols->{$pc} = [$pcstr, "?", $pcstr];
+}
+return 0;
+}
+# Sort addresses so we can do a join against nm output
+my $index = 0;
+my $fullname = $names[0];
+my $name = ShortFunctionName($fullname);
+foreach my $pc (sort { $a cmp $b } @{$pclist}) {
+# Adjust for mapped offset
+my $mpc = AddressSub($pc, $offset);
+while (($index < $#names) && ($mpc ge $symbol_table->{$fullname}->[1])){
+$index++;
+$fullname = $names[$index];
+$name = ShortFunctionName($fullname);
+}
+if ($mpc lt $symbol_table->{$fullname}->[1]) {
+$symbols->{$pc} = [$name, "?", $fullname];
+} else {
+my $pcstr = "0x" . $pc;
+$symbols->{$pc} = [$pcstr, "?", $pcstr];
+}
+}
+return 1;
+}
+sub ShortFunctionName {
+my $function = shift;
+while ($function =~ s/\([^()]*\)(\s*const)?//g) { }   # Argument types
+while ($function =~ s/<[^<>]*>//g)  { }    # Remove template arguments
+$function =~ s/^.*\s+(\w+::)/$1/;          # Remove leading type
+return $function;
+}
+# Trim overly long symbols found in disassembler output
+sub CleanDisassembly {
+my $d = shift;
+while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax)
+while ($d =~ s/(\w+)<[^<>]*>/$1/g)  { }       # Remove template arguments
+return $d;
+}
+# Clean file name for display
+sub CleanFileName {
+my ($f) = @_;
+$f =~ s|^/proc/self/cwd/||;
+$f =~ s|^\./||;
+return $f;
+}
+# Make address relative to section and clean up for display
+sub UnparseAddress {
+my ($offset, $address) = @_;
+$address = AddressSub($address, $offset);
+$address =~ s/^0x//;
+$address =~ s/^0*//;
+return $address;
+}
+##### Miscellaneous #####
+# Find the right versions of the above object tools to use.  The
+# argument is the program file being analyzed, and should be an ELF
+# 32-bit or ELF 64-bit executable file.  The location of the tools
+# is determined by considering the following options in this order:
+#   1) --tools option, if set
+#   2) PPROF_TOOLS environment variable, if set
+#   3) the environment
+sub ConfigureObjTools {
+my $prog_file = shift;
+# Check for the existence of $prog_file because /usr/bin/file does not
+# predictably return error status in prod.
+(-e $prog_file)  || error("$prog_file does not exist.\n");
+my $file_type = undef;
+if (-e "/usr/bin/file") {
+# Follow symlinks (at least for systems where "file" supports that).
+my $escaped_prog_file = ShellEscape($prog_file);
+$file_type = `/usr/bin/file -L $escaped_prog_file 2>$dev_null ||
+/usr/bin/file $escaped_prog_file`;
+} elsif ($^O == "MSWin32") {
+$file_type = "MS Windows";
+} else {
+print STDERR "WARNING: Can't determine the file type of $prog_file";
+}
+if ($file_type =~ /64-bit/) {
+# Change $address_length to 16 if the program file is ELF 64-bit.
+# We can't detect this from many (most?) heap or lock contention
+# profiles, since the actual addresses referenced are generally in low
+# memory even for 64-bit programs.
+$address_length = 16;
+}
+if ($file_type =~ /MS Windows/) {
+# For windows, we provide a version of nm and addr2line as part of
+# the opensource release, which is capable of parsing
+# Windows-style PDB executables.  It should live in the path, or
+# in the same directory as pprof.
+$obj_tool_map{"nm_pdb"} = "nm-pdb";
+$obj_tool_map{"addr2line_pdb"} = "addr2line-pdb";
+}
+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:
+foreach my $tool (keys %obj_tool_map) {
+$obj_tool_map{$tool} = ConfigureTool($obj_tool_map{$tool});
+}
+}
+# Returns the path of a caller-specified object tool.  If --tools or
+# PPROF_TOOLS are specified, then returns the full path to the tool
+# with that prefix.  Otherwise, returns the path unmodified (which
+# means we will look for it on PATH).
+sub ConfigureTool {
+my $tool = shift;
+my $path;
+# --tools (or $PPROF_TOOLS) is a comma separated list, where each
+# item is either a) a pathname prefix, or b) a map of the form
+# <tool>:<path>.  First we look for an entry of type (b) for our
+# tool.  If one is found, we use it.  Otherwise, we consider all the
+# pathname prefixes in turn, until one yields an existing file.  If
+# none does, we use a default path.
+my $tools = $main::opt_tools || $ENV{"PPROF_TOOLS"} || "";
+if ($tools =~ m/(,|^)\Q$tool\E:([^,]*)/) {
+$path = $2;
+# TODO(csilvers): sanity-check that $path exists?  Hard if it's relative.
+} elsif ($tools ne '') {
+foreach my $prefix (split(',', $tools)) {
+next if ($prefix =~ /:/);    # ignore "tool:fullpath" entries in the list
+if (-x $prefix . $tool) {
+$path = $prefix . $tool;
+last;
+}
+}
+if (!$path) {
+error("No '$tool' found with prefix specified by " .
+"--tools (or \$PPROF_TOOLS) '$tools'\n");
+}
+} else {
+# ... otherwise use the version that exists in the same directory as
+# pprof.  If there's nothing there, use $PATH.
+$0 =~ m,[^/]*$,;     # this is everything after the last slash
+my $dirname = $`;    # this is everything up to and including the last slash
+if (-x "$dirname$tool") {
+$path = "$dirname$tool";
+} else {
+$path = $tool;
+}
+}
+if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; }
+return $path;
+}
+sub ShellEscape {
+my @escaped_words = ();
+foreach my $word (@_) {
+my $escaped_word = $word;
+if ($word =~ m![^a-zA-Z0-9/.,_=-]!) {  # check for anything not in whitelist
+$escaped_word =~ s/'/'\\''/;
+$escaped_word = "'$escaped_word'";
+}
+push(@escaped_words, $escaped_word);
+}
+return join(" ", @escaped_words);
+}
+sub cleanup {
+unlink($main::tmpfile_sym);
+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) &&
+defined($main::collected_profile)) {
+if (scalar(@main::profile_files) == 1) {
+print STDERR "Dynamically gathered profile is in $main::collected_profile\n";
+}
+print STDERR "If you want to investigate this profile further, you can do:\n";
+print STDERR "\n";
+print STDERR "  pprof \\\n";
+print STDERR "    $main::prog \\\n";
+print STDERR "    $main::collected_profile\n";
+print STDERR "\n";
+}
+}
+sub sighandler {
+cleanup();
+exit(1);
+}
+sub error {
+my $msg = shift;
+print STDERR $msg;
+cleanup();
+exit(1);
+}
+# Run $nm_command and get all the resulting procedure boundaries whose
+# names match "$regexp" and returns them in a hashtable mapping from
+# procedure name to a two-element vector of [start address, end address]
+sub GetProcedureBoundariesViaNm {
+my $escaped_nm_command = shift;    # shell-escaped
+my $regexp = shift;
+my $symbol_table = {};
+open(NM, "$escaped_nm_command |") || error("$escaped_nm_command: $!\n");
+my $last_start = "0";
+my $routine = "";
+while (<NM>) {
+s/\r//g;         # turn windows-looking lines into unix-looking lines
+if (m/^\s*([0-9a-f]+) (.) (..*)/) {
+my $start_val = $1;
+my $type = $2;
+my $this_routine = $3;
+# It's possible for two symbols to share the same address, if
+# one is a zero-length variable (like __start_google_malloc) or
+# one symbol is a weak alias to another (like __libc_malloc).
+# In such cases, we want to ignore all values except for the
+# actual symbol, which in nm-speak has type "T".  The logic
+# below does this, though it's a bit tricky: what happens when
+# we have a series of lines with the same address, is the first
+# one gets queued up to be processed.  However, it won't
+# *actually* be processed until later, when we read a line with
+# a different address.  That means that as long as we're reading
+# lines with the same address, we have a chance to replace that
+# item in the queue, which we do whenever we see a 'T' entry --
+# that is, a line with type 'T'.  If we never see a 'T' entry,
+# 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;
+} elsif ($start_val eq $last_start) {
+# We're not the 'T' symbol at this address, so ignore us.
+next;
+}
+if ($this_routine eq $sep_symbol) {
+$sep_address = HexExtend($start_val);
+}
+# Tag this routine with the starting address in case the image
+# has multiple occurrences of this routine.  We use a syntax
+# that resembles template paramters that are automatically
+# stripped out by ShortFunctionName()
+$this_routine .= "<$start_val>";
+if (defined($routine) && $routine =~ m/$regexp/) {
+$symbol_table->{$routine} = [HexExtend($last_start),
+HexExtend($start_val)];
+}
+$last_start = $start_val;
+$routine = $this_routine;
+} elsif (m/^Loaded image name: (.+)/) {
+# The win32 nm workalike emits information about the binary it is using.
+if ($main::opt_debug) { print STDERR "Using Image $1\n"; }
+} elsif (m/^PDB file name: (.+)/) {
+# The win32 nm workalike emits information about the pdb it is using.
+if ($main::opt_debug) { print STDERR "Using PDB $1\n"; }
+}
+}
+close(NM);
+# Handle the last line in the nm output.  Unfortunately, we don't know
+# how big this last symbol is, because we don't know how big the file
+# is.  For now, we just give it a size of 0.
+# TODO(csilvers): do better here.
+if (defined($routine) && $routine =~ m/$regexp/) {
+$symbol_table->{$routine} = [HexExtend($last_start),
+HexExtend($last_start)];
+}
+return $symbol_table;
+}
+# Gets the procedure boundaries for all routines in "$image" whose names
+# match "$regexp" and returns them in a hashtable mapping from procedure
+# name to a two-element vector of [start address, end address].
+# Will return an empty map if nm is not installed or not working properly.
+sub GetProcedureBoundaries {
+my $image = shift;
+my $regexp = shift;
+# If $image doesn't start with /, then put ./ in front of it.  This works
+# around an obnoxious bug in our probing of nm -f behavior.
+# "nm -f $image" is supposed to fail on GNU nm, but if:
+#
+# a. $image starts with [BbSsPp] (for example, bin/foo/bar), AND
+# b. you have a.out in your current directory (a not uncommon occurence)
+#
+# then "nm -f $image" succeeds because -f only looks at the first letter of
+# the argument, which looks valid because it's [BbSsPp], and then since
+# there's no image provided, it looks for a.out and finds it.
+#
+# This regex makes sure that $image starts with . or /, forcing the -f
+# parsing to fail since . and / are not valid formats.
+$image =~ s#^[^/]#./$&#;
+# For libc libraries, the copy in /usr/lib/debug contains debugging symbols
+my $debugging = DebuggingLibrary($image);
+if ($debugging) {
+$image = $debugging;
+}
+my $nm = $obj_tool_map{"nm"};
+my $cppfilt = $obj_tool_map{"c++filt"};
+# nm can fail for two reasons: 1) $image isn't a debug library; 2) nm
+# binary doesn't support --demangle.  In addition, for OS X we need
+# to use the -f flag to get 'flat' nm output (otherwise we don't sort
+# properly and get incorrect results).  Unfortunately, GNU nm uses -f
+# in an incompatible way.  So first we test whether our nm supports
+# --demangle and -f.
+my $demangle_flag = "";
+my $cppfilt_flag = "";
+my $to_devnull = ">$dev_null 2>&1";
+if (system(ShellEscape($nm, "--demangle", "image") . $to_devnull) == 0) {
+# In this mode, we do "nm --demangle <foo>"
+$demangle_flag = "--demangle";
+$cppfilt_flag = "";
+} elsif (system(ShellEscape($cppfilt, $image) . $to_devnull) == 0) {
+# In this mode, we do "nm <foo> | c++filt"
+$cppfilt_flag = " | " . ShellEscape($cppfilt);
+};
+my $flatten_flag = "";
+if (system(ShellEscape($nm, "-f", $image) . $to_devnull) == 0) {
+$flatten_flag = "-f";
+}
+# Finally, in the case $imagie isn't a debug library, we try again with
+# -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 = (ShellEscape($nm, "-n", $flatten_flag, $demangle_flag,
+$image) . " 2>$dev_null $cppfilt_flag",
+ShellEscape($nm, "-D", "-n", $flatten_flag, $demangle_flag,
+$image) . " 2>$dev_null $cppfilt_flag",
+# 6nm is for Go binaries
+ShellEscape("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
+# PDB-format executables can apparently include dwarf .o files.
+if (exists $obj_tool_map{"nm_pdb"}) {
+push(@nm_commands,
+ShellEscape($obj_tool_map{"nm_pdb"}, "--demangle", $image)
+. " 2>$dev_null");
+}
+foreach my $nm_command (@nm_commands) {
+my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp);
+return $symbol_table if (%{$symbol_table});
+}
+my $symbol_table = {};
+return $symbol_table;
+}
+# The test vectors for AddressAdd/Sub/Inc are 8-16-nibble hex strings.
+# To make them more readable, we add underscores at interesting places.
+# This routine removes the underscores, producing the canonical representation
+# used by pprof to represent addresses, particularly in the tested routines.
+sub CanonicalHex {
+my $arg = shift;
+return join '', (split '_',$arg);
+}
+# Unit test for AddressAdd:
+sub AddressAddUnitTest {
+my $test_data_8 = shift;
+my $test_data_16 = shift;
+my $error_count = 0;
+my $fail_count = 0;
+my $pass_count = 0;
+# print STDERR "AddressAddUnitTest: ", 1+$#{$test_data_8}, " tests\n";
+# First a few 8-nibble addresses.  Note that this implementation uses
+# plain old arithmetic, so a quick sanity check along with verifying what
+# happens to overflow (we want it to wrap):
+$address_length = 8;
+foreach my $row (@{$test_data_8}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressAdd ($row->[0], $row->[1]);
+if ($sum ne $row->[2]) {
+printf STDERR "ERROR: %s != %s + %s = %s\n", $sum,
+$row->[0], $row->[1], $row->[2];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressAdd 32-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count = $fail_count;
+$fail_count = 0;
+$pass_count = 0;
+# Now 16-nibble addresses.
+$address_length = 16;
+foreach my $row (@{$test_data_16}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressAdd (CanonicalHex($row->[0]), CanonicalHex($row->[1]));
+my $expected = join '', (split '_',$row->[2]);
+if ($sum ne CanonicalHex($row->[2])) {
+printf STDERR "ERROR: %s != %s + %s = %s\n", $sum,
+$row->[0], $row->[1], $row->[2];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressAdd 64-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count += $fail_count;
+return $error_count;
+}
+# Unit test for AddressSub:
+sub AddressSubUnitTest {
+my $test_data_8 = shift;
+my $test_data_16 = shift;
+my $error_count = 0;
+my $fail_count = 0;
+my $pass_count = 0;
+# print STDERR "AddressSubUnitTest: ", 1+$#{$test_data_8}, " tests\n";
+# First a few 8-nibble addresses.  Note that this implementation uses
+# plain old arithmetic, so a quick sanity check along with verifying what
+# happens to overflow (we want it to wrap):
+$address_length = 8;
+foreach my $row (@{$test_data_8}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressSub ($row->[0], $row->[1]);
+if ($sum ne $row->[3]) {
+printf STDERR "ERROR: %s != %s - %s = %s\n", $sum,
+$row->[0], $row->[1], $row->[3];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressSub 32-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count = $fail_count;
+$fail_count = 0;
+$pass_count = 0;
+# Now 16-nibble addresses.
+$address_length = 16;
+foreach my $row (@{$test_data_16}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressSub (CanonicalHex($row->[0]), CanonicalHex($row->[1]));
+if ($sum ne CanonicalHex($row->[3])) {
+printf STDERR "ERROR: %s != %s - %s = %s\n", $sum,
+$row->[0], $row->[1], $row->[3];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressSub 64-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count += $fail_count;
+return $error_count;
+}
+# Unit test for AddressInc:
+sub AddressIncUnitTest {
+my $test_data_8 = shift;
+my $test_data_16 = shift;
+my $error_count = 0;
+my $fail_count = 0;
+my $pass_count = 0;
+# print STDERR "AddressIncUnitTest: ", 1+$#{$test_data_8}, " tests\n";
+# First a few 8-nibble addresses.  Note that this implementation uses
+# plain old arithmetic, so a quick sanity check along with verifying what
+# happens to overflow (we want it to wrap):
+$address_length = 8;
+foreach my $row (@{$test_data_8}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressInc ($row->[0]);
+if ($sum ne $row->[4]) {
+printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum,
+$row->[0], $row->[4];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressInc 32-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count = $fail_count;
+$fail_count = 0;
+$pass_count = 0;
+# Now 16-nibble addresses.
+$address_length = 16;
+foreach my $row (@{$test_data_16}) {
+if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
+my $sum = AddressInc (CanonicalHex($row->[0]));
+if ($sum ne CanonicalHex($row->[4])) {
+printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum,
+$row->[0], $row->[4];
+++$fail_count;
+} else {
+++$pass_count;
+}
+}
+printf STDERR "AddressInc 64-bit tests: %d passes, %d failures\n",
+$pass_count, $fail_count;
+$error_count += $fail_count;
+return $error_count;
+}
+# Driver for unit tests.
+# Currently just the address add/subtract/increment routines for 64-bit.
+sub RunUnitTests {
+my $error_count = 0;
+# This is a list of tuples [a, b, a+b, a-b, a+1]
+my $unit_test_data_8 = [
+[qw(aaaaaaaa 50505050 fafafafa 5a5a5a5a aaaaaaab)],
+[qw(50505050 aaaaaaaa fafafafa a5a5a5a6 50505051)],
+[qw(ffffffff aaaaaaaa aaaaaaa9 55555555 00000000)],
+[qw(00000001 ffffffff 00000000 00000002 00000002)],
+[qw(00000001 fffffff0 fffffff1 00000011 00000002)],
+];
+my $unit_test_data_16 = [
+# The implementation handles data in 7-nibble chunks, so those are the
+# interesting boundaries.
+[qw(aaaaaaaa 50505050
+00_000000f_afafafa 00_0000005_a5a5a5a 00_000000a_aaaaaab)],
+[qw(50505050 aaaaaaaa
+00_000000f_afafafa ff_ffffffa_5a5a5a6 00_0000005_0505051)],
+[qw(ffffffff aaaaaaaa
+00_000001a_aaaaaa9 00_0000005_5555555 00_0000010_0000000)],
+[qw(00000001 ffffffff
+00_0000010_0000000 ff_ffffff0_0000002 00_0000000_0000002)],
+[qw(00000001 fffffff0
+00_000000f_ffffff1 ff_ffffff0_0000011 00_0000000_0000002)],
+[qw(00_a00000a_aaaaaaa 50505050
+00_a00000f_afafafa 00_a000005_a5a5a5a 00_a00000a_aaaaaab)],
+[qw(0f_fff0005_0505050 aaaaaaaa
+0f_fff000f_afafafa 0f_ffefffa_5a5a5a6 0f_fff0005_0505051)],
+[qw(00_000000f_fffffff 01_800000a_aaaaaaa
+01_800001a_aaaaaa9 fe_8000005_5555555 00_0000010_0000000)],
+[qw(00_0000000_0000001 ff_fffffff_fffffff
+00_0000000_0000000 00_0000000_0000002 00_0000000_0000002)],
+[qw(00_0000000_0000001 ff_fffffff_ffffff0
+ff_fffffff_ffffff1 00_0000000_0000011 00_0000000_0000002)],
+];
+$error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16);
+$error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);
+$error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);
+if ($error_count > 0) {
+print STDERR $error_count, " errors: FAILED\n";
+} else {
+print STDERR "PASS\n";
+}
+exit ($error_count);
+}

The Tor Browser / file comparison

comparison: memory/jemalloc/src/bin/pprof

memory/jemalloc/src/bin/pprof