// 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.

// Authors: Ge,Jun (gejun@baidu.com)

#include "brpc/builtin/pprof_perl.h"

namespace brpc {

const char* pprof_perl() {
    return "#! /usr/bin/env perl\n"
        "use strict;\n"
        "use warnings;\n"
        "use Getopt::Long;\n"
        "my $PPROF_VERSION = \"1.5\";\n"
        "my %obj_tool_map = (\n"
        "  \"objdump\" => \"objdump\",\n"
        "  \"nm\" => \"nm\",\n"
        "  \"addr2line\" => \"addr2line\",\n"
        "  \"c++filt\" => \"c++filt\",\n"
        "  #\"nm_pdb\" => \"nm-pdb\",\n"
        "  #\"addr2line_pdb\" => \"addr2line-pdb\",\n"
        "  #\"otool\" => \"otool\",\n"
        ");\n"
        "my $DOT = \"dot\";\n"
        "if (exists $ENV{\"DOT\"}) {\n"
        "    $DOT = $ENV{\"DOT\"}\n"
        "}\n"
        "my $GV = \"gv\";\n"
        "my $KCACHEGRIND = \"kcachegrind\";\n"
        "my $PS2PDF = \"ps2pdf\";\n"
        "my $URL_FETCHER = \"curl -s\";\n"
        "my $HEAP_PAGE = \"/pprof/heap\";\n"
        "my $PROFILE_PAGE = \"/pprof/profile\";\n"
        "my $PMUPROFILE_PAGE = \"/pprof/pmuprofile(?:\\\\?.*)?\";\n"
        "my $GROWTH_PAGE = \"/pprof/growth\";\n"
        "my $CONTENTION_PAGE = \"/pprof/contention\";\n"
        "my $WALL_PAGE = \"/pprof/wall(?:\\\\?.*)?\";\n"
        "my $FILTEREDPROFILE_PAGE = \"/pprof/filteredprofile(?:\\\\?.*)?\";\n"
        "my $SYMBOL_PAGE = \"/pprof/symbol\";\n"
        "my $PROGRAM_NAME_PAGE = \"/pprof/cmdline\";\n"
        "my $PROFILES = \"($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|\" .\n"
        "               \"$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|\" .\n"
        "               \"$FILTEREDPROFILE_PAGE)\";\n"
        "my $UNKNOWN_BINARY = \"(unknown)\";\n"
        "my $address_length = 16;\n"
        "my @prefix_list = ();\n"
        "my $sep_symbol = '_fini';\n"
        "my $sep_address = undef;\n"
        "sub usage_string {\n"
        "  return <<EOF;\n"
        "Usage:\n"
        "pprof [options] <program> <profiles>\n"
        "   <profiles> is a space separated list of profile names.\n"
        "pprof [options] <symbolized-profiles>\n"
        "   <symbolized-profiles> is a list of profile files where each file contains\n"
        "   the necessary symbol mappings  as well as profile data (likely generated\n"
        "   with --raw).\n"
        "pprof [options] <profile>\n"
        "   <profile> is a remote form.  Symbols are obtained from host:port$SYMBOL_PAGE\n"
        "   Each name can be:\n"
        "   /path/to/profile        - a path to a profile file\n"
        "   host:port[/<service>]   - a location of a service to get profile from\n"
        "   The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile,\n"
        "                         $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall,\n"
        "                         or /pprof/filteredprofile.\n"
        "   For instance: \"pprof http://myserver.com:80$HEAP_PAGE\".\n"
        "   If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profiling).\n"
        "pprof --symbols <program>\n"
        "   Maps addresses to symbol names.  In this mode, stdin should be a\n"
        "   list of library mappings, in the same format as is found in the heap-\n"
        "   and cpu-profile files (this loosely matches that of /proc/self/maps\n"
        "   on linux), followed by a list of hex addresses to map, one per line.\n"
        "   For more help with querying remote servers, including how to add the\n"
        "   necessary server-side support code, see this filename (or one like it):\n"
        "   /usr/doc/google-perftools-$PPROF_VERSION/pprof_remote_servers.html\n"
        "Options:\n"
        "   --cum               Sort by cumulative data\n"
        "   --base=<base>       Subtract <base> from <profile> before display\n"
        "   --interactive       Run in interactive mode (interactive \"help\" gives help) [default]\n"
        "   --seconds=<n>       Length of time for dynamic profiles [default=30 secs]\n"
        "   --add_lib=<file>    Read additional symbols and line info from the given library\n"
        "   --lib_prefix=<dir>  Comma separated list of library path prefixes\n"
        "Reporting Granularity:\n"
        "   --addresses         Report at address level\n"
        "   --lines             Report at source line level\n"
        "   --functions         Report at function level [default]\n"
        "   --files             Report at source file level\n"
        "Output type:\n"
        "   --text              Generate text report\n"
        "   --callgrind         Generate callgrind format to stdout\n"
        "   --gv                Generate Postscript and display\n"
        "   --web               Generate SVG and display\n"
        "   --list=<regexp>     Generate source listing of matching routines\n"
        "   --disasm=<regexp>   Generate disassembly of matching routines\n"
        "   --symbols           Print demangled symbol names found at given addresses\n"
        "   --dot               Generate DOT file to stdout\n"
        "   --ps                Generate Postcript to stdout\n"
        "   --pdf               Generate PDF to stdout\n"
        "   --svg               Generate SVG to stdout\n"
        "   --gif               Generate GIF to stdout\n"
        "   --raw               Generate symbolized pprof data (useful with remote fetch)\n"
        "Heap-Profile Options:\n"
        "   --inuse_space       Display in-use (mega)bytes [default]\n"
        "   --inuse_objects     Display in-use objects\n"
        "   --alloc_space       Display allocated (mega)bytes\n"
        "   --alloc_objects     Display allocated objects\n"
        "   --show_bytes        Display space in bytes\n"
        "   --drop_negative     Ignore negative differences\n"
        "Contention-profile options:\n"
        "   --total_delay       Display total delay at each region [default]\n"
        "   --contentions       Display number of delays at each region\n"
        "   --mean_delay        Display mean delay at each region\n"
        "Call-graph Options:\n"
        "   --nodecount=<n>     Show at most so many nodes [default=80]\n"
        "   --nodefraction=<f>  Hide nodes below <f>*total [default=.005]\n"
        "   --edgefraction=<f>  Hide edges below <f>*total [default=.001]\n"
        "   --focus=<regexp>    Focus on nodes matching <regexp>\n"
        "   --ignore=<regexp>   Ignore nodes matching <regexp>\n"
        "   --scale=<n>         Set GV scaling [default=0]\n"
        "   --heapcheck         Make nodes with non-0 object counts\n"
        "                       (i.e. direct leak generators) more visible\n"
        "Miscellaneous:\n"
        "   --tools=<prefix or binary:fullpath>[,...]   \\$PATH for object tool pathnames\n"
        "   --test              Run unit tests\n"
        "   --help              This message\n"
        "   --version           Version information\n"
        "Environment Variables:\n"
        "   PPROF_TMPDIR        Profiles directory. Defaults to \\$HOME/pprof\n"
        "   PPROF_TOOLS         Prefix for object tools pathnames\n"
        "Examples:\n"
        "pprof /bin/ls ls.prof\n"
        "                       Enters \"interactive\" mode\n"
        "pprof --text /bin/ls ls.prof\n"
        "                       Outputs one line per procedure\n"
        "pprof --web /bin/ls ls.prof\n"
        "                       Displays annotated call-graph in web browser\n"
        "pprof --gv /bin/ls ls.prof\n"
        "                       Displays annotated call-graph via 'gv'\n"
        "pprof --gv --focus=Mutex /bin/ls ls.prof\n"
        "                       Restricts to code paths including a .*Mutex.* entry\n"
        "pprof --gv --focus=Mutex --ignore=string /bin/ls ls.prof\n"
        "                       Code paths including Mutex but not string\n"
        "pprof --list=getdir /bin/ls ls.prof\n"
        "                       (Per-line) annotated source listing for getdir()\n"
        "pprof --disasm=getdir /bin/ls ls.prof\n"
        "                       (Per-PC) annotated disassembly for getdir()\n"
        "pprof http://localhost:1234/\n"
        "                       Enters \"interactive\" mode\n"
        "pprof --text localhost:1234\n"
        "                       Outputs one line per procedure for localhost:1234\n"
        "pprof --raw localhost:1234 > ./local.raw\n"
        "pprof --text ./local.raw\n"
        "                       Fetches a remote profile for later analysis and then\n"
        "                       analyzes it in text mode.\n"
        "EOF\n"
        "}\n"
        "sub version_string {\n"
        "  return <<EOF\n"
        "pprof (part of google-perftools $PPROF_VERSION)\n"
        "Copyright 1998-2007 Google Inc.\n"
        "This is BSD licensed software; see the source for copying conditions\n"
        "and license information.\n"
        "There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A\n"
        "PARTICULAR PURPOSE.\n"
        "EOF\n"
        "}\n"
        "sub usage {\n"
        "  my $msg = shift;\n"
        "  print STDERR \"$msg\\n\\n\";\n"
        "  print STDERR usage_string();\n"
        "  print STDERR \"\\nFATAL ERROR: $msg\\n\";\n"
        "  exit(1);\n"
        "}\n"
        "sub Init() {\n"
        "  $main::tmpfile_sym = \"/tmp/pprof$$.sym\";\n"
        "  $main::tmpfile_ps = \"/tmp/pprof$$\";\n"
        "  $main::next_tmpfile = 0;\n"
        "  $SIG{'INT'} = \\&sighandler;\n"
        "  $main::source_cache = ();\n"
        "  $main::opt_help = 0;\n"
        "  $main::opt_version = 0;\n"
        "  $main::opt_cum = 0;\n"
        "  $main::opt_base = '';\n"
        "  $main::opt_addresses = 0;\n"
        "  $main::opt_lines = 0;\n"
        "  $main::opt_functions = 0;\n"
        "  $main::opt_files = 0;\n"
        "  $main::opt_lib_prefix = \"\";\n"
        "  $main::opt_text = 0;\n"
        "  $main::opt_callgrind = 0;\n"
        "  $main::opt_list = \"\";\n"
        "  $main::opt_disasm = \"\";\n"
        "  $main::opt_symbols = 0;\n"
        "  $main::opt_gv = 0;\n"
        "  $main::opt_web = 0;\n"
        "  $main::opt_dot = 0;\n"
        "  $main::opt_ps = 0;\n"
        "  $main::opt_pdf = 0;\n"
        "  $main::opt_gif = 0;\n"
        "  $main::opt_svg = 0;\n"
        "  $main::opt_raw = 0;\n"
        "  $main::opt_nodecount = 80;\n"
        "  $main::opt_nodefraction = 0.005;\n"
        "  $main::opt_edgefraction = 0.001;\n"
        "  $main::opt_focus = '';\n"
        "  $main::opt_ignore = '';\n"
        "  $main::opt_scale = 0;\n"
        "  $main::opt_heapcheck = 0;\n"
        "  $main::opt_seconds = 30;\n"
        "  $main::opt_lib = \"\";\n"
        "  $main::opt_inuse_space   = 0;\n"
        "  $main::opt_inuse_objects = 0;\n"
        "  $main::opt_alloc_space   = 0;\n"
        "  $main::opt_alloc_objects = 0;\n"
        "  $main::opt_show_bytes    = 0;\n"
        "  $main::opt_drop_negative = 0;\n"
        "  $main::opt_interactive   = 0;\n"
        "  $main::opt_total_delay = 0;\n"
        "  $main::opt_contentions = 0;\n"
        "  $main::opt_mean_delay = 0;\n"
        "  $main::opt_tools   = \"\";\n"
        "  $main::opt_debug   = 0;\n"
        "  $main::opt_test    = 0;\n"
        "  $main::opt_test_stride = 0;\n"
        "  $main::use_symbol_page = 0;\n"
        "  %main::tempnames = ();\n"
        "  $main::profile_type = '';\n"
        "  GetOptions(\"help!\"          => \\$main::opt_help,\n"
        "             \"version!\"       => \\$main::opt_version,\n"
        "             \"cum!\"           => \\$main::opt_cum,\n"
        "             \"base=s\"         => \\$main::opt_base,\n"
        "             \"seconds=i\"      => \\$main::opt_seconds,\n"
        "             \"add_lib=s\"      => \\$main::opt_lib,\n"
        "             \"lib_prefix=s\"   => \\$main::opt_lib_prefix,\n"
        "             \"functions!\"     => \\$main::opt_functions,\n"
        "             \"lines!\"         => \\$main::opt_lines,\n"
        "             \"addresses!\"     => \\$main::opt_addresses,\n"
        "             \"files!\"         => \\$main::opt_files,\n"
        "             \"text!\"          => \\$main::opt_text,\n"
        "             \"callgrind!\"     => \\$main::opt_callgrind,\n"
        "             \"list=s\"         => \\$main::opt_list,\n"
        "             \"disasm=s\"       => \\$main::opt_disasm,\n"
        "             \"symbols!\"       => \\$main::opt_symbols,\n"
        "             \"gv!\"            => \\$main::opt_gv,\n"
        "             \"web!\"           => \\$main::opt_web,\n"
        "             \"dot!\"           => \\$main::opt_dot,\n"
        "             \"ps!\"            => \\$main::opt_ps,\n"
        "             \"pdf!\"           => \\$main::opt_pdf,\n"
        "             \"svg!\"           => \\$main::opt_svg,\n"
        "             \"gif!\"           => \\$main::opt_gif,\n"
        "             \"raw!\"           => \\$main::opt_raw,\n"
        "             \"interactive!\"   => \\$main::opt_interactive,\n"
        "             \"nodecount=i\"    => \\$main::opt_nodecount,\n"
        "             \"nodefraction=f\" => \\$main::opt_nodefraction,\n"
        "             \"edgefraction=f\" => \\$main::opt_edgefraction,\n"
        "             \"focus=s\"        => \\$main::opt_focus,\n"
        "             \"ignore=s\"       => \\$main::opt_ignore,\n"
        "             \"scale=i\"        => \\$main::opt_scale,\n"
        "             \"heapcheck\"      => \\$main::opt_heapcheck,\n"
        "             \"inuse_space!\"   => \\$main::opt_inuse_space,\n"
        "             \"inuse_objects!\" => \\$main::opt_inuse_objects,\n"
        "             \"alloc_space!\"   => \\$main::opt_alloc_space,\n"
        "             \"alloc_objects!\" => \\$main::opt_alloc_objects,\n"
        "             \"show_bytes!\"    => \\$main::opt_show_bytes,\n"
        "             \"drop_negative!\" => \\$main::opt_drop_negative,\n"
        "             \"total_delay!\"   => \\$main::opt_total_delay,\n"
        "             \"contentions!\"   => \\$main::opt_contentions,\n"
        "             \"mean_delay!\"    => \\$main::opt_mean_delay,\n"
        "             \"tools=s\"        => \\$main::opt_tools,\n"
        "             \"test!\"          => \\$main::opt_test,\n"
        "             \"debug!\"         => \\$main::opt_debug,\n"
        "             \"test_stride=i\"  => \\$main::opt_test_stride,\n"
        "      ) || usage(\"Invalid option(s)\");\n"
        "  if ($main::opt_help) {\n"
        "    print usage_string();\n"
        "    exit(0);\n"
        "  }\n"
        "  if ($main::opt_version) {\n"
        "    print version_string();\n"
        "    exit(0);\n"
        "  }\n"
        "  if ($main::opt_disasm || $main::opt_list || $main::opt_symbols) {\n"
        "    $main::opt_functions = 0;\n"
        "    $main::opt_lines = 0;\n"
        "    $main::opt_addresses = 1;\n"
        "    $main::opt_files = 0;\n"
        "  }\n"
        "  if ($main::opt_inuse_space +\n"
        "      $main::opt_inuse_objects +\n"
        "      $main::opt_alloc_space +\n"
        "      $main::opt_alloc_objects > 1) {\n"
        "    usage(\"Specify at most on of --inuse/--alloc options\");\n"
        "  }\n"
        "  my $grains =\n"
        "      $main::opt_functions +\n"
        "      $main::opt_lines +\n"
        "      $main::opt_addresses +\n"
        "      $main::opt_files +\n"
        "      0;\n"
        "  if ($grains > 1) {\n"
        "    usage(\"Only specify one output granularity option\");\n"
        "  }\n"
        "  if ($grains == 0) {\n"
        "    $main::opt_functions = 1;\n"
        "  }\n"
        "  my $modes =\n"
        "      $main::opt_text +\n"
        "      $main::opt_callgrind +\n"
        "      ($main::opt_list eq '' ? 0 : 1) +\n"
        "      ($main::opt_disasm eq '' ? 0 : 1) +\n"
        "      ($main::opt_symbols == 0 ? 0 : 1) +\n"
        "      $main::opt_gv +\n"
        "      $main::opt_web +\n"
        "      $main::opt_dot +\n"
        "      $main::opt_ps +\n"
        "      $main::opt_pdf +\n"
        "      $main::opt_svg +\n"
        "      $main::opt_gif +\n"
        "      $main::opt_raw +\n"
        "      $main::opt_interactive +\n"
        "      0;\n"
        "  if ($modes > 1) {\n"
        "    usage(\"Only specify one output mode\");\n"
        "  }\n"
        "  if ($modes == 0) {\n"
        "    if (-t STDOUT) {\n"
        "      $main::opt_interactive = 1;\n"
        "    } else {\n"
        "      $main::opt_text = 1;\n"
        "    }\n"
        "  }\n"
        "  if ($main::opt_test) {\n"
        "    RunUnitTests();\n"
        "    exit(1);\n"
        "  }\n"
        "  $main::prog = \"\";\n"
        "  @main::pfile_args = ();\n"
        "  if (IsProfileURL($ARGV[0])) {\n"
        "    $main::use_symbol_page = 1;\n"
        "  } elsif (IsSymbolizedProfileFile($ARGV[0])) {\n"
        "    $main::use_symbolized_profile = 1;\n"
        "    $main::prog = $UNKNOWN_BINARY;\n"
        "  }\n"
        "  if ($main::use_symbol_page || $main::use_symbolized_profile) {\n"
        "    my %disabled = ('--lines' => $main::opt_lines,\n"
        "                    '--disasm' => $main::opt_disasm);\n"
        "    for my $option (keys %disabled) {\n"
        "      usage(\"$option cannot be used without a binary\") if $disabled{$option};\n"
        "    }\n"
        "    scalar(@ARGV) || usage(\"Did not specify profile file\");\n"
        "  } elsif ($main::opt_symbols) {\n"
        "    $main::prog = shift(@ARGV) || usage(\"Did not specify program\");\n"
        "  } else {\n"
        "    $main::prog = shift(@ARGV) || usage(\"Did not specify program\");\n"
        "    scalar(@ARGV) || usage(\"Did not specify profile file\");\n"
        "  }\n"
        "  foreach my $farg (@ARGV) {\n"
        "    if ($farg =~ m/(.*)\\@([0-9]+)(|\\/.*)$/ ) {\n"
        "      my $machine = $1;\n"
        "      my $num_machines = $2;\n"
        "      my $path = $3;\n"
        "      for (my $i = 0; $i < $num_machines; $i++) {\n"
        "        unshift(@main::pfile_args, \"$i.$machine$path\");\n"
        "      }\n"
        "    } else {\n"
        "      unshift(@main::pfile_args, $farg);\n"
        "    }\n"
        "  }\n"
        "  if ($main::use_symbol_page) {\n"
        "    unless (IsProfileURL($main::pfile_args[0])) {\n"
        "      error(\"The first profile should be a remote form to use $SYMBOL_PAGE\\n\");\n"
        "    }\n"
        "    CheckSymbolPage();\n"
        "    $main::prog = FetchProgramName();\n"
        "  } elsif (!$main::use_symbolized_profile) {\n"
        "    ConfigureObjTools($main::prog)\n"
        "  }\n"
        "  @prefix_list = split (',', $main::opt_lib_prefix);\n"
        "  foreach (@prefix_list) {\n"
        "    s|/+$||;\n"
        "  }\n"
        "}\n"
        "sub Main() {\n"
        "  Init();\n"
        "  $main::collected_profile = undef;\n"
        "  @main::profile_files = ();\n"
        "  $main::op_time = time();\n"
        "  if ($main::opt_symbols) {\n"
        "    PrintSymbols(*STDIN);\n"
        "    return;\n"
        "  }\n"
        "  FetchDynamicProfiles();\n"
        "  my $symbol_map = {};\n"
        "  my $data = ReadProfile($main::prog, pop(@main::profile_files));\n"
        "  my $profile = $data->{profile};\n"
        "  my $pcs = $data->{pcs};\n"
        "  my $libs = $data->{libs};\n"
        "  $symbol_map = MergeSymbols($symbol_map, $data->{symbols});\n"
        "  if (scalar(@main::profile_files) > 0) {\n"
        "    foreach my $pname (@main::profile_files) {\n"
        "      my $data2 = ReadProfile($main::prog, $pname);\n"
        "      $profile = AddProfile($profile, $data2->{profile});\n"
        "      $pcs = AddPcs($pcs, $data2->{pcs});\n"
        "      $symbol_map = MergeSymbols($symbol_map, $data2->{symbols});\n"
        "    }\n"
        "  }\n"
        "  if ($main::opt_base ne '') {\n"
        "    my $base = ReadProfile($main::prog, $main::opt_base);\n"
        "    $profile = SubtractProfile($profile, $base->{profile});\n"
        "    $pcs = AddPcs($pcs, $base->{pcs});\n"
        "    $symbol_map = MergeSymbols($symbol_map, $base->{symbols});\n"
        "  }\n"
        "  my $total = TotalProfile($profile);\n"
        "  my $symbols;\n"
        "  if ($main::use_symbolized_profile) {\n"
        "    $symbols = FetchSymbols($pcs, $symbol_map);\n"
        "  } elsif ($main::use_symbol_page) {\n"
        "    $symbols = FetchSymbols($pcs);\n"
        "  } else {\n"
        "    $symbols = ExtractSymbols($libs, $pcs);\n"
        "  }\n"
        "  $profile = RemoveUninterestingFrames($symbols, $profile);\n"
        "  if ($main::opt_focus ne '') {\n"
        "    $profile = FocusProfile($symbols, $profile, $main::opt_focus);\n"
        "  }\n"
        "  if ($main::opt_ignore ne '') {\n"
        "    $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore);\n"
        "  }\n"
        "  my $calls = ExtractCalls($symbols, $profile);\n"
        "  my $reduced = ReduceProfile($symbols, $profile);\n"
        "  my $flat = FlatProfile($reduced);\n"
        "  my $cumulative = CumulativeProfile($reduced);\n"
        "  if (!$main::opt_interactive) {\n"
        "    if ($main::opt_disasm) {\n"
        "      PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm, $total);\n"
        "    } elsif ($main::opt_list) {\n"
        "      PrintListing($libs, $flat, $cumulative, $main::opt_list);\n"
        "    } elsif ($main::opt_text) {\n"
        "      if ($total != 0) {\n"
        "        printf(\"Total: %s %s\\n\", Unparse($total), Units());\n"
        "      }\n"
        "      PrintText($symbols, $flat, $cumulative, $total, -1);\n"
        "    } elsif ($main::opt_raw) {\n"
        "      PrintSymbolizedProfile($symbols, $profile, $main::prog);\n"
        "    } elsif ($main::opt_callgrind) {\n"
        "      PrintCallgrind($calls);\n"
        "    } else {\n"
        "      if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {\n"
        "        if ($main::opt_gv) {\n"
        "          RunGV(TempName($main::next_tmpfile, \"ps\"), \"\");\n"
        "        } elsif ($main::opt_web) {\n"
        "          my $tmp = TempName($main::next_tmpfile, \"svg\");\n"
        "          RunWeb($tmp);\n"
        "          delete $main::tempnames{$tmp};\n"
        "          if (fork() == 0) {\n"
        "            sleep 5;\n"
        "            unlink($tmp);\n"
        "            exit(0);\n"
        "          }\n"
        "        }\n"
        "      } else {\n"
        "        cleanup();\n"
        "        exit(1);\n"
        "      }\n"
        "    }\n"
        "  } else {\n"
        "    InteractiveMode($profile, $symbols, $libs, $total);\n"
        "  }\n"
        "  cleanup();\n"
        "  exit(0);\n"
        "}\n"
        "Main();\n"
        "sub ReadlineMightFail {\n"
        "  if (-e '/lib/libtermcap.so.2') {\n"
        "    return 0;\n"
        "  } else {\n"
        "    return 1;\n"
        "  }\n"
        "}\n"
        "sub RunGV {\n"
        "  my $fname = shift;\n"
        "  my $bg = shift;\n"
        "  if (!system(\"$GV --version >/dev/null 2>&1\")) {\n"
        "    system(\"$GV --scale=$main::opt_scale --noantialias \" . $fname . $bg);\n"
        "  } else {\n"
        "    print STDERR \"$GV -scale $main::opt_scale\\n\";\n"
        "    system(\"$GV -scale $main::opt_scale \" . $fname . $bg);\n"
        "  }\n"
        "}\n"
        "sub RunWeb {\n"
        "  my $fname = shift;\n"
        "  print STDERR \"Loading web page file:///$fname\\n\";\n"
        "  if (`uname` =~ /Darwin/) {\n"
        "    system(\"/usr/bin/open\", $fname);\n"
        "    return;\n"
        "  }\n"
        "  my @alt = (\n"
        "    \"/etc/alternatives/gnome-www-browser\",\n"
        "    \"/etc/alternatives/x-www-browser\",\n"
        "    \"google-chrome\",\n"
        "    \"firefox\",\n"
        "  );\n"
        "  foreach my $b (@alt) {\n"
        "    if (system($b, $fname) == 0) {\n"
        "      return;\n"
        "    }\n"
        "  }\n"
        "  print STDERR \"Could not load web browser.\\n\";\n"
        "}\n"
        "sub RunKcachegrind {\n"
        "  my $fname = shift;\n"
        "  my $bg = shift;\n"
        "  print STDERR \"Starting '$KCACHEGRIND \" . $fname . $bg . \"'\\n\";\n"
        "  system(\"$KCACHEGRIND \" . $fname . $bg);\n"
        "}\n"
        "sub InteractiveMode {\n"
        "  $| = 1;\n"
        "  my ($orig_profile, $symbols, $libs, $total) = @_;\n"
        "  print STDERR \"Welcome to pprof!  For help, type 'help'.\\n\";\n"
        "  if ( -t STDIN &&\n"
        "       !ReadlineMightFail() &&\n"
        "       defined(eval {require Term::ReadLine}) ) {\n"
        "    my $term = new Term::ReadLine 'pprof';\n"
        "    while ( defined ($_ = $term->readline('(pprof) '))) {\n"
        "      $term->addhistory($_) if /\\S/;\n"
        "      if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {\n"
        "        last;\n"
        "      }\n"
        "    }\n"
        "  } else {\n"
        "    while (1) {\n"
        "      print STDERR \"(pprof) \";\n"
        "      $_ = <STDIN>;\n"
        "      last if ! defined $_ ;\n"
        "      s/\\r//g;\n"
        "      my $save_opt_lines = $main::opt_lines;\n"
        "      if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {\n"
        "        last;\n"
        "      }\n"
        "      $main::opt_lines = $save_opt_lines;\n"
        "    }\n"
        "  }\n"
        "}\n"
        "sub InteractiveCommand {\n"
        "  my($orig_profile, $symbols, $libs, $total, $command) = @_;\n"
        "  $_ = $command;\n"
        "  if (!defined($_)) {\n"
        "    print STDERR \"\\n\";\n"
        "    return 0;\n"
        "  }\n"
        "  if (m/^\\s*quit/) {\n"
        "    return 0;\n"
        "  }\n"
        "  if (m/^\\s*help/) {\n"
        "    InteractiveHelpMessage();\n"
        "    return 1;\n"
        "  }\n"
        "  $main::opt_text = 0;\n"
        "  $main::opt_callgrind = 0;\n"
        "  $main::opt_disasm = 0;\n"
        "  $main::opt_list = 0;\n"
        "  $main::opt_gv = 0;\n"
        "  $main::opt_cum = 0;\n"
        "  if (m/^\\s*(text|top)(\\d*)\\s*(.*)/) {\n"
        "    $main::opt_text = 1;\n"
        "    my $line_limit = ($2 ne \"\") ? int($2) : 10;\n"
        "    my $routine;\n"
        "    my $ignore;\n"
        "    ($routine, $ignore) = ParseInteractiveArgs($3);\n"
        "    my $profile = ProcessProfile($orig_profile, $symbols, \"\", $ignore);\n"
        "    my $reduced = ReduceProfile($symbols, $profile);\n"
        "    my $flat = FlatProfile($reduced);\n"
        "    my $cumulative = CumulativeProfile($reduced);\n"
        "    PrintText($symbols, $flat, $cumulative, $total, $line_limit);\n"
        "    return 1;\n"
        "  }\n"
        "  if (m/^\\s*callgrind\\s*([^ \\n]*)/) {\n"
        "    $main::opt_callgrind = 1;\n"
        "    my $calls = ExtractCalls($symbols, $orig_profile);\n"
        "    my $filename = $1;\n"
        "    if ( $1 eq '' ) {\n"
        "      $filename = TempName($main::next_tmpfile, \"callgrind\");\n"
        "    }\n"
        "    PrintCallgrind($calls, $filename);\n"
        "    if ( $1 eq '' ) {\n"
        "      RunKcachegrind($filename, \" & \");\n"
        "      $main::next_tmpfile++;\n"
        "    }\n"
        "    return 1;\n"
        "  }\n"
        "  if (m/^\\s*list\\s*(.+)/) {\n"
        "    $main::opt_list = 1;\n"
        "    my $routine;\n"
        "    my $ignore;\n"
        "    ($routine, $ignore) = ParseInteractiveArgs($1);\n"
        "    my $profile = ProcessProfile($orig_profile, $symbols, \"\", $ignore);\n"
        "    my $reduced = ReduceProfile($symbols, $profile);\n"
        "    my $flat = FlatProfile($reduced);\n"
        "    my $cumulative = CumulativeProfile($reduced);\n"
        "    PrintListing($libs, $flat, $cumulative, $routine);\n"
        "    return 1;\n"
        "  }\n"
        "  if (m/^\\s*disasm\\s*(.+)/) {\n"
        "    $main::opt_disasm = 1;\n"
        "    my $routine;\n"
        "    my $ignore;\n"
        "    ($routine, $ignore) = ParseInteractiveArgs($1);\n"
        "    my $profile = ProcessProfile($orig_profile, $symbols, \"\", $ignore);\n"
        "    my $reduced = ReduceProfile($symbols, $profile);\n"
        "    my $flat = FlatProfile($reduced);\n"
        "    my $cumulative = CumulativeProfile($reduced);\n"
        "    PrintDisassembly($libs, $flat, $cumulative, $routine, $total);\n"
        "    return 1;\n"
        "  }\n"
        "  if (m/^\\s*(gv|web)\\s*(.*)/) {\n"
        "    $main::opt_gv = 0;\n"
        "    $main::opt_web = 0;\n"
        "    if ($1 eq \"gv\") {\n"
        "      $main::opt_gv = 1;\n"
        "    } elsif ($1 eq \"web\") {\n"
        "      $main::opt_web = 1;\n"
        "    }\n"
        "    my $focus;\n"
        "    my $ignore;\n"
        "    ($focus, $ignore) = ParseInteractiveArgs($2);\n"
        "    my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore);\n"
        "    my $reduced = ReduceProfile($symbols, $profile);\n"
        "    my $flat = FlatProfile($reduced);\n"
        "    my $cumulative = CumulativeProfile($reduced);\n"
        "    if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {\n"
        "      if ($main::opt_gv) {\n"
        "        RunGV(TempName($main::next_tmpfile, \"ps\"), \" &\");\n"
        "      } elsif ($main::opt_web) {\n"
        "        RunWeb(TempName($main::next_tmpfile, \"svg\"));\n"
        "      }\n"
        "      $main::next_tmpfile++;\n"
        "    }\n"
        "    return 1;\n"
        "  }\n"
        "  if (m/^\\s*$/) {\n"
        "    return 1;\n"
        "  }\n"
        "  print STDERR \"Unknown command: try 'help'.\\n\";\n"
        "  return 1;\n"
        "}\n"
        "sub ProcessProfile {\n"
        "  my $orig_profile = shift;\n"
        "  my $symbols = shift;\n"
        "  my $focus = shift;\n"
        "  my $ignore = shift;\n"
        "  my $profile = $orig_profile;\n"
        "  my $total_count = TotalProfile($profile);\n"
        "  printf(\"Total: %s %s\\n\", Unparse($total_count), Units());\n"
        "  if ($focus ne '') {\n"
        "    $profile = FocusProfile($symbols, $profile, $focus);\n"
        "    my $focus_count = TotalProfile($profile);\n"
        "    printf(\"After focusing on '%s': %s %s of %s (%0.1f%%)\\n\",\n"
        "           $focus,\n"
        "           Unparse($focus_count), Units(),\n"
        "           Unparse($total_count), ($focus_count*100.0) / $total_count);\n"
        "  }\n"
        "  if ($ignore ne '') {\n"
        "    $profile = IgnoreProfile($symbols, $profile, $ignore);\n"
        "    my $ignore_count = TotalProfile($profile);\n"
        "    printf(\"After ignoring '%s': %s %s of %s (%0.1f%%)\\n\",\n"
        "           $ignore,\n"
        "           Unparse($ignore_count), Units(),\n"
        "           Unparse($total_count),\n"
        "           ($ignore_count*100.0) / $total_count);\n"
        "  }\n"
        "  return $profile;\n"
        "}\n"
        "sub InteractiveHelpMessage {\n"
        "  print STDERR <<ENDOFHELP;\n"
        "Interactive pprof mode\n"
        "Commands:\n"
        "  gv\n"
        "  gv [focus] [-ignore1] [-ignore2]\n"
        "      Show graphical hierarchical display of current profile.  Without\n"
        "      any arguments, shows all samples in the profile.  With the optional\n"
        "      \"focus\" argument, restricts the samples shown to just those where\n"
        "      the \"focus\" regular expression matches a routine name on the stack\n"
        "      trace.\n"
        "  web\n"
        "  web [focus] [-ignore1] [-ignore2]\n"
        "      Like GV, but displays profile in your web browser instead of using\n"
        "      Ghostview. Works best if your web browser is already running.\n"
        "      To change the browser that gets used:\n"
        "      On Linux, set the /etc/alternatives/gnome-www-browser symlink.\n"
        "      On OS X, change the Finder association for SVG files.\n"
        "  list [routine_regexp] [-ignore1] [-ignore2]\n"
        "      Show source listing of routines whose names match \"routine_regexp\"\n"
        "  top [--cum] [-ignore1] [-ignore2]\n"
        "  top20 [--cum] [-ignore1] [-ignore2]\n"
        "  top37 [--cum] [-ignore1] [-ignore2]\n"
        "      Show top lines ordered by flat profile count, or cumulative count\n"
        "      if --cum is specified.  If a number is present after 'top', the\n"
        "      top K routines will be shown (defaults to showing the top 10)\n"
        "  disasm [routine_regexp] [-ignore1] [-ignore2]\n"
        "      Show disassembly of routines whose names match \"routine_regexp\",\n"
        "      annotated with sample counts.\n"
        "  callgrind\n"
        "  callgrind [filename]\n"
        "      Generates callgrind file. If no filename is given, kcachegrind is called.\n"
        "  help - This listing\n"
        "  quit or ^D - End pprof\n"
        "For commands that accept optional -ignore tags, samples where any routine in\n"
        "the stack trace matches the regular expression in any of the -ignore\n"
        "parameters will be ignored.\n"
        "Further pprof details are available at this location (or one similar):\n"
        " /usr/doc/google-perftools-$PPROF_VERSION/cpu_profiler.html\n"
        " /usr/doc/google-perftools-$PPROF_VERSION/heap_profiler.html\n"
        "ENDOFHELP\n"
        "}\n"
        "sub ParseInteractiveArgs {\n"
        "  my $args = shift;\n"
        "  my $focus = \"\";\n"
        "  my $ignore = \"\";\n"
        "  my @x = split(/ +/, $args);\n"
        "  foreach $a (@x) {\n"
        "    if ($a =~ m/^(--|-)lines$/) {\n"
        "      $main::opt_lines = 1;\n"
        "    } elsif ($a =~ m/^(--|-)cum$/) {\n"
        "      $main::opt_cum = 1;\n"
        "    } elsif ($a =~ m/^-(.*)/) {\n"
        "      $ignore .= (($ignore ne \"\") ? \"|\" : \"\" ) . $1;\n"
        "    } else {\n"
        "      $focus .= (($focus ne \"\") ? \"|\" : \"\" ) . $a;\n"
        "    }\n"
        "  }\n"
        "  if ($ignore ne \"\") {\n"
        "    print STDERR \"Ignoring samples in call stacks that match '$ignore'\\n\";\n"
        "  }\n"
        "  return ($focus, $ignore);\n"
        "}\n"
        "sub TempName {\n"
        "  my $fnum = shift;\n"
        "  my $ext = shift;\n"
        "  my $file = \"$main::tmpfile_ps.$fnum.$ext\";\n"
        "  $main::tempnames{$file} = 1;\n"
        "  return $file;\n"
        "}\n"
        "sub PrintProfileData {\n"
        "  my $profile = shift;\n"
        "  print pack('L*', 0, 0, 3, 0, 0, 0, 1, 0, 0, 0);\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    if ($#addrs >= 0) {\n"
        "      my $depth = $#addrs + 1;\n"
        "      print pack('L*', $count & 0xFFFFFFFF, int($count / 2**32));\n"
        "      print pack('L*', $depth & 0xFFFFFFFF, int($depth / 2**32));\n"
        "      foreach my $full_addr (@addrs) {\n"
        "        my $addr = $full_addr;\n"
        "        $addr =~ s/0x0*//;\n"
        "        if (length($addr) > 16) {\n"
        "          print STDERR \"Invalid address in profile: $full_addr\\n\";\n"
        "          next;\n"
        "        }\n"
        "        my $low_addr = substr($addr, -8);\n"
        "        my $high_addr = substr($addr, -16, 8);\n"
        "        print pack('L*', hex('0x' . $low_addr), hex('0x' . $high_addr));\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "}\n"
        "sub PrintSymbolizedProfile {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my $prog = shift;\n"
        "  $SYMBOL_PAGE =~ m,[^/]+$,;\n"
        "  my $symbol_marker = $&;\n"
        "  print '--- ', $symbol_marker, \"\\n\";\n"
        "  if (defined($prog)) {\n"
        "    print 'binary=', $prog, \"\\n\";\n"
        "  }\n"
        "  while (my ($pc, $name) = each(%{$symbols})) {\n"
        "    my $sep = ' ';\n"
        "    print '0x', $pc;\n"
        "    for (my $j = 2; $j <= $#{$name}; $j += 3) {\n"
        "      print $sep, $name->[$j];\n"
        "      $sep = '--';\n"
        "    }\n"
        "    print \"\\n\";\n"
        "  }\n"
        "  print '---', \"\\n\";\n"
        "  $PROFILE_PAGE =~ m,[^/]+$,;\n"
        "  my $profile_marker = $&;\n"
        "  print '--- ', $profile_marker, \"\\n\";\n"
        "  if (defined($main::collected_profile)) {\n"
        "    open(SRC, \"<$main::collected_profile\");\n"
        "    while (<SRC>) {\n"
        "      print $_;\n"
        "    }\n"
        "    close(SRC);\n"
        "  } else {\n"
        "    PrintProfileData($profile);\n"
        "  }\n"
        "}\n"
        "sub PrintText {\n"
        "  my $symbols = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $total = shift;\n"
        "  my $line_limit = shift;\n"
        "  my $s = $main::opt_cum ? $cumulative : $flat;\n"
        "  my $running_sum = 0;\n"
        "  my $lines = 0;\n"
        "  foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b }\n"
        "                 keys(%{$cumulative})) {\n"
        "    my $f = GetEntry($flat, $k);\n"
        "    my $c = GetEntry($cumulative, $k);\n"
        "    $running_sum += $f;\n"
        "    my $sym = $k;\n"
        "    if (exists($symbols->{$k})) {\n"
        "      $sym = $symbols->{$k}->[0] . \" \" . $symbols->{$k}->[1];\n"
        "      if ($main::opt_addresses) {\n"
        "        $sym = $k . \" \" . $sym;\n"
        "      }\n"
        "    }\n"
        "    if ($f != 0 || $c != 0) {\n"
        "      printf(\"%8s %6s %6s %8s %6s %s\\n\",\n"
        "             Unparse($f),\n"
        "             Percent($f, $total),\n"
        "             Percent($running_sum, $total),\n"
        "             Unparse($c),\n"
        "             Percent($c, $total),\n"
        "             $sym);\n"
        "    }\n"
        "    $lines++;\n"
        "    last if ($line_limit >= 0 && $lines > $line_limit);\n"
        "  }\n"
        "}\n"
        "sub PrintCallgrind {\n"
        "  my $calls = shift;\n"
        "  my $filename;\n"
        "  if ($main::opt_interactive) {\n"
        "    $filename = shift;\n"
        "    print STDERR \"Writing callgrind file to '$filename'.\\n\"\n"
        "  } else {\n"
        "    $filename = \"&STDOUT\";\n"
        "  }\n"
        "  open(CG, \">\".$filename );\n"
        "  printf CG (\"events: Hits\\n\\n\");\n"
        "  foreach my $call ( map { $_->[0] }\n"
        "                     sort { $a->[1] cmp $b ->[1] ||\n"
        "                            $a->[2] <=> $b->[2] }\n"
        "                     map { /([^:]+):(\\d+):([^ ]+)( -> ([^:]+):(\\d+):(.+))?/;\n"
        "                           [$_, $1, $2] }\n"
        "                     keys %$calls ) {\n"
        "    my $count = int($calls->{$call});\n"
        "    $call =~ /([^:]+):(\\d+):([^ ]+)( -> ([^:]+):(\\d+):(.+))?/;\n"
        "    my ( $caller_file, $caller_line, $caller_function,\n"
        "         $callee_file, $callee_line, $callee_function ) =\n"
        "       ( $1, $2, $3, $5, $6, $7 );\n"
        "    printf CG (\"fl=$caller_file\\nfn=$caller_function\\n\");\n"
        "    if (defined $6) {\n"
        "      printf CG (\"cfl=$callee_file\\n\");\n"
        "      printf CG (\"cfn=$callee_function\\n\");\n"
        "      printf CG (\"calls=$count $callee_line\\n\");\n"
        "    }\n"
        "    printf CG (\"$caller_line $count\\n\\n\");\n"
        "  }\n"
        "}\n"
        "sub PrintDisassembly {\n"
        "  my $libs = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $disasm_opts = shift;\n"
        "  my $total = shift;\n"
        "  foreach my $lib (@{$libs}) {\n"
        "    my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts);\n"
        "    my $offset = AddressSub($lib->[1], $lib->[3]);\n"
        "    foreach my $routine (sort ByName keys(%{$symbol_table})) {\n"
        "      my $start_addr = $symbol_table->{$routine}->[0];\n"
        "      my $end_addr = $symbol_table->{$routine}->[1];\n"
        "      my $length = hex(AddressSub($end_addr, $start_addr));\n"
        "      my $addr = AddressAdd($start_addr, $offset);\n"
        "      for (my $i = 0; $i < $length; $i++) {\n"
        "        if (defined($cumulative->{$addr})) {\n"
        "          PrintDisassembledFunction($lib->[0], $offset,\n"
        "                                    $routine, $flat, $cumulative,\n"
        "                                    $start_addr, $end_addr, $total);\n"
        "          last;\n"
        "        }\n"
        "        $addr = AddressInc($addr);\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "}\n"
        "sub Disassemble {\n"
        "  my $prog = shift;\n"
        "  my $offset = shift;\n"
        "  my $start_addr = shift;\n"
        "  my $end_addr = shift;\n"
        "  my $objdump = $obj_tool_map{\"objdump\"};\n"
        "  my $cmd = sprintf(\"$objdump -C -d -l --no-show-raw-insn \" .\n"
        "                    \"--start-address=0x$start_addr \" .\n"
        "                    \"--stop-address=0x$end_addr $prog\");\n"
        "  open(OBJDUMP, \"$cmd |\") || error(\"$objdump: $!\\n\");\n"
        "  my @result = ();\n"
        "  my $filename = \"\";\n"
        "  my $linenumber = -1;\n"
        "  my $last = [\"\", \"\", \"\", \"\"];\n"
        "  while (<OBJDUMP>) {\n"
        "    s/\\r//g;\n"
        "    chop;\n"
        "    if (m|\\s*([^:\\s]+):(\\d+)\\s*$|) {\n"
        "      $filename = $1;\n"
        "      $linenumber = $2;\n"
        "    } elsif (m/^ +([0-9a-f]+):\\s*(.*)/) {\n"
        "      my $addr = HexExtend($1);\n"
        "      my $k = AddressAdd($addr, $offset);\n"
        "      $last->[4] = $k;\n"
        "      $last = [$k, $filename, $linenumber, $2, $end_addr];\n"
        "      push(@result, $last);\n"
        "    }\n"
        "  }\n"
        "  close(OBJDUMP);\n"
        "  return @result;\n"
        "}\n"
        "sub PrintSymbols {\n"
        "  my $maps_and_symbols_file = shift;\n"
        "  my @pclist = ();\n"
        "  my $pcs = {};\n"
        "  my $map = \"\";\n"
        "  foreach my $line (<$maps_and_symbols_file>) {\n"
        "    $line =~ s/\\r//g;\n"
        "    if ($line =~ /\\b(0x[0-9a-f]+)\\b/i) {\n"
        "      push(@pclist, HexExtend($1));\n"
        "      $pcs->{$pclist[-1]} = 1;\n"
        "    } else {\n"
        "      $map .= $line;\n"
        "    }\n"
        "  }\n"
        "  my $libs = ParseLibraries($main::prog, $map, $pcs);\n"
        "  my $symbols = ExtractSymbols($libs, $pcs);\n"
        "  foreach my $pc (@pclist) {\n"
        "    print(($symbols->{$pc}->[0] || \"\?\?\") . \"\\n\");\n"
        "  }\n"
        "}\n"
        "sub ByName {\n"
        "  return ShortFunctionName($a) cmp ShortFunctionName($b);\n"
        "}\n"
        "sub PrintListing {\n"
        "  my $libs = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $list_opts = shift;\n"
        "  foreach my $lib (@{$libs}) {\n"
        "    my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts);\n"
        "    my $offset = AddressSub($lib->[1], $lib->[3]);\n"
        "    foreach my $routine (sort ByName keys(%{$symbol_table})) {\n"
        "      my $start_addr = $symbol_table->{$routine}->[0];\n"
        "      my $end_addr = $symbol_table->{$routine}->[1];\n"
        "      my $length = hex(AddressSub($end_addr, $start_addr));\n"
        "      my $addr = AddressAdd($start_addr, $offset);\n"
        "      for (my $i = 0; $i < $length; $i++) {\n"
        "        if (defined($cumulative->{$addr})) {\n"
        "          PrintSource($lib->[0], $offset,\n"
        "                      $routine, $flat, $cumulative,\n"
        "                      $start_addr, $end_addr);\n"
        "          last;\n"
        "        }\n"
        "        $addr = AddressInc($addr);\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "}\n"
        "sub Indentation {\n"
        "  my $line = shift;\n"
        "  if (m/^(\\s*)\\S/) {\n"
        "    return length($1);\n"
        "  } else {\n"
        "    return -1;\n"
        "  }\n"
        "}\n"
        "sub PrintSource {\n"
        "  my $prog = shift;\n"
        "  my $offset = shift;\n"
        "  my $routine = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $start_addr = shift;\n"
        "  my $end_addr = shift;\n"
        "  my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);\n"
        "  my $filename = undef;\n"
        "  for (my $i = 0; $i <= $#instructions; $i++) {\n"
        "    if ($instructions[$i]->[2] >= 0) {\n"
        "      $filename = $instructions[$i]->[1];\n"
        "      last;\n"
        "    }\n"
        "  }\n"
        "  if (!defined($filename)) {\n"
        "    print STDERR \"no filename found in $routine\\n\";\n"
        "    return;\n"
        "  }\n"
        "  my $lastline = 0;\n"
        "  for (my $i = 0; $i <= $#instructions; $i++) {\n"
        "    my $f = $instructions[$i]->[1];\n"
        "    my $l = $instructions[$i]->[2];\n"
        "    if (($f eq $filename) && ($l > $lastline)) {\n"
        "      $lastline = $l;\n"
        "    }\n"
        "  }\n"
        "  my $firstline = 1;\n"
        "  for (my $i = 0; $i <= $#instructions; $i++) {\n"
        "    if ($instructions[$i]->[1] eq $filename) {\n"
        "      $firstline = $instructions[$i]->[2];\n"
        "      last;\n"
        "    }\n"
        "  }\n"
        "  my $oldlastline = $lastline;\n"
        "  {\n"
        "    if (!open(FILE, \"<$filename\")) {\n"
        "      print STDERR \"$filename: $!\\n\";\n"
        "      return;\n"
        "    }\n"
        "    my $l = 0;\n"
        "    my $first_indentation = -1;\n"
        "    while (<FILE>) {\n"
        "      s/\\r//g;\n"
        "      $l++;\n"
        "      my $indent = Indentation($_);\n"
        "      if ($l >= $firstline) {\n"
        "        if ($first_indentation < 0 && $indent >= 0) {\n"
        "          $first_indentation = $indent;\n"
        "          last if ($first_indentation == 0);\n"
        "        }\n"
        "      }\n"
        "      if ($l >= $lastline && $indent >= 0) {\n"
        "        if ($indent >= $first_indentation) {\n"
        "          $lastline = $l+1;\n"
        "        } else {\n"
        "          last;\n"
        "        }\n"
        "      }\n"
        "    }\n"
        "    close(FILE);\n"
        "  }\n"
        "  my $samples1 = {};\n"
        "  my $samples2 = {};\n"
        "  my $running1 = 0;\n"
        "  my $running2 = 0;\n"
        "  my $total1 = 0;\n"
        "  my $total2 = 0;\n"
        "  foreach my $e (@instructions) {\n"
        "    my $c1 = 0;\n"
        "    my $c2 = 0;\n"
        "    for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {\n"
        "      $c1 += GetEntry($flat, $a);\n"
        "      $c2 += GetEntry($cumulative, $a);\n"
        "    }\n"
        "    $running1 += $c1;\n"
        "    $running2 += $c2;\n"
        "    $total1 += $c1;\n"
        "    $total2 += $c2;\n"
        "    my $file = $e->[1];\n"
        "    my $line = $e->[2];\n"
        "    if (($file eq $filename) &&\n"
        "        ($line >= $firstline) &&\n"
        "        ($line <= $lastline)) {\n"
        "      AddEntry($samples1, $line, $running1);\n"
        "      AddEntry($samples2, $line, $running2);\n"
        "      $running1 = 0;\n"
        "      $running2 = 0;\n"
        "    }\n"
        "  }\n"
        "  AddEntry($samples1, $lastline, $running1);\n"
        "  AddEntry($samples2, $lastline, $running2);\n"
        "  printf(\"ROUTINE ====================== %s in %s\\n\" .\n"
        "         \"%6s %6s Total %s (flat / cumulative)\\n\",\n"
        "         ShortFunctionName($routine),\n"
        "         $filename,\n"
        "         Units(),\n"
        "         Unparse($total1),\n"
        "         Unparse($total2));\n"
        "  if (!open(FILE, \"<$filename\")) {\n"
        "    print STDERR \"$filename: $!\\n\";\n"
        "    return;\n"
        "  }\n"
        "  my $l = 0;\n"
        "  while (<FILE>) {\n"
        "    s/\\r//g;\n"
        "    $l++;\n"
        "    if ($l >= $firstline - 5 &&\n"
        "        (($l <= $oldlastline + 5) || ($l <= $lastline))) {\n"
        "      chop;\n"
        "      my $text = $_;\n"
        "      if ($l == $firstline) { printf(\"---\\n\"); }\n"
        "      printf(\"%6s %6s %4d: %s\\n\",\n"
        "             UnparseAlt(GetEntry($samples1, $l)),\n"
        "             UnparseAlt(GetEntry($samples2, $l)),\n"
        "             $l,\n"
        "             $text);\n"
        "      if ($l == $lastline)  { printf(\"---\\n\"); }\n"
        "    };\n"
        "  }\n"
        "  close(FILE);\n"
        "}\n"
        "sub SourceLine {\n"
        "  my $file = shift;\n"
        "  my $line = shift;\n"
        "  if (!defined($main::source_cache{$file})) {\n"
        "    if (100 < scalar keys(%main::source_cache)) {\n"
        "      $main::source_cache = ();\n"
        "    }\n"
        "    if (!open(FILE, \"<$file\")) {\n"
        "      print STDERR \"$file: $!\\n\";\n"
        "      $main::source_cache{$file} = [];\n"
        "      return undef;\n"
        "    }\n"
        "    my $lines = [];\n"
        "    push(@{$lines}, \"\");\n"
        "    while (<FILE>) {\n"
        "      push(@{$lines}, $_);\n"
        "    }\n"
        "    close(FILE);\n"
        "    $main::source_cache{$file} = $lines;\n"
        "  }\n"
        "  my $lines = $main::source_cache{$file};\n"
        "  if (($line < 0) || ($line > $#{$lines})) {\n"
        "    return undef;\n"
        "  } else {\n"
        "    return $lines->[$line];\n"
        "  }\n"
        "}\n"
        "sub PrintDisassembledFunction {\n"
        "  my $prog = shift;\n"
        "  my $offset = shift;\n"
        "  my $routine = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $start_addr = shift;\n"
        "  my $end_addr = shift;\n"
        "  my $total = shift;\n"
        "  my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);\n"
        "  my @flat_count = ();\n"
        "  my @cum_count = ();\n"
        "  my $flat_total = 0;\n"
        "  my $cum_total = 0;\n"
        "  foreach my $e (@instructions) {\n"
        "    my $c1 = 0;\n"
        "    my $c2 = 0;\n"
        "    for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {\n"
        "      $c1 += GetEntry($flat, $a);\n"
        "      $c2 += GetEntry($cumulative, $a);\n"
        "    }\n"
        "    push(@flat_count, $c1);\n"
        "    push(@cum_count, $c2);\n"
        "    $flat_total += $c1;\n"
        "    $cum_total += $c2;\n"
        "  }\n"
        "  printf(\"ROUTINE ====================== %s\\n\" .\n"
        "         \"%6s %6s %s (flat, cumulative) %.1f%% of total\\n\",\n"
        "         ShortFunctionName($routine),\n"
        "         Unparse($flat_total),\n"
        "         Unparse($cum_total),\n"
        "         Units(),\n"
        "         ($cum_total * 100.0) / $total);\n"
        "  my $current_file = \"\";\n"
        "  for (my $i = 0; $i <= $#instructions; ) {\n"
        "    my $e = $instructions[$i];\n"
        "    if ($e->[1] ne $current_file) {\n"
        "      $current_file = $e->[1];\n"
        "      my $fname = $current_file;\n"
        "      $fname =~ s|^\\./||;\n"
        "      if (length($fname) >= 58) {\n"
        "        $fname = \"...\" . substr($fname, -55);\n"
        "      }\n"
        "      printf(\"-------------------- %s\\n\", $fname);\n"
        "    }\n"
        "    my $first_line = $e->[2];\n"
        "    my $last_line = $first_line;\n"
        "    my %flat_sum = ();\n"
        "    my %cum_sum = ();\n"
        "    for (my $l = $first_line; $l <= $last_line; $l++) {\n"
        "      $flat_sum{$l} = 0;\n"
        "      $cum_sum{$l} = 0;\n"
        "    }\n"
        "    my $first_inst = $i;\n"
        "    while (($i <= $#instructions) &&\n"
        "           ($instructions[$i]->[2] >= $first_line) &&\n"
        "           ($instructions[$i]->[2] <= $last_line)) {\n"
        "      $e = $instructions[$i];\n"
        "      $flat_sum{$e->[2]} += $flat_count[$i];\n"
        "      $cum_sum{$e->[2]} += $cum_count[$i];\n"
        "      $i++;\n"
        "    }\n"
        "    my $last_inst = $i - 1;\n"
        "    for (my $l = $first_line; $l <= $last_line; $l++) {\n"
        "      my $line = SourceLine($current_file, $l);\n"
        "      if (!defined($line)) {\n"
        "        $line = \"?\\n\";\n"
        "        next;\n"
        "      } else {\n"
        "        $line =~ s/^\\s+//;\n"
        "      }\n"
        "      printf(\"%6s %6s %5d: %s\",\n"
        "             UnparseAlt($flat_sum{$l}),\n"
        "             UnparseAlt($cum_sum{$l}),\n"
        "             $l,\n"
        "             $line);\n"
        "    }\n"
        "    for (my $x = $first_inst; $x <= $last_inst; $x++) {\n"
        "      my $e = $instructions[$x];\n"
        "      my $address = $e->[0];\n"
        "      $address = AddressSub($address, $offset);\n"
        "      $address =~ s/^0x//;\n"
        "      $address =~ s/^0*//;\n"
        "      my $d = $e->[3];\n"
        "      while ($d =~ s/\\([^()%]*\\)(\\s*const)?//g) { }\n"
        "      while ($d =~ s/(\\w+)<[^<>]*>/$1/g)  { }\n"
        "      printf(\"%6s %6s    %8s: %6s\\n\",\n"
        "             UnparseAlt($flat_count[$x]),\n"
        "             UnparseAlt($cum_count[$x]),\n"
        "             $address,\n"
        "             $d);\n"
        "    }\n"
        "  }\n"
        "}\n"
        "sub PrintDot {\n"
        "  my $prog = shift;\n"
        "  my $symbols = shift;\n"
        "  my $raw = shift;\n"
        "  my $flat = shift;\n"
        "  my $cumulative = shift;\n"
        "  my $overall_total = shift;\n"
        "  my $local_total = TotalProfile($flat);\n"
        "  my $nodelimit = int($main::opt_nodefraction * $local_total);\n"
        "  my $edgelimit = int($main::opt_edgefraction * $local_total);\n"
        "  my $nodecount = $main::opt_nodecount;\n"
        "  my @list = (sort { abs(GetEntry($cumulative, $b)) <=>\n"
        "                     abs(GetEntry($cumulative, $a))\n"
        "                     || $a cmp $b }\n"
        "              keys(%{$cumulative}));\n"
        "  my $last = $nodecount - 1;\n"
        "  if ($last > $#list) {\n"
        "    $last = $#list;\n"
        "  }\n"
        "  while (($last >= 0) &&\n"
        "         (abs(GetEntry($cumulative, $list[$last])) <= $nodelimit)) {\n"
        "    $last--;\n"
        "  }\n"
        "  if ($last < 0) {\n"
        "    print STDERR \"No nodes to print\\n\";\n"
        "    return 0;\n"
        "  }\n"
        "  if ($nodelimit > 0 || $edgelimit > 0) {\n"
        "    printf STDERR (\"Dropping nodes with <= %s %s; edges with <= %s abs(%s)\\n\",\n"
        "                   Unparse($nodelimit), Units(),\n"
        "                   Unparse($edgelimit), Units());\n"
        "  }\n"
        "  my $output;\n"
        "  if ($main::opt_gv) {\n"
        "    $output = \"| $DOT -Tps2 >\" . TempName($main::next_tmpfile, \"ps\");\n"
        "  } elsif ($main::opt_ps) {\n"
        "    $output = \"| $DOT -Tps2\";\n"
        "  } elsif ($main::opt_pdf) {\n"
        "    $output = \"| $DOT -Tps2 | $PS2PDF - -\";\n"
        "  } elsif ($main::opt_web || $main::opt_svg) {\n"
        "    $output = \"| $DOT -Tsvg >\" . TempName($main::next_tmpfile, \"svg\");\n"
        "  } elsif ($main::opt_gif) {\n"
        "    $output = \"| $DOT -Tgif\";\n"
        "  } else {\n"
        "    $output = \">&STDOUT\";\n"
        "  }\n"
        "  open(DOT, $output) || error(\"$output: $!\\n\");\n"
        "  printf DOT (\"digraph \\\"%s; %s %s\\\" {\\n\",\n"
        "              $prog,\n"
        "              Unparse($overall_total),\n"
        "              Units());\n"
        "  if ($main::opt_pdf) {\n"
        "    printf DOT (\"size=\\\"8,11\\\"\\n\");\n"
        "  }\n"
        "  printf DOT (\"node [width=0.375,height=0.25];\\n\");\n"
        "  printf DOT (\"Legend [shape=box,fontsize=20,shape=plaintext,\" .\n"
        "              \"label=\\\"%s\\\\l%s\\\\l%s\\\\l%s\\\\l%s\\\\l\\\"];\\n\",\n"
        "              $prog,\n"
        "              sprintf(\"Total %s: %s\", Units(), Unparse($overall_total)),\n"
        "              sprintf(\"Focusing on: %s\", Unparse($local_total)),\n"
        "              sprintf(\"Dropped nodes with <= %s abs(%s)\",\n"
        "                      Unparse($nodelimit), Units()),\n"
        "              sprintf(\"Dropped edges with <= %s %s\",\n"
        "                      Unparse($edgelimit), Units())\n"
        "              );\n"
        "  my %node = ();\n"
        "  my $nextnode = 1;\n"
        "  foreach my $a (@list[0..$last]) {\n"
        "    my $f = GetEntry($flat, $a);\n"
        "    my $c = GetEntry($cumulative, $a);\n"
        "    my $fs = 8;\n"
        "    if ($local_total > 0) {\n"
        "      $fs = 8 + (50.0 * sqrt(abs($f * 1.0 / $local_total)));\n"
        "    }\n"
        "    $node{$a} = $nextnode++;\n"
        "    my $sym = $a;\n"
        "    $sym =~ s/\\s+/\\\\n/g;\n"
        "    $sym =~ s/::/\\\\n/g;\n"
        "    my $extra = \"\";\n"
        "    if ($f != $c) {\n"
        "      $extra = sprintf(\"\\\\rof %s (%s)\",\n"
        "                       Unparse($c),\n"
        "                       Percent($c, $overall_total));\n"
        "    }\n"
        "    my $style = \"\";\n"
        "    if ($main::opt_heapcheck) {\n"
        "      if ($f > 0) {\n"
        "        $style = \",style=filled,fillcolor=gray\"\n"
        "      } elsif ($f < 0) {\n"
        "        $style = \",peripheries=3\"\n"
        "      }\n"
        "    }\n"
        "    printf DOT (\"N%d [label=\\\"%s\\\\n%s (%s)%s\\\\r\" .\n"
        "                \"\\\",shape=box,fontsize=%.1f%s];\\n\",\n"
        "                $node{$a},\n"
        "                $sym,\n"
        "                Unparse($f),\n"
        "                Percent($f, $overall_total),\n"
        "                $extra,\n"
        "                $fs,\n"
        "                $style,\n"
        "               );\n"
        "  }\n"
        "  my %edge = ();\n"
        "  my $n;\n"
        "  foreach my $k (keys(%{$raw})) {\n"
        "    $n = $raw->{$k};\n"
        "    my @translated = TranslateStack($symbols, $k);\n"
        "    for (my $i = 1; $i <= $#translated; $i++) {\n"
        "      my $src = $translated[$i];\n"
        "      my $dst = $translated[$i-1];\n"
        "      #next if ($src eq $dst);\n"
        "      if (exists($node{$src}) && exists($node{$dst})) {\n"
        "        my $edge_label = \"$src\\001$dst\";\n"
        "        if (!exists($edge{$edge_label})) {\n"
        "          $edge{$edge_label} = 0;\n"
        "        }\n"
        "        $edge{$edge_label} += $n;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  foreach my $e (keys(%edge)) {\n"
        "    my @x = split(/\\001/, $e);\n"
        "    $n = $edge{$e};\n"
        "    if (abs($n) > $edgelimit) {\n"
        "      my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0);\n"
        "      if ($fraction > 1) { $fraction = 1; }\n"
        "      my $w = $fraction * 2;\n"
        "      if ($w < 0.5 && ($main::opt_dot || $main::opt_web || $main::opt_svg)) {\n"
        // NOTE: We transfer dot to svg at browser side, also need to limit width for dot.
        "        $w = 0.5;\n"
        "      }\n"
        "      my $edgeweight = abs($n) ** 0.7;\n"
        "      if ($edgeweight > 100000) { $edgeweight = 100000; }\n"
        "      $edgeweight = int($edgeweight);\n"
        "      my $style = sprintf(\"setlinewidth(%f)\", $w);\n"
        "      if ($x[1] =~ m/\\(inline\\)/) {\n"
        "        $style .= \",dashed\";\n"
        "      }\n"
        "      printf DOT (\"N%s -> N%s [label=%s, weight=%d, style=\\\"%s\\\"];\\n\",\n"
        "                  $node{$x[0]},\n"
        "                  $node{$x[1]},\n"
        "                  Unparse($n),\n"
        "                  $edgeweight,\n"
        "                  $style);\n"
        "    }\n"
        "  }\n"
        "  print DOT (\"}\\n\");\n"
        "  close(DOT);\n"
        "  if ($main::opt_web || $main::opt_svg) {\n"
        "    RewriteSvg(TempName($main::next_tmpfile, \"svg\"));\n"
        "  }\n"
        "  return 1;\n"
        "}\n"
        "sub RewriteSvg {\n"
        "  my $svgfile = shift;\n"
        "  open(SVG, $svgfile) || die \"open temp svg: $!\";\n"
        "  my @svg = <SVG>;\n"
        "  close(SVG);\n"
        "  unlink $svgfile;\n"
        "  my $svg = join('', @svg);\n"
        "  #\n"
        "  #\n"
        "  #\n"
        "  $svg =~ s/(?s)<svg width=\"[^\"]+\" height=\"[^\"]+\"(.*?)viewBox=\"[^\"]+\"/<svg width=\"100%\" height=\"100%\"$1/;\n"
        "  my $svg_javascript = SvgJavascript();\n"
        "  my $viewport = \"<g id=\\\"viewport\\\" transform=\\\"translate(0,0)\\\">\\n\";\n"
        "  $svg =~ s/<g id=\"graph\\d\"/$svg_javascript$viewport$&/;\n"
        "  $svg =~ s/(.*)(<\\/svg>)/$1<\\/g>$2/;\n"
        "  $svg =~ s/<g id=\"graph\\d\"(.*?)/<g id=\"viewport\"$1/;\n"
        "  if ($main::opt_svg) {\n"
        "    print $svg;\n"
        "  } else {\n"
        "    open(SVG, \">$svgfile\") || die \"open $svgfile: $!\";\n"
        "    print SVG $svg;\n"
        "    close(SVG);\n"
        "  }\n"
        "}\n"
        "sub SvgJavascript {\n"
        "  return <<'EOF';\n"
        "<script type=\"text/ecmascript\"><![CDATA[\n"
        "// SVGPan\n"
        "// http://www.cyberz.org/blog/2009/12/08/svgpan-a-javascript-svg-panzoomdrag-library/\n"
        "// Local modification: if(true || ...) below to force panning, never moving.\n"
        "/**\n"
        " *  SVGPan library 1.2\n"
        " * ====================\n"
        " *\n"
        " * Given an unique existing element with id \"viewport\", including the\n"
        " * the library into any SVG adds the following capabilities:\n"
        " *\n"
        " *  - Mouse panning\n"
        " *  - Mouse zooming (using the wheel)\n"
        " *  - Object dargging\n"
        " *\n"
        " * Known issues:\n"
        " *\n"
        " *  - Zooming (while panning) on Safari has still some issues\n"
        " *\n"
        " * Releases:\n"
        " *\n"
        " * 1.2, Sat Mar 20 08:42:50 GMT 2010, Zeng Xiaohui\n"
        " *	Fixed a bug with browser mouse handler interaction\n"
        " *\n"
        " * 1.1, Wed Feb  3 17:39:33 GMT 2010, Zeng Xiaohui\n"
        " *	Updated the zoom code to support the mouse wheel on Safari/Chrome\n"
        " *\n"
        " * 1.0, Andrea Leofreddi\n"
        " *	First release\n"
        " *\n"
        " * This code is licensed under the following BSD license:\n"
        " *\n"
        " * Copyright 2009-2010 Andrea Leofreddi <a.leofreddi@itcharm.com>. All rights reserved.\n"
        " *\n"
        " * Redistribution and use in source and binary forms, with or without modification, are\n"
        " * permitted provided that the following conditions are met:\n"
        " *\n"
        " *    1. Redistributions of source code must retain the above copyright notice, this list of\n"
        " *       conditions and the following disclaimer.\n"
        " *\n"
        " *    2. Redistributions in binary form must reproduce the above copyright notice, this list\n"
        " *       of conditions and the following disclaimer in the documentation and/or other materials\n"
        " *       provided with the distribution.\n"
        " *\n"
        " * THIS SOFTWARE IS PROVIDED BY Andrea Leofreddi ``AS IS'' AND ANY EXPRESS OR IMPLIED\n"
        " * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND\n"
        " * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Andrea Leofreddi OR\n"
        " * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR\n"
        " * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\n"
        " * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON\n"
        " * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING\n"
        " * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF\n"
        " * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n"
        " *\n"
        " * The views and conclusions contained in the software and documentation are those of the\n"
        " * authors and should not be interpreted as representing official policies, either expressed\n"
        " * or implied, of Andrea Leofreddi.\n"
        " */\n"
        "var root = document.documentElement;\n"
        "var state = 'none', stateTarget, stateOrigin, stateTf;\n"
        "setupHandlers(root);\n"
        "/**\n"
        " * Register handlers\n"
        " */\n"
        "function setupHandlers(root){\n"
        "	setAttributes(root, {\n"
        "		\"onmouseup\" : \"add(evt)\",\n"
        "		\"onmousedown\" : \"handleMouseDown(evt)\",\n"
        "		\"onmousemove\" : \"handleMouseMove(evt)\",\n"
        "		\"onmouseup\" : \"handleMouseUp(evt)\",\n"
        "		//\"onmouseout\" : \"handleMouseUp(evt)\", // Decomment this to stop the pan functionality when dragging out of the SVG element\n"
        "	});\n"
        "	if(navigator.userAgent.toLowerCase().indexOf('webkit') >= 0)\n"
        "		window.addEventListener('mousewheel', handleMouseWheel, false); // Chrome/Safari\n"
        "	else\n"
        "		window.addEventListener('DOMMouseScroll', handleMouseWheel, false); // Others\n"
        "	var g = svgDoc.getElementById(\"svg\");\n"
        "	g.width = \"100%\";\n"
        "	g.height = \"100%\";\n"
        "}\n"
        "/**\n"
        " * Instance an SVGPoint object with given event coordinates.\n"
        " */\n"
        "function getEventPoint(evt) {\n"
        "	var p = root.createSVGPoint();\n"
        "	p.x = evt.clientX;\n"
        "	p.y = evt.clientY;\n"
        "	return p;\n"
        "}\n"
        "/**\n"
        " * Sets the current transform matrix of an element.\n"
        " */\n"
        "function setCTM(element, matrix) {\n"
        "	var s = \"matrix(\" + matrix.a + \",\" + matrix.b + \",\" + matrix.c + \",\" + matrix.d + \",\" + matrix.e + \",\" + matrix.f + \")\";\n"
        "	element.setAttribute(\"transform\", s);\n"
        "}\n"
        "/**\n"
        " * Dumps a matrix to a string (useful for debug).\n"
        " */\n"
        "function dumpMatrix(matrix) {\n"
        "	var s = \"[ \" + matrix.a + \", \" + matrix.c + \", \" + matrix.e + \"\\n  \" + matrix.b + \", \" + matrix.d + \", \" + matrix.f + \"\\n  0, 0, 1 ]\";\n"
        "	return s;\n"
        "}\n"
        "/**\n"
        " * Sets attributes of an element.\n"
        " */\n"
        "function setAttributes(element, attributes){\n"
        "	for (i in attributes)\n"
        "		element.setAttributeNS(null, i, attributes[i]);\n"
        "}\n"
        "/**\n"
        " * Handle mouse move event.\n"
        " */\n"
        "function handleMouseWheel(evt) {\n"
        "	if(evt.preventDefault)\n"
        "		evt.preventDefault();\n"
        "	evt.returnValue = false;\n"
        "	var svgDoc = evt.target.ownerDocument;\n"
        "	var delta;\n"
        "	if(evt.wheelDelta)\n"
        "		delta = evt.wheelDelta / 3600; // Chrome/Safari\n"
        "	else\n"
        "		delta = evt.detail / -90; // Mozilla\n"
        "	var z = 1 + delta; // Zoom factor: 0.9/1.1\n"
        "	var g = svgDoc.getElementById(\"viewport\");\n"
        "	var p = getEventPoint(evt);\n"
        "	p = p.matrixTransform(g.getCTM().inverse());\n"
        "	// Compute new scale matrix in current mouse position\n"
        "	var k = root.createSVGMatrix().translate(p.x, p.y).scale(z).translate(-p.x, -p.y);\n"
        "        setCTM(g, g.getCTM().multiply(k));\n"
        "	stateTf = stateTf.multiply(k.inverse());\n"
        "}\n"
        "/**\n"
        " * Handle mouse move event.\n"
        " */\n"
        "function handleMouseMove(evt) {\n"
        "	if(evt.preventDefault)\n"
        "		evt.preventDefault();\n"
        "	evt.returnValue = false;\n"
        "	var svgDoc = evt.target.ownerDocument;\n"
        "	var g = svgDoc.getElementById(\"viewport\");\n"
        "	if(state == 'pan') {\n"
        "		// Pan mode\n"
        "		var p = getEventPoint(evt).matrixTransform(stateTf);\n"
        "		setCTM(g, stateTf.inverse().translate(p.x - stateOrigin.x, p.y - stateOrigin.y));\n"
        "	} else if(state == 'move') {\n"
        "		// Move mode\n"
        "		var p = getEventPoint(evt).matrixTransform(g.getCTM().inverse());\n"
        "		setCTM(stateTarget, root.createSVGMatrix().translate(p.x - stateOrigin.x, p.y - stateOrigin.y).multiply(g.getCTM().inverse()).multiply(stateTarget.getCTM()));\n"
        "		stateOrigin = p;\n"
        "	}\n"
        "}\n"
        "/**\n"
        " * Handle click event.\n"
        " */\n"
        "function handleMouseDown(evt) {\n"
        "	if(evt.preventDefault)\n"
        "		evt.preventDefault();\n"
        "	evt.returnValue = false;\n"
        "	var svgDoc = evt.target.ownerDocument;\n"
        "	var g = svgDoc.getElementById(\"viewport\");\n"
        "	if(true || evt.target.tagName == \"svg\") {\n"
        "		// Pan mode\n"
        "		state = 'pan';\n"
        "		stateTf = g.getCTM().inverse();\n"
        "		stateOrigin = getEventPoint(evt).matrixTransform(stateTf);\n"
        "	} else {\n"
        "		// Move mode\n"
        "		state = 'move';\n"
        "		stateTarget = evt.target;\n"
        "		stateTf = g.getCTM().inverse();\n"
        "		stateOrigin = getEventPoint(evt).matrixTransform(stateTf);\n"
        "	}\n"
        "}\n"
        "/**\n"
        " * Handle mouse button release event.\n"
        " */\n"
        "function handleMouseUp(evt) {\n"
        "	if(evt.preventDefault)\n"
        "		evt.preventDefault();\n"
        "	evt.returnValue = false;\n"
        "	var svgDoc = evt.target.ownerDocument;\n"
        "	if(state == 'pan' || state == 'move') {\n"
        "		// Quit pan mode\n"
        "		state = '';\n"
        "	}\n"
        "}\n"
        "]]></script>\n"
        "EOF\n"
        "}\n"
        "sub TranslateStack {\n"
        "  my $symbols = shift;\n"
        "  my $k = shift;\n"
        "  my @addrs = split(/\\n/, $k);\n"
        "  my @result = ();\n"
        "  for (my $i = 0; $i <= $#addrs; $i++) {\n"
        "    my $a = $addrs[$i];\n"
        "    if (length($a) > 8 && $a gt \"7fffffffffffffff\") {\n"
        "      next;\n"
        "    }\n"
        "    if ($main::opt_disasm || $main::opt_list) {\n"
        "      push(@result, $a);\n"
        "      next;\n"
        "    }\n"
        "    my $symlist = $symbols->{$a};\n"
        "    if (!defined($symlist)) {\n"
        "      $symlist = [$a, \"\", $a];\n"
        "    }\n"
        "    for (my $j = $#{$symlist}; $j >= 2; $j -= 3) {\n"
        "      my $func = $symlist->[$j-2];\n"
        "      my $fileline = $symlist->[$j-1];\n"
        "      my $fullfunc = $symlist->[$j];\n"
        "      if ($j > 2) {\n"
        "        $func = \"$func (inline)\";\n"
        "      }\n"
        "      if ($main::opt_addresses) {\n"
        "        push(@result, \"$a $func $fileline\");\n"
        "      } elsif ($main::opt_lines) {\n"
        "        if ($func eq '\?\?' && $fileline eq '\?\?:0') {\n"
        "          push(@result, \"$a\");\n"
        "        } else {\n"
        "          push(@result, \"$func $fileline\");\n"
        "        }\n"
        "      } elsif ($main::opt_functions) {\n"
        "        if ($func eq '\?\?') {\n"
        "          push(@result, \"$a\");\n"
        "        } else {\n"
        "          push(@result, $func);\n"
        "        }\n"
        "      } elsif ($main::opt_files) {\n"
        "        if ($fileline eq '\?\?:0' || $fileline eq '') {\n"
        "          push(@result, \"$a\");\n"
        "        } else {\n"
        "          my $f = $fileline;\n"
        "          $f =~ s/:\\d+$//;\n"
        "          push(@result, $f);\n"
        "        }\n"
        "      } else {\n"
        "        push(@result, $a);\n"
        "        last;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return @result;\n"
        "}\n"
        "sub Percent {\n"
        "  my $num = shift;\n"
        "  my $tot = shift;\n"
        "  if ($tot != 0) {\n"
        "    return sprintf(\"%.1f%%\", $num * 100.0 / $tot);\n"
        "  } else {\n"
        "    return ($num == 0) ? \"nan\" : (($num > 0) ? \"+inf\" : \"-inf\");\n"
        "  }\n"
        "}\n"
        "sub Unparse {\n"
        "  my $num = shift;\n"
        "  if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {\n"
        "    if ($main::opt_inuse_objects || $main::opt_alloc_objects) {\n"
        "      return sprintf(\"%d\", $num);\n"
        "    } else {\n"
        "      if ($main::opt_show_bytes) {\n"
        "        return sprintf(\"%d\", $num);\n"
        "      } else {\n"
        "        return sprintf(\"%.1f\", $num / 1048576.0);\n"
        "      }\n"
        "    }\n"
        "  } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {\n"
        "    return sprintf(\"%.3f\", $num / 1e9);\n"
        "  } else {\n"
        "    return sprintf(\"%d\", $num);\n"
        "  }\n"
        "}\n"
        "sub UnparseAlt {\n"
        "  my $num = shift;\n"
        "  if ($num == 0) {\n"
        "    return \".\";\n"
        "  } else {\n"
        "    return Unparse($num);\n"
        "  }\n"
        "}\n"
        "sub Units {\n"
        "  if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {\n"
        "    if ($main::opt_inuse_objects || $main::opt_alloc_objects) {\n"
        "      return \"objects\";\n"
        "    } else {\n"
        "      if ($main::opt_show_bytes) {\n"
        "        return \"B\";\n"
        "      } else {\n"
        "        return \"MB\";\n"
        "      }\n"
        "    }\n"
        "  } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {\n"
        "    return \"seconds\";\n"
        "  } else {\n"
        "    return \"samples\";\n"
        "  }\n"
        "}\n"
        "sub FlatProfile {\n"
        "  my $profile = shift;\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    if ($#addrs >= 0) {\n"
        "      AddEntry($result, $addrs[0], $count);\n"
        "    }\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub CumulativeProfile {\n"
        "  my $profile = shift;\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    foreach my $a (@addrs) {\n"
        "      AddEntry($result, $a, $count);\n"
        "    }\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub IsSecondPcAlwaysTheSame {\n"
        "  my $profile = shift;\n"
        "  my $second_pc = undef;\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    if ($#addrs < 1) {\n"
        "      return undef;\n"
        "    }\n"
        "    if (not defined $second_pc) {\n"
        "      $second_pc = $addrs[1];\n"
        "    } else {\n"
        "      if ($second_pc ne $addrs[1]) {\n"
        "        return undef;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return $second_pc;\n"
        "}\n"
        "sub ExtractSymbolLocation {\n"
        "  my $symbols = shift;\n"
        "  my $address = shift;\n"
        "  my $location = \"\?\?:0:unknown\";\n"
        "  if (exists $symbols->{$address}) {\n"
        "    my $file = $symbols->{$address}->[1];\n"
        "    if ($file eq \"?\") {\n"
        "      $file = \"\?\?:0\"\n"
        "    }\n"
        "    $location = $file . \":\" . $symbols->{$address}->[0];\n"
        "  }\n"
        "  return $location;\n"
        "}\n"
        "sub ExtractCalls {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my $calls = {};\n"
        "  while( my ($stack_trace, $count) = each %$profile ) {\n"
        "    my @address = split(/\\n/, $stack_trace);\n"
        "    my $destination = ExtractSymbolLocation($symbols, $address[0]);\n"
        "    AddEntry($calls, $destination, $count);\n"
        "    for (my $i = 1; $i <= $#address; $i++) {\n"
        "      my $source = ExtractSymbolLocation($symbols, $address[$i]);\n"
        "      my $call = \"$source -> $destination\";\n"
        "      AddEntry($calls, $call, $count);\n"
        "      $destination = $source;\n"
        "    }\n"
        "  }\n"
        "  return $calls;\n"
        "}\n"
        "sub RemoveUninterestingFrames {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my %skip = ();\n"
        "  my $skip_regexp = 'NOMATCH';\n"
        "  if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {\n"
        "    foreach my $name ('calloc',\n"
        "                      'cfree',\n"
        "                      'malloc',\n"
        "                      'free',\n"
        "                      'memalign',\n"
        "                      'posix_memalign',\n"
        "                      'pvalloc',\n"
        "                      'valloc',\n"
        "                      'realloc',\n"
        "                      'tc_calloc',\n"
        "                      'tc_cfree',\n"
        "                      'tc_malloc',\n"
        "                      'tc_free',\n"
        "                      'tc_memalign',\n"
        "                      'tc_posix_memalign',\n"
        "                      'tc_pvalloc',\n"
        "                      'tc_valloc',\n"
        "                      'tc_realloc',\n"
        "                      'tc_new',\n"
        "                      'tc_delete',\n"
        "                      'tc_newarray',\n"
        "                      'tc_deletearray',\n"
        "                      'tc_new_nothrow',\n"
        "                      'tc_newarray_nothrow',\n"
        "                      'do_malloc',\n"
        "                      '::do_malloc',\n"
        "                      '::do_malloc_or_cpp_alloc',\n"
        "                      'DoSampledAllocation',\n"
        "                      'simple_alloc::allocate',\n"
        "                      '__malloc_alloc_template::allocate',\n"
        "                      '__builtin_delete',\n"
        "                      '__builtin_new',\n"
        "                      '__builtin_vec_delete',\n"
        "                      '__builtin_vec_new',\n"
        "                      'operator new',\n"
        "                      'operator new[]',\n"
        "                      '__start_google_malloc',\n"
        "                      '__stop_google_malloc',\n"
        "                      '__start_malloc_hook',\n"
        "                      '__stop_malloc_hook') {\n"
        "      $skip{$name} = 1;\n"
        "      $skip{\"_\" . $name} = 1;\n"
        "    }\n"
        "    $skip_regexp = \"TCMalloc|^tcmalloc::\";\n"
        "  } elsif ($main::profile_type eq 'contention') {\n"
        "    foreach my $vname ('Mutex::Unlock', 'Mutex::UnlockSlow') {\n"
        "      $skip{$vname} = 1;\n"
        "    }\n"
        "  } elsif ($main::profile_type eq 'cpu') {\n"
        "    foreach my $name ('ProfileData::Add',\n"
        "                      'ProfileData::prof_handler',\n"
        "                      'CpuProfiler::prof_handler',\n"
        "                      '__FRAME_END__',\n"
        "                      '__pthread_sighandler',\n"
        "                      '__restore') {\n"
        "      $skip{$name} = 1;\n"
        "    }\n"
        "  } else {\n"
        "  }\n"
        "  if ($main::profile_type eq 'cpu') {\n"
        "    while (my $second_pc = IsSecondPcAlwaysTheSame($profile)) {\n"
        "      my $result = {};\n"
        "      my $func = '';\n"
        "      if (exists($symbols->{$second_pc})) {\n"
        "        $second_pc = $symbols->{$second_pc}->[0];\n"
        "      }\n"
        "      print STDERR \"Removing $second_pc from all stack traces.\\n\";\n"
        "      foreach my $k (keys(%{$profile})) {\n"
        "        my $count = $profile->{$k};\n"
        "        my @addrs = split(/\\n/, $k);\n"
        "        splice @addrs, 1, 1;\n"
        "        my $reduced_path = join(\"\\n\", @addrs);\n"
        "        AddEntry($result, $reduced_path, $count);\n"
        "      }\n"
        "      $profile = $result;\n"
        "    }\n"
        "  }\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    my @path = ();\n"
        "    foreach my $a (@addrs) {\n"
        "      if (exists($symbols->{$a})) {\n"
        "        my $func = $symbols->{$a}->[0];\n"
        "        if ($skip{$func} || ($func =~ m/$skip_regexp/)) {\n"
        "          next;\n"
        "        }\n"
        "      }\n"
        "      push(@path, $a);\n"
        "    }\n"
        "    my $reduced_path = join(\"\\n\", @path);\n"
        "    AddEntry($result, $reduced_path, $count);\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub ReduceProfile {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @translated = TranslateStack($symbols, $k);\n"
        "    my @path = ();\n"
        "    my %seen = ();\n"
        "    $seen{''} = 1;\n"
        "    foreach my $e (@translated) {\n"
        "      if (!$seen{$e}) {\n"
        "        $seen{$e} = 1;\n"
        "        push(@path, $e);\n"
        "      }\n"
        "    }\n"
        "    my $reduced_path = join(\"\\n\", @path);\n"
        "    AddEntry($result, $reduced_path, $count);\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub SymbolMatches {\n"
        "  my $sym = shift;\n"
        "  my $re = shift;\n"
        "  if (defined($sym)) {\n"
        "    for (my $i = 0; $i < $#{$sym}; $i += 3) {\n"
        "      if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) {\n"
        "        return 1;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return 0;\n"
        "}\n"
        "sub FocusProfile {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my $focus = shift;\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    foreach my $a (@addrs) {\n"
        "      if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) {\n"
        "        AddEntry($result, $k, $count);\n"
        "        last;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub IgnoreProfile {\n"
        "  my $symbols = shift;\n"
        "  my $profile = shift;\n"
        "  my $ignore = shift;\n"
        "  my $result = {};\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    my $count = $profile->{$k};\n"
        "    my @addrs = split(/\\n/, $k);\n"
        "    my $matched = 0;\n"
        "    foreach my $a (@addrs) {\n"
        "      if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) {\n"
        "        $matched = 1;\n"
        "        last;\n"
        "      }\n"
        "    }\n"
        "    if (!$matched) {\n"
        "      AddEntry($result, $k, $count);\n"
        "    }\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub TotalProfile {\n"
        "  my $profile = shift;\n"
        "  my $result = 0;\n"
        "  foreach my $k (keys(%{$profile})) {\n"
        "    $result += $profile->{$k};\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub AddProfile {\n"
        "  my $A = shift;\n"
        "  my $B = shift;\n"
        "  my $R = {};\n"
        "  foreach my $k (keys(%{$A})) {\n"
        "    my $v = $A->{$k};\n"
        "    AddEntry($R, $k, $v);\n"
        "  }\n"
        "  foreach my $k (keys(%{$B})) {\n"
        "    my $v = $B->{$k};\n"
        "    AddEntry($R, $k, $v);\n"
        "  }\n"
        "  return $R;\n"
        "}\n"
        "sub MergeSymbols {\n"
        "  my $A = shift;\n"
        "  my $B = shift;\n"
        "  my $R = {};\n"
        "  foreach my $k (keys(%{$A})) {\n"
        "    $R->{$k} = $A->{$k};\n"
        "  }\n"
        "  if (defined($B)) {\n"
        "    foreach my $k (keys(%{$B})) {\n"
        "      $R->{$k} = $B->{$k};\n"
        "    }\n"
        "  }\n"
        "  return $R;\n"
        "}\n"
        "sub AddPcs {\n"
        "  my $A = shift;\n"
        "  my $B = shift;\n"
        "  my $R = {};\n"
        "  foreach my $k (keys(%{$A})) {\n"
        "    $R->{$k} = 1\n"
        "  }\n"
        "  foreach my $k (keys(%{$B})) {\n"
        "    $R->{$k} = 1\n"
        "  }\n"
        "  return $R;\n"
        "}\n"
        "sub SubtractProfile {\n"
        "  my $A = shift;\n"
        "  my $B = shift;\n"
        "  my $R = {};\n"
        "  foreach my $k (keys(%{$A})) {\n"
        "    my $v = $A->{$k} - GetEntry($B, $k);\n"
        "    if ($v < 0 && $main::opt_drop_negative) {\n"
        "      $v = 0;\n"
        "    }\n"
        "    AddEntry($R, $k, $v);\n"
        "  }\n"
        "  if (!$main::opt_drop_negative) {\n"
        "    foreach my $k (keys(%{$B})) {\n"
        "      if (!exists($A->{$k})) {\n"
        "        AddEntry($R, $k, 0 - $B->{$k});\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return $R;\n"
        "}\n"
        "sub GetEntry {\n"
        "  my $profile = shift;\n"
        "  my $k = shift;\n"
        "  if (exists($profile->{$k})) {\n"
        "    return $profile->{$k};\n"
        "  } else {\n"
        "    return 0;\n"
        "  }\n"
        "}\n"
        "sub AddEntry {\n"
        "  my $profile = shift;\n"
        "  my $k = shift;\n"
        "  my $n = shift;\n"
        "  if (!exists($profile->{$k})) {\n"
        "    $profile->{$k} = 0;\n"
        "  }\n"
        "  $profile->{$k} += $n;\n"
        "}\n"
        "sub AddEntries {\n"
        "  my $profile = shift;\n"
        "  my $pcs = shift;\n"
        "  my $stack = shift;\n"
        "  my $count = shift;\n"
        "  my @k = ();\n"
        "  foreach my $e (split(/\\s+/, $stack)) {\n"
        "    my $pc = HexExtend($e);\n"
        "    $pcs->{$pc} = 1;\n"
        "    push @k, $pc;\n"
        "  }\n"
        "  AddEntry($profile, (join \"\\n\", @k), $count);\n"
        "}\n"
        "sub CheckSymbolPage {\n"
        "  my $url = SymbolPageURL();\n"
        "  open(SYMBOL, \"$URL_FETCHER '$url' |\");\n"
        "  my $line = <SYMBOL>;\n"
        "  $line =~ s/\\r//g;\n"
        "  close(SYMBOL);\n"
        "  unless (defined($line)) {\n"
        "    error(\"$url doesn't exist\\n\");\n"
        "  }\n"
        "  if ($line =~ /^num_symbols:\\s+(\\d+)$/) {\n"
        "    if ($1 == 0) {\n"
        "      error(\"Stripped binary. No symbols available.\\n\");\n"
        "    }\n"
        "  } else {\n"
        "    error(\"Failed to get the number of symbols from $url\\n\");\n"
        "  }\n"
        "}\n"
        "sub IsProfileURL {\n"
        "  my $profile_name = shift;\n"
        "  if (-f $profile_name) {\n"
        "    printf STDERR \"Using local file $profile_name.\\n\";\n"
        "    return 0;\n"
        "  }\n"
        "  return 1;\n"
        "}\n"
        "sub ParseProfileURL {\n"
        "  my $profile_name = shift;\n"
        "  if (!defined($profile_name) || $profile_name eq \"\") {\n"
        "    return ();\n"
        "  }\n"
        "  $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,;\n"
        "  my $proto = $1 || \"http://\";\n"
        "  my $hostport = $2;\n"
        "  my $prefix = $3;\n"
        "  my $profile = $4 || \"/\";\n"
        "  my $host = $hostport;\n"
        "  $host =~ s/:.*//;\n"
        "  my $baseurl = \"$proto$hostport$prefix\";\n"
        "  return ($host, $baseurl, $profile);\n"
        "}\n"
        "sub SymbolPageURL {\n"
        "  my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);\n"
        "  return \"$baseURL$SYMBOL_PAGE\";\n"
        "}\n"
        "sub FetchProgramName() {\n"
        "  my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);\n"
        "  my $url = \"$baseURL$PROGRAM_NAME_PAGE\";\n"
        "  my $command_line = \"$URL_FETCHER '$url'\";\n"
        "  open(CMDLINE, \"$command_line |\") or error($command_line);\n"
        "  my $cmdline = <CMDLINE>;\n"
        "  $cmdline =~ s/\\r//g;\n"
        "  close(CMDLINE);\n"
        "  error(\"Failed to get program name from $url\\n\") unless defined($cmdline);\n"
        "  $cmdline =~ s/\\x00.+//;\n"
        "  $cmdline =~ s!\\n!!g;\n"
        "  return $cmdline;\n"
        "}\n"
        "sub ResolveRedirectionForCurl {\n"
        "  my $url = shift;\n"
        "  my $command_line = \"$URL_FETCHER --head '$url'\";\n"
        "  open(CMDLINE, \"$command_line |\") or error($command_line);\n"
        "  while (<CMDLINE>) {\n"
        "    s/\\r//g;\n"
        "    if (/^Location: (.*)/) {\n"
        "      $url = $1;\n"
        "    }\n"
        "  }\n"
        "  close(CMDLINE);\n"
        "  return $url;\n"
        "}\n"
        "sub AddFetchTimeout {\n"
        "  my $fetcher = shift;\n"
        "  my $timeout = shift;\n"
        "  if (defined($timeout)) {\n"
        "    if ($fetcher =~ m/\\bcurl -s/) {\n"
        "      $fetcher .= sprintf(\" --max-time %d\", $timeout);\n"
        "    } elsif ($fetcher =~ m/\\brpcget\\b/) {\n"
        "      $fetcher .= sprintf(\" --deadline=%d\", $timeout);\n"
        "    }\n"
        "  }\n"
        "  return $fetcher;\n"
        "}\n"
        "sub ReadSymbols {\n"
        "  my $in = shift;\n"
        "  my $map = {};\n"
        "  while (<$in>) {\n"
        "    s/\\r//g;\n"
        "    if (m/^0x0*([0-9a-f]+)\\s+(.+)/) {\n"
        "      $map->{$1} = $2;\n"
        "    } elsif (m/^---/) {\n"
        "      last;\n"
        "    } elsif (m/^([a-z][^=]*)=(.*)$/ ) {\n"
        "      my ($variable, $value) = ($1, $2);\n"
        "      for ($variable, $value) {\n"
        "        s/^\\s+//;\n"
        "        s/\\s+$//;\n"
        "      }\n"
        "      if ($variable eq \"binary\") {\n"
        "        if ($main::prog ne $UNKNOWN_BINARY && $main::prog ne $value) {\n"
        "          printf STDERR (\"Warning: Mismatched binary name '%s', using '%s'.\\n\",\n"
        "                         $main::prog, $value);\n"
        "        }\n"
        "        $main::prog = $value;\n"
        "      } else {\n"
        "        printf STDERR (\"Ignoring unknown variable in symbols list: \" .\n"
        "            \"'%s' = '%s'\\n\", $variable, $value);\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  return $map;\n"
        "}\n"
        "sub FetchSymbols {\n"
        "  my $pcset = shift;\n"
        "  my $symbol_map = shift;\n"
        "  my %seen = ();\n"
        "  my @pcs = grep { !$seen{$_}++ } keys(%$pcset);\n"
        "  if (!defined($symbol_map)) {\n"
        "    my $post_data = join(\"+\", sort((map {\"0x\" . \"$_\"} @pcs)));\n"
        "    open(POSTFILE, \">$main::tmpfile_sym\");\n"
        "    print POSTFILE $post_data;\n"
        "    close(POSTFILE);\n"
        "    my $url = SymbolPageURL();\n"
        "    my $command_line;\n"
        "    if ($URL_FETCHER =~ m/\\bcurl -s/) {\n"
        "      $url = ResolveRedirectionForCurl($url);\n"
        "      $command_line = \"$URL_FETCHER -d '\\@$main::tmpfile_sym' '$url'\";\n"
        "    } else {\n"
        "      $command_line = \"$URL_FETCHER --post '$url' < '$main::tmpfile_sym'\";\n"
        "    }\n"
        "    my $cppfilt = $obj_tool_map{\"c++filt\"};\n"
        "    open(SYMBOL, \"$command_line | $cppfilt |\") or error($command_line);\n"
        "    $symbol_map = ReadSymbols(*SYMBOL{IO});\n"
        "    close(SYMBOL);\n"
        "  }\n"
        "  my $symbols = {};\n"
        "  foreach my $pc (@pcs) {\n"
        "    my $fullname;\n"
        "    my $shortpc = $pc;\n"
        "    $shortpc =~ s/^0*//;\n"
        "    my $fullnames;\n"
        "    if (defined($symbol_map->{$shortpc})) {\n"
        "      $fullnames = $symbol_map->{$shortpc};\n"
        "    } else {\n"
        "      $fullnames = \"0x\" . $pc;\n"
        "    }\n"
        "    my $sym = [];\n"
        "    $symbols->{$pc} = $sym;\n"
        "    foreach my $fullname (split(\"--\", $fullnames)) {\n"
        "      my $name = ShortFunctionName($fullname);\n"
        "      push(@{$sym}, $name, \"?\", $fullname);\n"
        "    }\n"
        "  }\n"
        "  return $symbols;\n"
        "}\n"
        "sub BaseName {\n"
        "  my $file_name = shift;\n"
        "  $file_name =~ s!^.*/!!;\n"
        "  return $file_name;\n"
        "}\n"
        "sub MakeProfileBaseName {\n"
        "  my ($binary_name, $profile_name) = @_;\n"
        "  my ($host, $baseURL, $path) = ParseProfileURL($profile_name);\n"
        "  my $binary_shortname = BaseName($binary_name);\n"
        "  return sprintf(\"%s.%s.%s\",\n"
        "                 $binary_shortname, $main::op_time, $host);\n"
        "}\n"
        "sub FetchDynamicProfile {\n"
        "  my $binary_name = shift;\n"
        "  my $profile_name = shift;\n"
        "  my $fetch_name_only = shift;\n"
        "  my $encourage_patience = shift;\n"
        "  if (!IsProfileURL($profile_name)) {\n"
        "    return $profile_name;\n"
        "  } else {\n"
        "    my ($host, $baseURL, $path) = ParseProfileURL($profile_name);\n"
        "    if ($path eq \"\" || $path eq \"/\") {\n"
        "      $path = $PROFILE_PAGE;\n"
        "    }\n"
        "    my $profile_file = MakeProfileBaseName($binary_name, $profile_name);\n"
        "    my $url = \"$baseURL$path\";\n"
        "    my $fetch_timeout = undef;\n"
        "    if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) {\n"
        "      if ($path =~ m/[?]/) {\n"
        "        $url .= \"&\";\n"
        "      } else {\n"
        "        $url .= \"?\";\n"
        "      }\n"
        "      $url .= sprintf(\"seconds=%d\", $main::opt_seconds);\n"
        "      $fetch_timeout = $main::opt_seconds * 1.01 + 60;\n"
        "    } else {\n"
        "      my $suffix = $path;\n"
        "      $suffix =~ s,/,.,g;\n"
        "      $profile_file .= $suffix;\n"
        "    }\n"
        "    my $profile_dir = $ENV{\"PPROF_TMPDIR\"} || ($ENV{HOME} . \"/pprof\");\n"
        "    if (! -d $profile_dir) {\n"
        "      mkdir($profile_dir)\n"
        "          || die(\"Unable to create profile directory $profile_dir: $!\\n\");\n"
        "    }\n"
        "    my $tmp_profile = \"$profile_dir/.tmp.$profile_file\";\n"
        "    my $real_profile = \"$profile_dir/$profile_file\";\n"
        "    if ($fetch_name_only > 0) {\n"
        "      return $real_profile;\n"
        "    }\n"
        "    my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout);\n"
        "    my $cmd = \"$fetcher '$url' > '$tmp_profile'\";\n"
        "    if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/){\n"
        "      print STDERR \"Gathering CPU profile from $url for $main::opt_seconds seconds to\\n  ${real_profile}\\n\";\n"
        "      if ($encourage_patience) {\n"
        "        print STDERR \"Be patient...\\n\";\n"
        "      }\n"
        "    } else {\n"
        "      print STDERR \"Fetching $path profile from $url to\\n  ${real_profile}\\n\";\n"
        "    }\n"
        "    (system($cmd) == 0) || error(\"Failed to get profile: $cmd: $!\\n\");\n"
        "    (system(\"mv $tmp_profile $real_profile\") == 0) || error(\"Unable to rename profile\\n\");\n"
        "    print STDERR \"Wrote profile to $real_profile\\n\";\n"
        "    $main::collected_profile = $real_profile;\n"
        "    return $main::collected_profile;\n"
        "  }\n"
        "}\n"
        "sub FetchDynamicProfiles {\n"
        "  my $items = scalar(@main::pfile_args);\n"
        "  my $levels = log($items) / log(2);\n"
        "  if ($items == 1) {\n"
        "    $main::profile_files[0] = FetchDynamicProfile($main::prog, $main::pfile_args[0], 0, 1);\n"
        "  } else {\n"
        "    if ((2 ** $levels) < $items) {\n"
        "     $levels++;\n"
        "    }\n"
        "    my $count = scalar(@main::pfile_args);\n"
        "    for (my $i = 0; $i < $count; $i++) {\n"
        "      $main::profile_files[$i] = FetchDynamicProfile($main::prog, $main::pfile_args[$i], 1, 0);\n"
        "    }\n"
        "    print STDERR \"Fetching $count profiles, Be patient...\\n\";\n"
        "    FetchDynamicProfilesRecurse($levels, 0, 0);\n"
        "    $main::collected_profile = join(\" \\\\\\n    \", @main::profile_files);\n"
        "  }\n"
        "}\n"
        "sub FetchDynamicProfilesRecurse {\n"
        "  my $maxlevel = shift;\n"
        "  my $level = shift;\n"
        "  my $position = shift;\n"
        "  if (my $pid = fork()) {\n"
        "    $position = 0 | ($position << 1);\n"
        "    TryCollectProfile($maxlevel, $level, $position);\n"
        "    wait;\n"
        "  } else {\n"
        "    $position = 1 | ($position << 1);\n"
        "    TryCollectProfile($maxlevel, $level, $position);\n"
        "    cleanup();\n"
        "    exit(0);\n"
        "  }\n"
        "}\n"
        "sub TryCollectProfile {\n"
        "  my $maxlevel = shift;\n"
        "  my $level = shift;\n"
        "  my $position = shift;\n"
        "  if ($level >= ($maxlevel - 1)) {\n"
        "    if ($position < scalar(@main::pfile_args)) {\n"
        "      FetchDynamicProfile($main::prog, $main::pfile_args[$position], 0, 0);\n"
        "    }\n"
        "  } else {\n"
        "    FetchDynamicProfilesRecurse($maxlevel, $level+1, $position);\n"
        "  }\n"
        "}\n"
        "BEGIN {\n"
        "  package CpuProfileStream;\n"
        "  sub new {\n"
        "    my ($class, $file, $fname) = @_;\n"
        "    my $self = { file        => $file,\n"
        "                 base        => 0,\n"
        "                 stride      => 512 * 1024,\n"
        "                 slots       => [],\n"
        "                 unpack_code => \"\",\n"
        "                 perl_is_64bit => 1,\n"
        "    };\n"
        "    bless $self, $class;\n"
        "    if ($main::opt_test_stride > 0) {\n"
        "      $self->{stride} = $main::opt_test_stride;\n"
        "    }\n"
        "    my $slots = $self->{slots};\n"
        "    my $str;\n"
        "    read($self->{file}, $str, 8);\n"
        "    $address_length = ($str eq (chr(0)x8)) ? 16 : 8;\n"
        "    if ($address_length == 8) {\n"
        "      if (substr($str, 6, 2) eq chr(0)x2) {\n"
        "        $self->{unpack_code} = 'V';\n"
        "      } elsif (substr($str, 4, 2) eq chr(0)x2) {\n"
        "        $self->{unpack_code} = 'N';\n"
        "      } else {\n"
        "        ::error(\"$fname: header size >= 2**16\\n\");\n"
        "      }\n"
        "      @$slots = unpack($self->{unpack_code} . \"*\", $str);\n"
        "    } else {\n"
        "      my $has_q = 0;\n"
        "      eval { $has_q = pack(\"Q\", \"1\") ? 1 : 1; };\n"
        "      if (!$has_q) {\n"
        "	$self->{perl_is_64bit} = 0;\n"
        "      }\n"
        "      read($self->{file}, $str, 8);\n"
        "      if (substr($str, 4, 4) eq chr(0)x4) {\n"
        "        $self->{unpack_code} = 'V';\n"
        "      } elsif (substr($str, 0, 4) eq chr(0)x4) {\n"
        "        $self->{unpack_code} = 'N';\n"
        "      } else {\n"
        "        ::error(\"$fname: header size >= 2**32\\n\");\n"
        "      }\n"
        "      my @pair = unpack($self->{unpack_code} . \"*\", $str);\n"
        "      @$slots = (0, $pair[0] + $pair[1]);\n"
        "    }\n"
        "    return $self;\n"
        "  }\n"
        "  sub overflow {\n"
        "    my ($self) = @_;\n"
        "    my $slots = $self->{slots};\n"
        "    $self->{base} += $#$slots + 1;\n"
        "    my $str;\n"
        "    read($self->{file}, $str, $self->{stride});\n"
        "    if ($address_length == 8) {\n"
        "      @$slots = unpack($self->{unpack_code} . \"*\", $str);\n"
        "    } else {\n"
        "      my @b32_values = unpack($self->{unpack_code} . \"*\", $str);\n"
        "      my @b64_values = ();\n"
        "      for (my $i = 0; $i < $#b32_values; $i += 2) {\n"
        "	my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]);\n"
        "        if ($self->{unpack_code} eq 'N') {\n"
        "	  ($lo, $hi) = ($hi, $lo);\n"
        "	}\n"
        "	my $value = $lo + $hi * (2**32);\n"
        "	if (!$self->{perl_is_64bit} &&\n"
        "	    (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) {\n"
        "	  ::error(\"Need a 64-bit perl to process this 64-bit profile.\\n\");\n"
        "	}\n"
        "	push(@b64_values, $value);\n"
        "      }\n"
        "      @$slots = @b64_values;\n"
        "    }\n"
        "  }\n"
        "  sub get {\n"
        "    my ($self, $idx) = @_;\n"
        "    my $slots = $self->{slots};\n"
        "    while ($#$slots >= 0) {\n"
        "      if ($idx < $self->{base}) {\n"
        "        print STDERR \"Unexpected look-back reading CPU profile\";\n"
        "        return -1;\n"
        "      } elsif ($idx > $self->{base} + $#$slots) {\n"
        "        $self->overflow();\n"
        "      } else {\n"
        "        return $slots->[$idx - $self->{base}];\n"
        "      }\n"
        "    }\n"
        "    return -1;\n"
        "  }\n"
        "}\n"
        "sub ReadProfileLine {\n"
        "  local *PROFILE = shift;\n"
        "  my $firstchar = \"\";\n"
        "  my $line = \"\";\n"
        "  read(PROFILE, $firstchar, 1);\n"
        "  seek(PROFILE, -1, 1);\n"
        "  if ($firstchar eq \"\\0\") {\n"
        "    return \"\";\n"
        "  }\n"
        "  $line = <PROFILE>;\n"
        "  if (defined($line)) {\n"
        "    $line =~ s/\\r//g;\n"
        "  }\n"
        "  return $line;\n"
        "}\n"
        "sub IsSymbolizedProfileFile {\n"
        "  my $file_name = shift;\n"
        "  if (!(-e $file_name) || !(-r $file_name)) {\n"
        "    return 0;\n"
        "  }\n"
        "  open(TFILE, \"<$file_name\");\n"
        "  binmode TFILE;\n"
        "  my $firstline = ReadProfileLine(*TFILE);\n"
        "  close(TFILE);\n"
        "  if (!$firstline) {\n"
        "    return 0;\n"
        "  }\n"
        "  $SYMBOL_PAGE =~ m,[^/]+$,;\n"
        "  my $symbol_marker = $&;\n"
        "  return $firstline =~ /^--- *$symbol_marker/;\n"
        "}\n"
        "sub ReadProfile {\n"
        "  my $prog = shift;\n"
        "  my $fname = shift;\n"
        "  if (IsSymbolizedProfileFile($fname) && !$main::use_symbolized_profile) {\n"
        "    usage(\"Symbolized profile '$fname' cannot be used with a binary arg.  \" .\n"
        "          \"Try again without passing '$prog'.\");\n"
        "  }\n"
        "  $main::profile_type = '';\n"
        "  $CONTENTION_PAGE =~ m,[^/]+$,;\n"
        "  my $contention_marker = $&;\n"
        "  $GROWTH_PAGE  =~ m,[^/]+$,;\n"
        "  my $growth_marker = $&;\n"
        "  $SYMBOL_PAGE =~ m,[^/]+$,;\n"
        "  my $symbol_marker = $&;\n"
        "  $PROFILE_PAGE =~ m,[^/]+$,;\n"
        "  my $profile_marker = $&;\n"
        "  open(PROFILE, \"<$fname\") || error(\"$fname: $!\\n\");\n"
        "  binmode PROFILE;\n"
        "  my $header = ReadProfileLine(*PROFILE);\n"
        "  if (!defined($header)) {\n"
        "    error(\"Profile is empty.\\n\");\n"
        "  }\n"
        "  my $symbols;\n"
        "  if ($header =~ m/^--- *$symbol_marker/o) {\n"
        "    $symbols = ReadSymbols(*PROFILE{IO});\n"
        "    $header = ReadProfileLine(*PROFILE) || \"\";\n"
        "  }\n"
        "  my $result;\n"
        "  if ($header =~ m/^heap profile:.*$growth_marker/o) {\n"
        "    $main::profile_type = 'growth';\n"
        "    $result =  ReadHeapProfile($prog, $fname, $header);\n"
        "  } elsif ($header =~ m/^heap profile:/) {\n"
        "    $main::profile_type = 'heap';\n"
        "    $result =  ReadHeapProfile($prog, $fname, $header);\n"
        "  } elsif ($header =~ m/^--- *$contention_marker/o) {\n"
        "    $main::profile_type = 'contention';\n"
        "    $result = ReadSynchProfile($prog, $fname);\n"
        "  } elsif ($header =~ m/^--- *Stacks:/) {\n"
        "    print STDERR\n"
        "      \"Old format contention profile: mistakenly reports \" .\n"
        "      \"condition variable signals as lock contentions.\\n\";\n"
        "    $main::profile_type = 'contention';\n"
        "    $result = ReadSynchProfile($prog, $fname);\n"
        "  } elsif ($header =~ m/^--- *$profile_marker/) {\n"
        "    $main::profile_type = 'cpu';\n"
        "    $result = ReadCPUProfile($prog, $fname);\n"
        "  } else {\n"
        "    if (defined($symbols)) {\n"
        "      error(\"$fname: Cannot recognize profile section after symbols.\\n\");\n"
        "    }\n"
        "    $main::profile_type = 'cpu';\n"
        "    $result = ReadCPUProfile($prog, $fname);\n"
        "  }\n"
        "  if (defined($symbols)) {\n"
        "    $result->{symbols} = $symbols;\n"
        "  }\n"
        "  return $result;\n"
        "}\n"
        "sub FixCallerAddresses {\n"
        "  my $stack = shift;\n"
        "  if ($main::use_symbolized_profile) {\n"
        "    return $stack;\n"
        "  } else {\n"
        "    $stack =~ /(\\s)/;\n"
        "    my $delimiter = $1;\n"
        "    my @addrs = split(' ', $stack);\n"
        "    my @fixedaddrs;\n"
        "    $#fixedaddrs = $#addrs;\n"
        "    if ($#addrs >= 0) {\n"
        "      $fixedaddrs[0] = $addrs[0];\n"
        "    }\n"
        "    for (my $i = 1; $i <= $#addrs; $i++) {\n"
        "      $fixedaddrs[$i] = AddressSub($addrs[$i], \"0x1\");\n"
        "    }\n"
        "    return join $delimiter, @fixedaddrs;\n"
        "  }\n"
        "}\n"
        "sub ReadCPUProfile {\n"
        "  my $prog = shift;\n"
        "  my $fname = shift;\n"
        "  my $version;\n"
        "  my $period;\n"
        "  my $i;\n"
        "  my $profile = {};\n"
        "  my $pcs = {};\n"
        "  my $slots = CpuProfileStream->new(*PROFILE, $fname);\n"
        "  if ($slots->get(0) != 0 ) {\n"
        "    error(\"$fname: not a profile file, or old format profile file\\n\");\n"
        "  }\n"
        "  $i = 2 + $slots->get(1);\n"
        "  $version = $slots->get(2);\n"
        "  $period = $slots->get(3);\n"
        "  if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) {\n"
        "    error(\"$fname: not a profile file, or corrupted profile file\\n\");\n"
        "  }\n"
        "  while ($slots->get($i) != -1) {\n"
        "    my $n = $slots->get($i++);\n"
        "    my $d = $slots->get($i++);\n"
        "    if ($d > (2**16)) {\n"
        "      my $addr = sprintf(\"0%o\", $i * ($address_length == 8 ? 4 : 8));\n"
        "      print STDERR \"At index $i (address $addr):\\n\";\n"
        "      error(\"$fname: stack trace depth >= 2**32\\n\");\n"
        "    }\n"
        "    if ($slots->get($i) == 0) {\n"
        "      $i += $d;\n"
        "      last;\n"
        "    }\n"
        "    my @k = ();\n"
        "    for (my $j = 0; $j < $d; $j++) {\n"
        "      my $pc = $slots->get($i+$j);\n"
        "      if ($j > 0 && !$main::use_symbolized_profile) {\n"
        "        $pc--;\n"
        "      }\n"
        "      $pc = sprintf(\"%0*x\", $address_length, $pc);\n"
        "      $pcs->{$pc} = 1;\n"
        "      push @k, $pc;\n"
        "    }\n"
        "    AddEntry($profile, (join \"\\n\", @k), $n);\n"
        "    $i += $d;\n"
        "  }\n"
        "  my $map = '';\n"
        "  seek(PROFILE, $i * 4, 0);\n"
        "  read(PROFILE, $map, (stat PROFILE)[7]);\n"
        "  close(PROFILE);\n"
        "  my $r = {};\n"
        "  $r->{version} = $version;\n"
        "  $r->{period} = $period;\n"
        "  $r->{profile} = $profile;\n"
        "  $r->{libs} = ParseLibraries($prog, $map, $pcs);\n"
        "  $r->{pcs} = $pcs;\n"
        "  return $r;\n"
        "}\n"
        "sub ReadHeapProfile {\n"
        "  my $prog = shift;\n"
        "  my $fname = shift;\n"
        "  my $header = shift;\n"
        "  my $index = 1;\n"
        "  if ($main::opt_inuse_space) {\n"
        "    $index = 1;\n"
        "  } elsif ($main::opt_inuse_objects) {\n"
        "    $index = 0;\n"
        "  } elsif ($main::opt_alloc_space) {\n"
        "    $index = 3;\n"
        "  } elsif ($main::opt_alloc_objects) {\n"
        "    $index = 2;\n"
        "  }\n"
        "  my $sampling_algorithm = 0;\n"
        "  my $sample_adjustment = 0;\n"
        "  chomp($header);\n"
        "  my $type = \"unknown\";\n"
        "  if ($header =~ m\"^heap profile:\\s*(\\d+):\\s+(\\d+)\\s+\\[\\s*(\\d+):\\s+(\\d+)\\](\\s*@\\s*([^/]*)(/(\\d+))?)?\") {\n"
        "    if (defined($6) && ($6 ne '')) {\n"
        "      $type = $6;\n"
        "      my $sample_period = $8;\n"
        "      if (($type eq \"heapprofile\") || ($type !~ /heap/) ) {\n"
        "        $sampling_algorithm = 0;\n"
        "      } elsif ($type =~ /_v2/) {\n"
        "        $sampling_algorithm = 2;\n"
        "        if (defined($sample_period) && ($sample_period ne '')) {\n"
        "          $sample_adjustment = int($sample_period);\n"
        "        }\n"
        "      } else {\n"
        "        $sampling_algorithm = 1;\n"
        "        if (defined($sample_period) && ($sample_period ne '')) {\n"
        "          $sample_adjustment = int($sample_period)/2;\n"
        "        }\n"
        "      }\n"
        "    } else {\n"
        "      my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);\n"
        "      if (($n1 == $n2) && ($s1 == $s2)) {\n"
        "        $sampling_algorithm = 1;\n"
        "      }\n"
        "    }\n"
        "  }\n"
        "  if ($sampling_algorithm > 0) {\n"
        "    if ($sample_adjustment == 0) {\n"
        "      $sample_adjustment = 128*1024;\n"
        "      print STDERR \"Adjusting heap profiles for 1-in-128KB sampling rate\\n\";\n"
        "    } else {\n"
        "      printf STDERR (\"Adjusting heap profiles for 1-in-%d sampling rate\\n\",\n"
        "                     $sample_adjustment);\n"
        "    }\n"
        "    if ($sampling_algorithm > 1) {\n"
        "      printf STDERR \"Heap version $sampling_algorithm\\n\";\n"
        "    }\n"
        "  }\n"
        "  my $profile = {};\n"
        "  my $pcs = {};\n"
        "  my $map = \"\";\n"
        "  while (<PROFILE>) {\n"
        "    s/\\r//g;\n"
        "    if (/^MAPPED_LIBRARIES:/) {\n"
        "      while (<PROFILE>) {\n"
        "        s/\\r//g;\n"
        "        $map .= $_;\n"
        "      }\n"
        "      last;\n"
        "    }\n"
        "    if (/^--- Memory map:/) {\n"
        "      my $buildvar = \"\";\n"
        "      while (<PROFILE>) {\n"
        "        s/\\r//g;\n"
        "        if (m/^\\s*build=(.*)\\n/) {\n"
        "          $buildvar = $1;\n"
        "        }\n"
        "        $_ =~ s/\\$build\\b/$buildvar/g;\n"
        "        $map .= $_;\n"
        "      }\n"
        "      last;\n"
        "    }\n"
        "    s/^\\s*//;\n"
        "    s/\\s*$//;\n"
        "    if (m/^\\s*(\\d+):\\s+(\\d+)\\s+\\[\\s*(\\d+):\\s+(\\d+)\\]\\s+@\\s+(.*)$/) {\n"
        "      my $stack = $5;\n"
        "      my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);\n"
        "      if ($sample_adjustment) {\n"
        "        if ($sampling_algorithm == 2) {\n"
        "          my $ratio;\n"
        "          $ratio = (($s1*1.0)/$n1)/($sample_adjustment);\n"
        "          my $scale_factor;\n"
        "          $scale_factor = 1/(1 - exp(-$ratio));\n"
        "          $n1 *= $scale_factor;\n"
        "          $s1 *= $scale_factor;\n"
        "          $ratio = (($s2*1.0)/$n2)/($sample_adjustment);\n"
        "          $scale_factor = 1/(1 - exp(-$ratio));\n"
        "          $n2 *= $scale_factor;\n"
        "          $s2 *= $scale_factor;\n"
        "        } else {\n"
        "          my $ratio;\n"
        "          $ratio = (($s1*1.0)/$n1)/($sample_adjustment);\n"
        "          if ($ratio < 1) {\n"
        "            $n1 /= $ratio;\n"
        "            $s1 /= $ratio;\n"
        "          }\n"
        "          $ratio = (($s2*1.0)/$n2)/($sample_adjustment);\n"
        "          if ($ratio < 1) {\n"
        "            $n2 /= $ratio;\n"
        "            $s2 /= $ratio;\n"
        "          }\n"
        "        }\n"
        "      }\n"
        "      my @counts = ($n1, $s1, $n2, $s2);\n"
        "      AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);\n"
        "    }\n"
        "  }\n"
        "  my $r = {};\n"
        "  $r->{version} = \"heap\";\n"
        "  $r->{period} = 1;\n"
        "  $r->{profile} = $profile;\n"
        "  $r->{libs} = ParseLibraries($prog, $map, $pcs);\n"
        "  $r->{pcs} = $pcs;\n"
        "  return $r;\n"
        "}\n"
        "sub ReadSynchProfile {\n"
        "  my ($prog, $fname, $header) = @_;\n"
        "  my $map = '';\n"
        "  my $profile = {};\n"
        "  my $pcs = {};\n"
        "  my $sampling_period = 1;\n"
        "  my $cyclespernanosec = 2.8;\n"
        "  my $seen_clockrate = 0;\n"
        "  my $line;\n"
        "  my $index = 0;\n"
        "  if ($main::opt_total_delay) {\n"
        "    $index = 0;\n"
        "  } elsif ($main::opt_contentions) {\n"
        "    $index = 1;\n"
        "  } elsif ($main::opt_mean_delay) {\n"
        "    $index = 2;\n"
        "  }\n"
        "  while ( $line = <PROFILE> ) {\n"
        "    $line =~ s/\\r//g;\n"
        "    if ( $line =~ /^\\s*(\\d+)\\s+(\\d+) \\@\\s*(.*?)\\s*$/ ) {\n"
        "      my ($cycles, $count, $stack) = ($1, $2, $3);\n"
        "      $cycles /= $cyclespernanosec;\n"
        "      $cycles *= $sampling_period;\n"
        "      $count *= $sampling_period;\n"
        "      my @values = ($cycles, $count, $cycles / $count);\n"
        "      AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]);\n"
        "    } elsif ( $line =~ /^(slow release).*thread \\d+  \\@\\s*(.*?)\\s*$/ ||\n"
        "              $line =~ /^\\s*(\\d+) \\@\\s*(.*?)\\s*$/ ) {\n"
        "      my ($cycles, $stack) = ($1, $2);\n"
        "      if ($cycles !~ /^\\d+$/) {\n"
        "        next;\n"
        "      }\n"
        "      $cycles /= $cyclespernanosec;\n"
        "      $cycles *= $sampling_period;\n"
        "      AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles);\n"
        "    } elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) {\n"
        "      my ($variable, $value) = ($1,$2);\n"
        "      for ($variable, $value) {\n"
        "        s/^\\s+//;\n"
        "        s/\\s+$//;\n"
        "      }\n"
        "      if ($variable eq \"cycles/second\") {\n"
        "        $cyclespernanosec = $value / 1e9;\n"
        "        $seen_clockrate = 1;\n"
        "      } elsif ($variable eq \"sampling period\") {\n"
        "        $sampling_period = $value;\n"
        "      } elsif ($variable eq \"ms since reset\") {\n"
        "      } elsif ($variable eq \"discarded samples\") {\n"
        "      } else {\n"
        "        printf STDERR (\"Ignoring unnknown variable in /contention output: \" .\n"
        "                       \"'%s' = '%s'\\n\",$variable,$value);\n"
        "      }\n"
        "    } else {\n"
        "      $map .= $line;\n"
        "    }\n"
        "  }\n"
        "  close PROFILE;\n"
        "  if (!$seen_clockrate) {\n"
        "    printf STDERR (\"No cycles/second entry in profile; Guessing %.1f GHz\\n\",\n"
        "                   $cyclespernanosec);\n"
        "  }\n"
        "  my $r = {};\n"
        "  $r->{version} = 0;\n"
        "  $r->{period} = $sampling_period;\n"
        "  $r->{profile} = $profile;\n"
        "  $r->{libs} = ParseLibraries($prog, $map, $pcs);\n"
        "  $r->{pcs} = $pcs;\n"
        "  return $r;\n"
        "}\n"
        "sub HexExtend {\n"
        "  my $addr = shift;\n"
        "  $addr =~ s/^0x//;\n"
        "  if (length $addr > $address_length) {\n"
        "    printf STDERR \"Warning:  address $addr is longer than address length $address_length\\n\";\n"
        "  }\n"
        "  return substr(\"000000000000000\".$addr, -$address_length);\n"
        "}\n"
        "sub FindLibrary {\n"
        "  my $file = shift;\n"
        "  my $suffix = $file;\n"
        "  do {\n"
        "    foreach my $prefix (@prefix_list) {\n"
        "      my $fullpath = $prefix . $suffix;\n"
        "      if (-e $fullpath) {\n"
        "        return $fullpath;\n"
        "      }\n"
        "    }\n"
        "  } while ($suffix =~ s|^/[^/]+/|/|);\n"
        "  return $file;\n"
        "}\n"
        "sub DebuggingLibrary {\n"
        "  my $file = shift;\n"
        "  if ($file =~ m|^/| && -f \"/usr/lib/debug$file\") {\n"
        "    return \"/usr/lib/debug$file\";\n"
        "  }\n"
        "  return undef;\n"
        "}\n"
        "sub ParseTextSectionHeaderFromObjdump {\n"
        "  my $lib = shift;\n"
        "  my $size = undef;\n"
        "  my $vma;\n"
        "  my $file_offset;\n"
        "  my $objdump = $obj_tool_map{\"objdump\"};\n"
        "  open(OBJDUMP, \"$objdump -h $lib |\")\n"
        "                || error(\"$objdump $lib: $!\\n\");\n"
        "  while (<OBJDUMP>) {\n"
        "    s/\\r//g;\n"
        "    my @x = split;\n"
        "    if (($#x >= 6) && ($x[1] eq '.text')) {\n"
        "      $size = $x[2];\n"
        "      $vma = $x[3];\n"
        "      $file_offset = $x[5];\n"
        "      last;\n"
        "    }\n"
        "  }\n"
        "  close(OBJDUMP);\n"
        "  if (!defined($size)) {\n"
        "    return undef;\n"
        "  }\n"
        "  my $r = {};\n"
        "  $r->{size} = $size;\n"
        "  $r->{vma} = $vma;\n"
        "  $r->{file_offset} = $file_offset;\n"
        "  return $r;\n"
        "}\n"
        "sub ParseTextSectionHeaderFromOtool {\n"
        "  my $lib = shift;\n"
        "  my $size = undef;\n"
        "  my $vma = undef;\n"
        "  my $file_offset = undef;\n"
        "  my $otool = $obj_tool_map{\"otool\"};\n"
        "  open(OTOOL, \"$otool -l $lib |\")\n"
        "                || error(\"$otool $lib: $!\\n\");\n"
        "  my $cmd = \"\";\n"
        "  my $sectname = \"\";\n"
        "  my $segname = \"\";\n"
        "  foreach my $line (<OTOOL>) {\n"
        "    $line =~ s/\\r//g;\n"
        "    if ($line =~ /Load command/) {\n"
        "      $cmd = \"\";\n"
        "      $sectname = \"\";\n"
        "      $segname = \"\";\n"
        "    } elsif ($line =~ /Section/) {\n"
        "      $sectname = \"\";\n"
        "      $segname = \"\";\n"
        "    } elsif ($line =~ /cmd (\\w+)/) {\n"
        "      $cmd = $1;\n"
        "    } elsif ($line =~ /sectname (\\w+)/) {\n"
        "      $sectname = $1;\n"
        "    } elsif ($line =~ /segname (\\w+)/) {\n"
        "      $segname = $1;\n"
        "    } elsif (!(($cmd eq \"LC_SEGMENT\" || $cmd eq \"LC_SEGMENT_64\") &&\n"
        "               $sectname eq \"__text\" &&\n"
        "               $segname eq \"__TEXT\")) {\n"
        "      next;\n"
        "    } elsif ($line =~ /\\baddr 0x([0-9a-fA-F]+)/) {\n"
        "      $vma = $1;\n"
        "    } elsif ($line =~ /\\bsize 0x([0-9a-fA-F]+)/) {\n"
        "      $size = $1;\n"
        "    } elsif ($line =~ /\\boffset ([0-9]+)/) {\n"
        "      $file_offset = sprintf(\"%016x\", $1);\n"
        "    }\n"
        "    if (defined($vma) && defined($size) && defined($file_offset)) {\n"
        "      last;\n"
        "    }\n"
        "  }\n"
        "  close(OTOOL);\n"
        "  if (!defined($vma) || !defined($size) || !defined($file_offset)) {\n"
        "     return undef;\n"
        "  }\n"
        "  my $r = {};\n"
        "  $r->{size} = $size;\n"
        "  $r->{vma} = $vma;\n"
        "  $r->{file_offset} = $file_offset;\n"
        "  return $r;\n"
        "}\n"
        "sub ParseTextSectionHeader {\n"
        "  if (defined($obj_tool_map{\"otool\"})) {\n"
        "    my $r = ParseTextSectionHeaderFromOtool(@_);\n"
        "    if (defined($r)){\n"
        "      return $r;\n"
        "    }\n"
        "  }\n"
        "  return ParseTextSectionHeaderFromObjdump(@_);\n"
        "}\n"
        "sub ParseLibraries {\n"
        "  return if $main::use_symbol_page;\n"
        "  my $prog = shift;\n"
        "  my $map = shift;\n"
        "  my $pcs = shift;\n"
        "  my $result = [];\n"
        "  my $h = \"[a-f0-9]+\";\n"
        "  my $zero_offset = HexExtend(\"0\");\n"
        "  my $buildvar = \"\";\n"
        "  foreach my $l (split(\"\\n\", $map)) {\n"
        "    if ($l =~ m/^\\s*build=(.*)$/) {\n"
        "      $buildvar = $1;\n"
        "    }\n"
        "    my $start;\n"
        "    my $finish;\n"
        "    my $offset;\n"
        "    my $lib;\n"
        "    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) {\n"
        "      $start = HexExtend($1);\n"
        "      $finish = HexExtend($2);\n"
        "      $offset = HexExtend($3);\n"
        "      $lib = $4;\n"
        "      $lib =~ s|\\\\|/|g;\n"
        "    } elsif ($l =~ /^\\s*($h)-($h):\\s*(\\S+\\.so(\\.\\d+)*)/) {\n"
        "      $start = HexExtend($1);\n"
        "      $finish = HexExtend($2);\n"
        "      $offset = $zero_offset;\n"
        "      $lib = $3;\n"
        "    } else {\n"
        "      next;\n"
        "    }\n"
        "    $lib =~ s/\\$build\\b/$buildvar/g;\n"
        "    $lib = FindLibrary($lib);\n"
        "    if (!DebuggingLibrary($lib)) {\n"
        "      my $text = ParseTextSectionHeader($lib);\n"
        "      if (defined($text)) {\n"
        "         my $vma_offset = AddressSub($text->{vma}, $text->{file_offset});\n"
        "         $offset = AddressAdd($offset, $vma_offset);\n"
        "      }\n"
        "    }\n"
        "    push(@{$result}, [$lib, $start, $finish, $offset]);\n"
        "  }\n"
        "  if ($main::opt_lib ne \"\") {\n"
        "    my $text = ParseTextSectionHeader($main::opt_lib);\n"
        "    if (defined($text)) {\n"
        "       my $start = $text->{vma};\n"
        "       my $finish = AddressAdd($start, $text->{size});\n"
        "       push(@{$result}, [$main::opt_lib, $start, $finish, $start]);\n"
        "    }\n"
        "  }\n"
        "  my $min_pc = HexExtend(\"0\");\n"
        "  my $max_pc = $min_pc;\n"
        "  foreach my $pc (keys(%{$pcs})) {\n"
        "    if (HexExtend($pc) gt $max_pc) { $max_pc = HexExtend($pc); }\n"
        "  }\n"
        "  push(@{$result}, [$prog, $min_pc, $max_pc, $zero_offset]);\n"
        "  return $result;\n"
        "}\n"
        "sub AddressAdd {\n"
        "  my $addr1 = shift;\n"
        "  my $addr2 = shift;\n"
        "  my $sum;\n"
        "  if ($address_length == 8) {\n"
        "    $sum = (hex($addr1)+hex($addr2)) % (0x10000000 * 16);\n"
        "    return sprintf(\"%08x\", $sum);\n"
        "  } else {\n"
        "    if ($main::opt_debug and $main::opt_test) {\n"
        "      print STDERR \"AddressAdd $addr1 + $addr2 = \";\n"
        "    }\n"
        "    my $a1 = substr($addr1,-7);\n"
        "    $addr1 = substr($addr1,0,-7);\n"
        "    my $a2 = substr($addr2,-7);\n"
        "    $addr2 = substr($addr2,0,-7);\n"
        "    $sum = hex($a1) + hex($a2);\n"
        "    my $c = 0;\n"
        "    if ($sum > 0xfffffff) {\n"
        "      $c = 1;\n"
        "      $sum -= 0x10000000;\n"
        "    }\n"
        "    my $r = sprintf(\"%07x\", $sum);\n"
        "    $a1 = substr($addr1,-7);\n"
        "    $addr1 = substr($addr1,0,-7);\n"
        "    $a2 = substr($addr2,-7);\n"
        "    $addr2 = substr($addr2,0,-7);\n"
        "    $sum = hex($a1) + hex($a2) + $c;\n"
        "    $c = 0;\n"
        "    if ($sum > 0xfffffff) {\n"
        "      $c = 1;\n"
        "      $sum -= 0x10000000;\n"
        "    }\n"
        "    $r = sprintf(\"%07x\", $sum) . $r;\n"
        "    $sum = hex($addr1) + hex($addr2) + $c;\n"
        "    if ($sum > 0xff) { $sum -= 0x100; }\n"
        "    $r = sprintf(\"%02x\", $sum) . $r;\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"$r\\n\"; }\n"
        "    return $r;\n"
        "  }\n"
        "}\n"
        "sub AddressSub {\n"
        "  my $addr1 = shift;\n"
        "  my $addr2 = shift;\n"
        "  my $diff;\n"
        "  if ($address_length == 8) {\n"
        "    $diff = (hex($addr1)-hex($addr2)) % (0x10000000 * 16);\n"
        "    return sprintf(\"%08x\", $diff);\n"
        "  } else {\n"
        "    my $a1 = hex(substr($addr1,-7));\n"
        "    $addr1 = substr($addr1,0,-7);\n"
        "    my $a2 = hex(substr($addr2,-7));\n"
        "    $addr2 = substr($addr2,0,-7);\n"
        "    my $b = 0;\n"
        "    if ($a2 > $a1) {\n"
        "      $b = 1;\n"
        "      $a1 += 0x10000000;\n"
        "    }\n"
        "    $diff = $a1 - $a2;\n"
        "    my $r = sprintf(\"%07x\", $diff);\n"
        "    $a1 = hex(substr($addr1,-7));\n"
        "    $addr1 = substr($addr1,0,-7);\n"
        "    $a2 = hex(substr($addr2,-7)) + $b;\n"
        "    $addr2 = substr($addr2,0,-7);\n"
        "    $b = 0;\n"
        "    if ($a2 > $a1) {\n"
        "      $b = 1;\n"
        "      $a1 += 0x10000000;\n"
        "    }\n"
        "    $diff = $a1 - $a2;\n"
        "    $r = sprintf(\"%07x\", $diff) . $r;\n"
        "    $a1 = hex($addr1);\n"
        "    $a2 = hex($addr2) + $b;\n"
        "    if ($a2 > $a1) { $a1 += 0x100; }\n"
        "    $diff = $a1 - $a2;\n"
        "    $r = sprintf(\"%02x\", $diff) . $r;\n"
        "    return $r;\n"
        "  }\n"
        "}\n"
        "sub AddressInc {\n"
        "  my $addr = shift;\n"
        "  my $sum;\n"
        "  if ($address_length == 8) {\n"
        "    $sum = (hex($addr)+1) % (0x10000000 * 16);\n"
        "    return sprintf(\"%08x\", $sum);\n"
        "  } else {\n"
        "    my $a1 = substr($addr,-7);\n"
        "    $addr = substr($addr,0,-7);\n"
        "    $sum = hex($a1) + 1;\n"
        "    my $r = sprintf(\"%07x\", $sum);\n"
        "    if ($sum <= 0xfffffff) {\n"
        "      $r = $addr . $r;\n"
        "      return HexExtend($r);\n"
        "    } else {\n"
        "      $r = \"0000000\";\n"
        "    }\n"
        "    $a1 = substr($addr,-7);\n"
        "    $addr = substr($addr,0,-7);\n"
        "    $sum = hex($a1) + 1;\n"
        "    $r = sprintf(\"%07x\", $sum) . $r;\n"
        "    if ($sum <= 0xfffffff) {\n"
        "      $r = $addr . $r;\n"
        "      return HexExtend($r);\n"
        "    } else {\n"
        "      $r = \"00000000000000\";\n"
        "    }\n"
        "    $sum = hex($addr) + 1;\n"
        "    if ($sum > 0xff) { $sum -= 0x100; }\n"
        "    $r = sprintf(\"%02x\", $sum) . $r;\n"
        "    return $r;\n"
        "  }\n"
        "}\n"
        "sub ExtractSymbols {\n"
        "  my $libs = shift;\n"
        "  my $pcset = shift;\n"
        "  my $symbols = {};\n"
        "  my %seen = ();\n"
        "  foreach my $lib (@{$libs}) {\n"
        "    my $libname = $lib->[0];\n"
        "    my $start = $lib->[1];\n"
        "    my $finish = $lib->[2];\n"
        "    my $offset = $lib->[3];\n"
        "    my $contained = [];\n"
        "    foreach my $pc (keys(%{$pcset})) {\n"
        "      if (!$seen{$pc} && ($pc ge $start) && ($pc le $finish)) {\n"
        "        $seen{$pc} = 1;\n"
        "        push(@{$contained}, $pc);\n"
        "      }\n"
        "    }\n"
        "    MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols);\n"
        "  }\n"
        "  return $symbols;\n"
        "}\n"
        "sub MapToSymbols {\n"
        "  my $image = shift;\n"
        "  my $offset = shift;\n"
        "  my $pclist = shift;\n"
        "  my $symbols = shift;\n"
        "  my $debug = 0;\n"
        "  if ($#{$pclist} < 0) { return; }\n"
        "  my $addr2line = $obj_tool_map{\"addr2line\"};\n"
        "  my $cmd = \"$addr2line -f -C -e $image\";\n"
        "  if (exists $obj_tool_map{\"addr2line_pdb\"}) {\n"
        "    $addr2line = $obj_tool_map{\"addr2line_pdb\"};\n"
        "    $cmd = \"$addr2line --demangle -f -C -e $image\";\n"
        "  }\n"
        "  if (system(\"$addr2line --help >/dev/null 2>&1\") != 0) {\n"
        "    MapSymbolsWithNM($image, $offset, $pclist, $symbols);\n"
        "    return;\n"
        "  }\n"
        "  $sep_address = undef;\n"
        "  my $nm_symbols = {};\n"
        "  MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);\n"
        "  if (defined($sep_address)) {\n"
        "    if (system(\"$cmd -i --help >/dev/null 2>&1\") == 0) {\n"
        "      $cmd .= \" -i\";\n"
        "    } else {\n"
        "      $sep_address = undef;\n"
        "    }\n"
        "  }\n"
        "  open(ADDRESSES, \">$main::tmpfile_sym\") || error(\"$main::tmpfile_sym: $!\\n\");\n"
        "  if ($debug) { print(\"---- $image ---\\n\"); }\n"
        "  for (my $i = 0; $i <= $#{$pclist}; $i++) {\n"
        "    if ($debug) { printf STDERR (\"%s\\n\", $pclist->[$i]); }\n"
        "    printf ADDRESSES (\"%s\\n\", AddressSub($pclist->[$i], $offset));\n"
        "    if (defined($sep_address)) {\n"
        "      printf ADDRESSES (\"%s\\n\", $sep_address);\n"
        "    }\n"
        "  }\n"
        "  close(ADDRESSES);\n"
        "  if ($debug) {\n"
        "    print(\"----\\n\");\n"
        "    system(\"cat $main::tmpfile_sym\");\n"
        "    print(\"----\\n\");\n"
        "    system(\"$cmd <$main::tmpfile_sym\");\n"
        "    print(\"----\\n\");\n"
        "  }\n"
        "  open(SYMBOLS, \"$cmd <$main::tmpfile_sym |\") || error(\"$cmd: $!\\n\");\n"
        "  my $count = 0;\n"
        "  while (<SYMBOLS>) {\n"
        "    s/\\r?\\n$//g;\n"
        "    my $fullfunction = $_;\n"
        "    $_ = <SYMBOLS>;\n"
        "    s/\\r?\\n$//g;\n"
        "    my $filelinenum = $_;\n"
        "    if (defined($sep_address) && $fullfunction eq $sep_symbol) {\n"
        "      $count++;\n"
        "      next;\n"
        "    }\n"
        "    $filelinenum =~ s|\\\\|/|g;\n"
        "    my $pcstr = $pclist->[$count];\n"
        "    my $function = ShortFunctionName($fullfunction);\n"
        "    if ($fullfunction eq '\?\?') {\n"
        "      my $nms = $nm_symbols->{$pcstr};\n"
        "      if (defined($nms)) {\n"
        "        $function = $nms->[0];\n"
        "        $fullfunction = $nms->[2];\n"
        "      }\n"
        "    }\n"
        "    my $sym = $symbols->{$pcstr};\n"
        "    if (!defined($sym)) {\n"
        "      $sym = [];\n"
        "      $symbols->{$pcstr} = $sym;\n"
        "    }\n"
        "    unshift(@{$sym}, $function, $filelinenum, $fullfunction);\n"
        "    if ($debug) { printf STDERR (\"%s => [%s]\\n\", $pcstr, join(\" \", @{$sym})); }\n"
        "    if (!defined($sep_address)) {\n"
        "      $count++;\n"
        "    }\n"
        "  }\n"
        "  close(SYMBOLS);\n"
        "}\n"
        "sub MapSymbolsWithNM {\n"
        "  my $image = shift;\n"
        "  my $offset = shift;\n"
        "  my $pclist = shift;\n"
        "  my $symbols = shift;\n"
        "  my $symbol_table = GetProcedureBoundaries($image, \".\");\n"
        "  if (!%{$symbol_table}) {\n"
        "    return 0;\n"
        "  }\n"
        "  my @names = sort { $symbol_table->{$a}->[0] cmp $symbol_table->{$b}->[0] }\n"
        "    keys(%{$symbol_table});\n"
        "  if ($#names < 0) {\n"
        "    foreach my $pc (@{$pclist}) {\n"
        "      my $pcstr = \"0x\" . $pc;\n"
        "      $symbols->{$pc} = [$pcstr, \"?\", $pcstr];\n"
        "    }\n"
        "    return 0;\n"
        "  }\n"
        "  my $index = 0;\n"
        "  my $fullname = $names[0];\n"
        "  my $name = ShortFunctionName($fullname);\n"
        "  foreach my $pc (sort { $a cmp $b } @{$pclist}) {\n"
        "    my $mpc = AddressSub($pc, $offset);\n"
        "    while (($index < $#names) && ($mpc ge $symbol_table->{$fullname}->[1])){\n"
        "      $index++;\n"
        "      $fullname = $names[$index];\n"
        "      $name = ShortFunctionName($fullname);\n"
        "    }\n"
        "    if ($mpc lt $symbol_table->{$fullname}->[1]) {\n"
        "      $symbols->{$pc} = [$name, \"?\", $fullname];\n"
        "    } else {\n"
        "      my $pcstr = \"0x\" . $pc;\n"
        "      $symbols->{$pc} = [$pcstr, \"?\", $pcstr];\n"
        "    }\n"
        "  }\n"
        "  return 1;\n"
        "}\n"
        "sub ShortFunctionName {\n"
        "  my $function = shift;\n"
        "  while ($function =~ s/\\([^()]*\\)(\\s*const)?//g) { }\n"
        "  while ($function =~ s/<[^<>]*>//g)  { }\n"
        "  $function =~ s/^.*\\s+(\\w+::)/$1/;\n"
        "  return $function;\n"
        "}\n"
        "sub ConfigureObjTools {\n"
        "  my $prog_file = shift;\n"
        "  (-e $prog_file)  || error(\"$prog_file does not exist.\\n\");\n"
        "  my $file_type = `/usr/bin/file -L $prog_file 2>/dev/null || /usr/bin/file $prog_file`;\n"
        "  if ($file_type =~ /64-bit/) {\n"
        "    $address_length = 16;\n"
        "  }\n"
        "  if ($file_type =~ /MS Windows/) {\n"
        "    $obj_tool_map{\"nm_pdb\"} = \"nm-pdb\";\n"
        "    $obj_tool_map{\"addr2line_pdb\"} = \"addr2line-pdb\";\n"
        "  }\n"
        "  if ($file_type =~ /Mach-O/) {\n"
        "    $obj_tool_map{\"otool\"} = \"otool\";\n"
        "    $obj_tool_map{\"addr2line\"} = \"false\";\n"
        "    $obj_tool_map{\"objdump\"} = \"false\";\n"
        "  }\n"
        "  foreach my $tool (keys %obj_tool_map) {\n"
        "    $obj_tool_map{$tool} = ConfigureTool($obj_tool_map{$tool});\n"
        "  }\n"
        "}\n"
        "sub ConfigureTool {\n"
        "  my $tool = shift;\n"
        "  my $path;\n"
        "  my $tools = $main::opt_tools || $ENV{\"PPROF_TOOLS\"} || \"\";\n"
        "  if ($tools =~ m/(,|^)\\Q$tool\\E:([^,]*)/) {\n"
        "    $path = $2;\n"
        "  } elsif ($tools ne '') {\n"
        "    foreach my $prefix (split(',', $tools)) {\n"
        "      next if ($prefix =~ /:/);\n"
        "      if (-x $prefix . $tool) {\n"
        "        $path = $prefix . $tool;\n"
        "        last;\n"
        "      }\n"
        "    }\n"
        "    if (!$path) {\n"
        "      error(\"No '$tool' found with prefix specified by \" .\n"
        "            \"--tools (or \\$PPROF_TOOLS) '$tools'\\n\");\n"
        "    }\n"
        "  } else {\n"
        "    $0 =~ m,[^/]*$,;\n"
        "    my $dirname = $`;\n"
        "    if (-x \"$dirname$tool\") {\n"
        "      $path = \"$dirname$tool\";\n"
        "    } else {\n"
        "      $path = $tool;\n"
        "    }\n"
        "  }\n"
        "  if ($main::opt_debug) { print STDERR \"Using '$path' for '$tool'.\\n\"; }\n"
        "  return $path;\n"
        "}\n"
        "sub cleanup {\n"
        "  unlink($main::tmpfile_sym);\n"
        "  unlink(keys %main::tempnames);\n"
        "  if ((scalar(@main::profile_files) > 0) &&\n"
        "      defined($main::collected_profile)) {\n"
        "    if (scalar(@main::profile_files) == 1) {\n"
        "      print STDERR \"Dynamically gathered profile is in $main::collected_profile\\n\";\n"
        "    }\n"
        "    print STDERR \"If you want to investigate this profile further, you can do:\\n\";\n"
        "    print STDERR \"\\n\";\n"
        "    print STDERR \"  pprof \\\\\\n\";\n"
        "    print STDERR \"    $main::prog \\\\\\n\";\n"
        "    print STDERR \"    $main::collected_profile\\n\";\n"
        "    print STDERR \"\\n\";\n"
        "  }\n"
        "}\n"
        "sub sighandler {\n"
        "  cleanup();\n"
        "  exit(1);\n"
        "}\n"
        "sub error {\n"
        "  my $msg = shift;\n"
        "  print STDERR $msg;\n"
        "  cleanup();\n"
        "  exit(1);\n"
        "}\n"
        "sub GetProcedureBoundariesViaNm {\n"
        "  my $nm_command = shift;\n"
        "  my $regexp = shift;\n"
        "  my $symbol_table = {};\n"
        "  open(NM, \"$nm_command |\") || error(\"$nm_command: $!\\n\");\n"
        "  my $last_start = \"0\";\n"
        "  my $routine = \"\";\n"
        "  while (<NM>) {\n"
        "    s/\\r//g;\n"
        "    if (m/^\\s*([0-9a-f]+) (.) (..*)/) {\n"
        "      my $start_val = $1;\n"
        "      my $type = $2;\n"
        "      my $this_routine = $3;\n"
        "      if ($start_val eq $last_start && $type =~ /t/i) {\n"
        "        $routine = $this_routine;\n"
        "        next;\n"
        "      } elsif ($start_val eq $last_start) {\n"
        "        next;\n"
        "      }\n"
        "      if ($this_routine eq $sep_symbol) {\n"
        "        $sep_address = HexExtend($start_val);\n"
        "      }\n"
        "      $this_routine .= \"<$start_val>\";\n"
        "      if (defined($routine) && $routine =~ m/$regexp/) {\n"
        "        $symbol_table->{$routine} = [HexExtend($last_start),\n"
        "                                     HexExtend($start_val)];\n"
        "      }\n"
        "      $last_start = $start_val;\n"
        "      $routine = $this_routine;\n"
        "    } elsif (m/^Loaded image name: (.+)/) {\n"
        "      if ($main::opt_debug) { print STDERR \"Using Image $1\\n\"; }\n"
        "    } elsif (m/^PDB file name: (.+)/) {\n"
        "      if ($main::opt_debug) { print STDERR \"Using PDB $1\\n\"; }\n"
        "    }\n"
        "  }\n"
        "  close(NM);\n"
        "  if (defined($routine) && $routine =~ m/$regexp/) {\n"
        "    $symbol_table->{$routine} = [HexExtend($last_start),\n"
        "                                 HexExtend($last_start)];\n"
        "  }\n"
        "  return $symbol_table;\n"
        "}\n"
        "sub GetProcedureBoundaries {\n"
        "  my $image = shift;\n"
        "  my $regexp = shift;\n"
        "  my $debugging = DebuggingLibrary($image);\n"
        "  if ($debugging) {\n"
        "    $image = $debugging;\n"
        "  }\n"
        "  my $nm = $obj_tool_map{\"nm\"};\n"
        "  my $cppfilt = $obj_tool_map{\"c++filt\"};\n"
        "  my $demangle_flag = \"\";\n"
        "  my $cppfilt_flag = \"\";\n"
        "  if (system(\"$nm --demangle $image >/dev/null 2>&1\") == 0) {\n"
        "    $demangle_flag = \"--demangle\";\n"
        "    $cppfilt_flag = \"\";\n"
        "  } elsif (system(\"$cppfilt $image >/dev/null 2>&1\") == 0) {\n"
        "    $cppfilt_flag = \" | $cppfilt\";\n"
        "  };\n"
        "  my $flatten_flag = \"\";\n"
        "  if (system(\"$nm -f $image >/dev/null 2>&1\") == 0) {\n"
        "    $flatten_flag = \"-f\";\n"
        "  }\n"
        "  my @nm_commands = (\"$nm -n $flatten_flag $demangle_flag\" .\n"
        "                     \" $image 2>/dev/null $cppfilt_flag\",\n"
        "                     \"$nm -D -n $flatten_flag $demangle_flag\" .\n"
        "                     \" $image 2>/dev/null $cppfilt_flag\",\n"
        "		     \"6nm $image 2>/dev/null | sort\",\n"
        "                     );\n"
        "  if (exists $obj_tool_map{\"nm_pdb\"}) {\n"
        "    my $nm_pdb = $obj_tool_map{\"nm_pdb\"};\n"
        "    push(@nm_commands, \"$nm_pdb --demangle $image 2>/dev/null\");\n"
        "  }\n"
        "  foreach my $nm_command (@nm_commands) {\n"
        "    my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp);\n"
        "    return $symbol_table if (%{$symbol_table});\n"
        "  }\n"
        "  my $symbol_table = {};\n"
        "  return $symbol_table;\n"
        "}\n"
        "sub CanonicalHex {\n"
        "  my $arg = shift;\n"
        "  return join '', (split '_',$arg);\n"
        "}\n"
        "sub AddressAddUnitTest {\n"
        "  my $test_data_8 = shift;\n"
        "  my $test_data_16 = shift;\n"
        "  my $error_count = 0;\n"
        "  my $fail_count = 0;\n"
        "  my $pass_count = 0;\n"
        "  $address_length = 8;\n"
        "  foreach my $row (@{$test_data_8}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressAdd ($row->[0], $row->[1]);\n"
        "    if ($sum ne $row->[2]) {\n"
        "      printf STDERR \"ERROR: %s != %s + %s = %s\\n\", $sum,\n"
        "             $row->[0], $row->[1], $row->[2];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressAdd 32-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count = $fail_count;\n"
        "  $fail_count = 0;\n"
        "  $pass_count = 0;\n"
        "  $address_length = 16;\n"
        "  foreach my $row (@{$test_data_16}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressAdd (CanonicalHex($row->[0]), CanonicalHex($row->[1]));\n"
        "    my $expected = join '', (split '_',$row->[2]);\n"
        "    if ($sum ne CanonicalHex($row->[2])) {\n"
        "      printf STDERR \"ERROR: %s != %s + %s = %s\\n\", $sum,\n"
        "             $row->[0], $row->[1], $row->[2];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressAdd 64-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count += $fail_count;\n"
        "  return $error_count;\n"
        "}\n"
        "sub AddressSubUnitTest {\n"
        "  my $test_data_8 = shift;\n"
        "  my $test_data_16 = shift;\n"
        "  my $error_count = 0;\n"
        "  my $fail_count = 0;\n"
        "  my $pass_count = 0;\n"
        "  $address_length = 8;\n"
        "  foreach my $row (@{$test_data_8}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressSub ($row->[0], $row->[1]);\n"
        "    if ($sum ne $row->[3]) {\n"
        "      printf STDERR \"ERROR: %s != %s - %s = %s\\n\", $sum,\n"
        "             $row->[0], $row->[1], $row->[3];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressSub 32-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count = $fail_count;\n"
        "  $fail_count = 0;\n"
        "  $pass_count = 0;\n"
        "  $address_length = 16;\n"
        "  foreach my $row (@{$test_data_16}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressSub (CanonicalHex($row->[0]), CanonicalHex($row->[1]));\n"
        "    if ($sum ne CanonicalHex($row->[3])) {\n"
        "      printf STDERR \"ERROR: %s != %s - %s = %s\\n\", $sum,\n"
        "             $row->[0], $row->[1], $row->[3];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressSub 64-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count += $fail_count;\n"
        "  return $error_count;\n"
        "}\n"
        "sub AddressIncUnitTest {\n"
        "  my $test_data_8 = shift;\n"
        "  my $test_data_16 = shift;\n"
        "  my $error_count = 0;\n"
        "  my $fail_count = 0;\n"
        "  my $pass_count = 0;\n"
        "  $address_length = 8;\n"
        "  foreach my $row (@{$test_data_8}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressInc ($row->[0]);\n"
        "    if ($sum ne $row->[4]) {\n"
        "      printf STDERR \"ERROR: %s != %s + 1 = %s\\n\", $sum,\n"
        "             $row->[0], $row->[4];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressInc 32-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count = $fail_count;\n"
        "  $fail_count = 0;\n"
        "  $pass_count = 0;\n"
        "  $address_length = 16;\n"
        "  foreach my $row (@{$test_data_16}) {\n"
        "    if ($main::opt_debug and $main::opt_test) { print STDERR \"@{$row}\\n\"; }\n"
        "    my $sum = AddressInc (CanonicalHex($row->[0]));\n"
        "    if ($sum ne CanonicalHex($row->[4])) {\n"
        "      printf STDERR \"ERROR: %s != %s + 1 = %s\\n\", $sum,\n"
        "             $row->[0], $row->[4];\n"
        "      ++$fail_count;\n"
        "    } else {\n"
        "      ++$pass_count;\n"
        "    }\n"
        "  }\n"
        "  printf STDERR \"AddressInc 64-bit tests: %d passes, %d failures\\n\",\n"
        "         $pass_count, $fail_count;\n"
        "  $error_count += $fail_count;\n"
        "  return $error_count;\n"
        "}\n"
        "sub RunUnitTests {\n"
        "  my $error_count = 0;\n"
        "  my $unit_test_data_8 = [\n"
        "    [qw(aaaaaaaa 50505050 fafafafa 5a5a5a5a aaaaaaab)],\n"
        "    [qw(50505050 aaaaaaaa fafafafa a5a5a5a6 50505051)],\n"
        "    [qw(ffffffff aaaaaaaa aaaaaaa9 55555555 00000000)],\n"
        "    [qw(00000001 ffffffff 00000000 00000002 00000002)],\n"
        "    [qw(00000001 fffffff0 fffffff1 00000011 00000002)],\n"
        "  ];\n"
        "  my $unit_test_data_16 = [\n"
        "    [qw(aaaaaaaa 50505050\n"
        "        00_000000f_afafafa 00_0000005_a5a5a5a 00_000000a_aaaaaab)],\n"
        "    [qw(50505050 aaaaaaaa\n"
        "        00_000000f_afafafa ff_ffffffa_5a5a5a6 00_0000005_0505051)],\n"
        "    [qw(ffffffff aaaaaaaa\n"
        "        00_000001a_aaaaaa9 00_0000005_5555555 00_0000010_0000000)],\n"
        "    [qw(00000001 ffffffff\n"
        "        00_0000010_0000000 ff_ffffff0_0000002 00_0000000_0000002)],\n"
        "    [qw(00000001 fffffff0\n"
        "        00_000000f_ffffff1 ff_ffffff0_0000011 00_0000000_0000002)],\n"
        "    [qw(00_a00000a_aaaaaaa 50505050\n"
        "        00_a00000f_afafafa 00_a000005_a5a5a5a 00_a00000a_aaaaaab)],\n"
        "    [qw(0f_fff0005_0505050 aaaaaaaa\n"
        "        0f_fff000f_afafafa 0f_ffefffa_5a5a5a6 0f_fff0005_0505051)],\n"
        "    [qw(00_000000f_fffffff 01_800000a_aaaaaaa\n"
        "        01_800001a_aaaaaa9 fe_8000005_5555555 00_0000010_0000000)],\n"
        "    [qw(00_0000000_0000001 ff_fffffff_fffffff\n"
        "        00_0000000_0000000 00_0000000_0000002 00_0000000_0000002)],\n"
        "    [qw(00_0000000_0000001 ff_fffffff_ffffff0\n"
        "        ff_fffffff_ffffff1 00_0000000_0000011 00_0000000_0000002)],\n"
        "  ];\n"
        "  $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16);\n"
        "  $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);\n"
        "  $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);\n"
        "  if ($error_count > 0) {\n"
        "    print STDERR $error_count, \" errors: FAILED\\n\";\n"
        "  } else {\n"
        "    print STDERR \"PASS\\n\";\n"
        "  }\n"
        "  exit ($error_count);\n"
        "}\n";
}

} // namespace brpc
