1a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans#! /usr/bin/env perl 2a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Copyright (c) 1998-2007, Google Inc. 4a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# All rights reserved. 5a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 6a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Redistribution and use in source and binary forms, with or without 7a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# modification, are permitted provided that the following conditions are 8a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# met: 9a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 10a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# * Redistributions of source code must retain the above copyright 11a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# notice, this list of conditions and the following disclaimer. 12a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# * Redistributions in binary form must reproduce the above 13a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# copyright notice, this list of conditions and the following disclaimer 14a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# in the documentation and/or other materials provided with the 15a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# distribution. 16a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# * Neither the name of Google Inc. nor the names of its 17a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# contributors may be used to endorse or promote products derived from 18a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# this software without specific prior written permission. 19a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 20a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 32a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# --- 33a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Program for printing the profile generated by common/profiler.cc, 34a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# or by the heap profiler (common/debugallocation.cc) 35a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 36a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# The profile contains a sequence of entries of the form: 37a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# <count> <stack trace> 38a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# This program parses the profile, and generates user-readable 39a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# output. 40a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 41a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Examples: 42a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 43a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof "program" "profile" 44a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Enters "interactive" mode 45a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 46a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --text "program" "profile" 47a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generates one line per procedure 48a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 49a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --gv "program" "profile" 50a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generates annotated call-graph and displays via "gv" 51a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 52a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --gv --focus=Mutex "program" "profile" 53a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Restrict to code paths that involve an entry that matches "Mutex" 54a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 55a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --gv --focus=Mutex --ignore=string "program" "profile" 56a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Restrict to code paths that involve an entry that matches "Mutex" 57a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# and does not match "string" 58a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 59a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --list=IBF_CheckDocid "program" "profile" 60a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generates disassembly listing of all routines with at least one 61a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# sample that match the --list=<regexp> pattern. The listing is 62a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# annotated with the flat and cumulative sample counts at each line. 63a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 64a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# % tools/pprof --disasm=IBF_CheckDocid "program" "profile" 65a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generates disassembly listing of all routines with at least one 66a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# sample that match the --disasm=<regexp> pattern. The listing is 67a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# annotated with the flat and cumulative sample counts at each PC value. 68a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 69a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# TODO: Use color to indicate files? 70a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 71a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansuse strict; 72a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansuse warnings; 73a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansuse Getopt::Long; 74a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 7525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy $PPROF_VERSION = "2.0"; 76a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 77a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These are the object tools we use which can come from a 78a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# user-specified location using --tools, from the PPROF_TOOLS 79a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# environment variable, or from the environment. 80a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy %obj_tool_map = ( 81a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "objdump" => "objdump", 82a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "nm" => "nm", 83a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "addr2line" => "addr2line", 84a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "c++filt" => "c++filt", 85a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ## ConfigureObjTools may add architecture-specific entries: 86a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables 87a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans #"addr2line_pdb" => "addr2line-pdb", # ditto 88a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans #"otool" => "otool", # equivalent of objdump on OS X 89a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans); 9025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# NOTE: these are lists, so you can put in commandline flags if you want. 9125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @DOT = ("dot"); # leave non-absolute, since it may be in /usr/local 9225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @GV = ("gv"); 9325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @EVINCE = ("evince"); # could also be xpdf or perhaps acroread 9425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @KCACHEGRIND = ("kcachegrind"); 9525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @PS2PDF = ("ps2pdf"); 96a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These are used for dynamic profiles 9725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy @URL_FETCHER = ("curl", "-s"); 98a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 99a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These are the web pages that servers need to support for dynamic profiles 100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $HEAP_PAGE = "/pprof/heap"; 101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" 102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param 103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ?seconds=#&event=x&period=n 104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $GROWTH_PAGE = "/pprof/growth"; 105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $CONTENTION_PAGE = "/pprof/contention"; 106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter 107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; 10825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy $CENSUSPROFILE_PAGE = "/pprof/censusprofile(?:\\?.*)?"; # must support cgi-param 10925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # "?seconds=#", 11025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # "?tags_regexp=#" and 11125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # "?type=#". 112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST 113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PROGRAM_NAME_PAGE = "/pprof/cmdline"; 114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 115d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# These are the web pages that can be named on the command line. 116d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# All the alternatives must begin with /. 117d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansmy $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" . 118d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" . 1199a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans "$FILTEREDPROFILE_PAGE|$CENSUSPROFILE_PAGE)"; 120d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# default binary name 122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $UNKNOWN_BINARY = "(unknown)"; 123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# There is a pervasive dependency on the length (in hex characters, 125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# i.e., nibbles) of an address, distinguishing between 32-bit and 126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 64-bit profiles. To err on the safe size, default to 64-bit here: 127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $address_length = 16; 128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 12925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansmy $dev_null = "/dev/null"; 13025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansif (! -e $dev_null && $^O =~ /MSWin/) { # $^O is the OS perl was built for 13125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $dev_null = "nul"; 13225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 13325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# A list of paths to search for shared object files 135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy @prefix_list = (); 136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Special routine name that should not have any symbols. 138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Used as separator to parse "addr2line -i" output. 139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $sep_symbol = '_fini'; 140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $sep_address = undef; 141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Argument parsing ##### 143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub usage_string { 145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return <<EOF; 146a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansUsage: 147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <program> <profiles> 148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <profiles> is a space separated list of profile names. 149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <symbolized-profiles> 150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <symbolized-profiles> is a list of profile files where each file contains 151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans the necessary symbol mappings as well as profile data (likely generated 152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans with --raw). 153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <profile> 154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE 155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Each name can be: 157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans /path/to/profile - a path to a profile file 158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans host:port[/<service>] - a location of a service to get profile from 159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, 161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, 1629a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $CENSUSPROFILE_PAGE, or /pprof/filteredprofile. 16325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans For instance: 16425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans pprof http://myserver.com:80$HEAP_PAGE 165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profiling). 166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --symbols <program> 167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Maps addresses to symbol names. In this mode, stdin should be a 168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans list of library mappings, in the same format as is found in the heap- 169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans and cpu-profile files (this loosely matches that of /proc/self/maps 170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans on linux), followed by a list of hex addresses to map, one per line. 171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans For more help with querying remote servers, including how to add the 173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans necessary server-side support code, see this filename (or one like it): 174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 17525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans /usr/doc/gperftools-$PPROF_VERSION/pprof_remote_servers.html 176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 177a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansOptions: 178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --cum Sort by cumulative data 179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --base=<base> Subtract <base> from <profile> before display 180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --interactive Run in interactive mode (interactive "help" gives help) [default] 181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --seconds=<n> Length of time for dynamic profiles [default=30 secs] 182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --add_lib=<file> Read additional symbols and line info from the given library 183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --lib_prefix=<dir> Comma separated list of library path prefixes 184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 185a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansReporting Granularity: 186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --addresses Report at address level 187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --lines Report at source line level 188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --functions Report at function level [default] 189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --files Report at source file level 190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 191a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansOutput type: 192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --text Generate text report 193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --callgrind Generate callgrind format to stdout 194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --gv Generate Postscript and display 1959a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans --evince Generate PDF and display 196d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --web Generate SVG and display 197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --list=<regexp> Generate source listing of matching routines 198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --disasm=<regexp> Generate disassembly of matching routines 199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --symbols Print demangled symbol names found at given addresses 200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --dot Generate DOT file to stdout 201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --ps Generate Postcript to stdout 202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --pdf Generate PDF to stdout 203d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --svg Generate SVG to stdout 204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --gif Generate GIF to stdout 205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --raw Generate symbolized pprof data (useful with remote fetch) 206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 207a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansHeap-Profile Options: 208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --inuse_space Display in-use (mega)bytes [default] 209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --inuse_objects Display in-use objects 210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --alloc_space Display allocated (mega)bytes 211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --alloc_objects Display allocated objects 212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --show_bytes Display space in bytes 213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --drop_negative Ignore negative differences 214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 215a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansContention-profile options: 216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --total_delay Display total delay at each region [default] 217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --contentions Display number of delays at each region 218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --mean_delay Display mean delay at each region 219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 220a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCall-graph Options: 221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --nodecount=<n> Show at most so many nodes [default=80] 222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --nodefraction=<f> Hide nodes below <f>*total [default=.005] 223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --edgefraction=<f> Hide edges below <f>*total [default=.001] 2249a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans --maxdegree=<n> Max incoming/outgoing edges per node [default=8] 225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --focus=<regexp> Focus on nodes matching <regexp> 226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --ignore=<regexp> Ignore nodes matching <regexp> 227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --scale=<n> Set GV scaling [default=0] 228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --heapcheck Make nodes with non-0 object counts 229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (i.e. direct leak generators) more visible 230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 231a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansMiscellaneous: 232d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --tools=<prefix or binary:fullpath>[,...] \$PATH for object tool pathnames 233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --test Run unit tests 234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --help This message 235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --version Version information 236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 237a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEnvironment Variables: 238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof 239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PPROF_TOOLS Prefix for object tools pathnames 240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 241a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansExamples: 242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof /bin/ls ls.prof 244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Enters "interactive" mode 245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text /bin/ls ls.prof 246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Outputs one line per procedure 247d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanspprof --web /bin/ls ls.prof 248d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Displays annotated call-graph in web browser 249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv /bin/ls ls.prof 250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Displays annotated call-graph via 'gv' 251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv --focus=Mutex /bin/ls ls.prof 252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Restricts to code paths including a .*Mutex.* entry 253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv --focus=Mutex --ignore=string /bin/ls ls.prof 254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Code paths including Mutex but not string 255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --list=getdir /bin/ls ls.prof 256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (Per-line) annotated source listing for getdir() 257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --disasm=getdir /bin/ls ls.prof 258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (Per-PC) annotated disassembly for getdir() 259d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 260d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanspprof http://localhost:1234/ 261d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Enters "interactive" mode 262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text localhost:1234 263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Outputs one line per procedure for localhost:1234 264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --raw localhost:1234 > ./local.raw 265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text ./local.raw 266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Fetches a remote profile for later analysis and then 267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans analyzes it in text mode. 268a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEOF 269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub version_string { 272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return <<EOF 27325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanspprof (part of gperftools $PPROF_VERSION) 274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 275a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCopyright 1998-2007 Google Inc. 276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 277a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansThis is BSD licensed software; see the source for copying conditions 278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansand license information. 279a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansThere is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A 280a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansPARTICULAR PURPOSE. 281a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEOF 282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub usage { 285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $msg = shift; 286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$msg\n\n"; 287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR usage_string(); 288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\nFATAL ERROR: $msg\n"; # just as a reminder 289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Init() { 293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Setup tmp-file name and handler to clean it up. 294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We do this in the very beginning so that we can use 295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # error() and cleanup() function anytime here after. 296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::tmpfile_sym = "/tmp/pprof$$.sym"; 297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::tmpfile_ps = "/tmp/pprof$$"; 298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile = 0; 299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SIG{'INT'} = \&sighandler; 300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Cache from filename/linenumber to source code 302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache = (); 303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_help = 0; 305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_version = 0; 306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 0; 308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_base = ''; 309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses = 0; 310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 0; 311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 0; 312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files = 0; 313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lib_prefix = ""; 314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 0; 316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 0; 317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = ""; 318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = ""; 319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_symbols = 0; 320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv = 0; 3219a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_evince = 0; 322d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 0; 323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_dot = 0; 324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ps = 0; 325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_pdf = 0; 326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gif = 0; 327d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_svg = 0; 328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_raw = 0; 329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_nodecount = 80; 331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_nodefraction = 0.005; 332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_edgefraction = 0.001; 3339a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_maxdegree = 8; 334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_focus = ''; 335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ignore = ''; 336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_scale = 0; 337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_heapcheck = 0; 338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_seconds = 30; 339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lib = ""; 340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_space = 0; 342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_objects = 0; 343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_space = 0; 344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_objects = 0; 345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_show_bytes = 0; 346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_drop_negative = 0; 347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive = 0; 348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_total_delay = 0; 350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_contentions = 0; 351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_mean_delay = 0; 352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_tools = ""; 354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_debug = 0; 355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_test = 0; 356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # These are undocumented flags used only by unittests. 358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_test_stride = 0; 359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Are we using $SYMBOL_PAGE? 361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::use_symbol_page = 0; 362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 363d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Files returned by TempName. 364d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans %main::tempnames = (); 365d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Type of profile we are dealing with 367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Supported types: 368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # cpu 369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap 370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # growth 371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # contention 372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = ''; # Empty type means "unknown" 373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans GetOptions("help!" => \$main::opt_help, 375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "version!" => \$main::opt_version, 376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "cum!" => \$main::opt_cum, 377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "base=s" => \$main::opt_base, 378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "seconds=i" => \$main::opt_seconds, 379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "add_lib=s" => \$main::opt_lib, 380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "lib_prefix=s" => \$main::opt_lib_prefix, 381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "functions!" => \$main::opt_functions, 382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "lines!" => \$main::opt_lines, 383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "addresses!" => \$main::opt_addresses, 384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "files!" => \$main::opt_files, 385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "text!" => \$main::opt_text, 386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "callgrind!" => \$main::opt_callgrind, 387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "list=s" => \$main::opt_list, 388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "disasm=s" => \$main::opt_disasm, 389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "symbols!" => \$main::opt_symbols, 390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "gv!" => \$main::opt_gv, 3919a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans "evince!" => \$main::opt_evince, 392d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "web!" => \$main::opt_web, 393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "dot!" => \$main::opt_dot, 394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "ps!" => \$main::opt_ps, 395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "pdf!" => \$main::opt_pdf, 396d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "svg!" => \$main::opt_svg, 397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "gif!" => \$main::opt_gif, 398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "raw!" => \$main::opt_raw, 399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "interactive!" => \$main::opt_interactive, 400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "nodecount=i" => \$main::opt_nodecount, 401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "nodefraction=f" => \$main::opt_nodefraction, 402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "edgefraction=f" => \$main::opt_edgefraction, 4039a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans "maxdegree=i" => \$main::opt_maxdegree, 404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "focus=s" => \$main::opt_focus, 405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "ignore=s" => \$main::opt_ignore, 406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "scale=i" => \$main::opt_scale, 407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "heapcheck" => \$main::opt_heapcheck, 408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "inuse_space!" => \$main::opt_inuse_space, 409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "inuse_objects!" => \$main::opt_inuse_objects, 410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "alloc_space!" => \$main::opt_alloc_space, 411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "alloc_objects!" => \$main::opt_alloc_objects, 412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "show_bytes!" => \$main::opt_show_bytes, 413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "drop_negative!" => \$main::opt_drop_negative, 414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "total_delay!" => \$main::opt_total_delay, 415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "contentions!" => \$main::opt_contentions, 416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "mean_delay!" => \$main::opt_mean_delay, 417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "tools=s" => \$main::opt_tools, 418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "test!" => \$main::opt_test, 419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "debug!" => \$main::opt_debug, 420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Undocumented flags used only by unittests: 421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "test_stride=i" => \$main::opt_test_stride, 422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ) || usage("Invalid option(s)"); 423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Deal with the standard --help and --version 425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_help) { 426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print usage_string(); 427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_version) { 431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print version_string(); 432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassembly/listing/symbols mode requires address-level info 436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm || $main::opt_list || $main::opt_symbols) { 437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 0; 438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 0; 439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses = 1; 440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files = 0; 441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check heap-profiling flags 444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_space + 445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_objects + 446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_space + 447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_objects > 1) { 448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Specify at most on of --inuse/--alloc options"); 449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check output granularities 452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $grains = 453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions + 454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines + 455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses + 456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files + 457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0; 458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($grains > 1) { 459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Only specify one output granularity option"); 460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($grains == 0) { 462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 1; 463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check output modes 466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $modes = 467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text + 468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind + 469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_list eq '' ? 0 : 1) + 470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_disasm eq '' ? 0 : 1) + 471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_symbols == 0 ? 0 : 1) + 472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv + 4739a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_evince + 474d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web + 475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_dot + 476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ps + 477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_pdf + 478d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_svg + 479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gif + 480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_raw + 481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive + 482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0; 483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($modes > 1) { 484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Only specify one output mode"); 485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($modes == 0) { 487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-t STDOUT) { # If STDOUT is a tty, activate interactive mode 488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive = 1; 489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 1; 491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_test) { 495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans RunUnitTests(); 496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Should not return 497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Binary name and profile arguments list 501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = ""; 502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @main::pfile_args = (); 503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote profiling without a binary (using $SYMBOL_PAGE instead) 50525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (@ARGV > 0) { 50625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (IsProfileURL($ARGV[0])) { 50725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $main::use_symbol_page = 1; 50825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif (IsSymbolizedProfileFile($ARGV[0])) { 50925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $main::use_symbolized_profile = 1; 51025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file 51125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbol_page || $main::use_symbolized_profile) { 515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We don't need a binary! 516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %disabled = ('--lines' => $main::opt_lines, 517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '--disasm' => $main::opt_disasm); 518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for my $option (keys %disabled) { 519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("$option cannot be used without a binary") if $disabled{$option}; 520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Set $main::prog later... 522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans scalar(@ARGV) || usage("Did not specify profile file"); 523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_symbols) { 524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # --symbols needs a binary-name (to run nm on, etc) but not profiles 525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = shift(@ARGV) || usage("Did not specify program"); 526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = shift(@ARGV) || usage("Did not specify program"); 528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans scalar(@ARGV) || usage("Did not specify profile file"); 529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse profile file/location arguments 532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $farg (@ARGV) { 533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($farg =~ m/(.*)\@([0-9]+)(|\/.*)$/ ) { 534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $machine = $1; 535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num_machines = $2; 536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $path = $3; 537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $num_machines; $i++) { 538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@main::pfile_args, "$i.$machine$path"); 539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@main::pfile_args, $farg); 542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbol_page) { 546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unless (IsProfileURL($main::pfile_args[0])) { 547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("The first profile should be a remote form to use $SYMBOL_PAGE\n"); 548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans CheckSymbolPage(); 550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = FetchProgramName(); 551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (!$main::use_symbolized_profile) { # may not need objtools! 552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ConfigureObjTools($main::prog) 553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 55525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Break the opt_lib_prefix into the prefix_list array 556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @prefix_list = split (',', $main::opt_lib_prefix); 557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remove trailing / from the prefixes, in the list to prevent 559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # searching things like /my/path//lib/mylib.so 560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach (@prefix_list) { 561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s|/+$||; 562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Main() { 566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Init(); 567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = undef; 568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @main::profile_files = (); 569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::op_time = time(); 570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Printing symbols is special and requires a lot less info that most. 572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_symbols) { 573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintSymbols(*STDIN); # Get /proc/maps and symbols output from stdin 574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Fetch all profile data 578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfiles(); 579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # this will hold symbols that we read from the profile files 581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_map = {}; 582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read one profile, pick the last item on the list 584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $data = ReadProfile($main::prog, pop(@main::profile_files)); 585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = $data->{profile}; 586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = $data->{pcs}; 587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = $data->{libs}; # Info about main program and shared libraries 588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $data->{symbols}); 589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add additional profiles, if available. 591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (scalar(@main::profile_files) > 0) { 592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pname (@main::profile_files) { 593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $data2 = ReadProfile($main::prog, $pname); 594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = AddProfile($profile, $data2->{profile}); 595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs = AddPcs($pcs, $data2->{pcs}); 596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $data2->{symbols}); 597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Subtract base from profile, if specified 601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_base ne '') { 602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $base = ReadProfile($main::prog, $main::opt_base); 603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = SubtractProfile($profile, $base->{profile}); 604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs = AddPcs($pcs, $base->{pcs}); 605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $base->{symbols}); 606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get total data in profile 609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = TotalProfile($profile); 610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Collect symbols 612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols; 613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbolized_profile) { 614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = FetchSymbols($pcs, $symbol_map); 615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::use_symbol_page) { 616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = FetchSymbols($pcs); 617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 618d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # TODO(csilvers): $libs uses the /proc/self/maps data from profile1, 619d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # which may differ from the data from subsequent profiles, especially 620d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # if they were run on different machines. Use appropriate libs for 621d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # each pc somehow. 622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = ExtractSymbols($libs, $pcs); 623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remove uniniteresting stack items 626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = RemoveUninterestingFrames($symbols, $profile); 627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Focus? 629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_focus ne '') { 630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = FocusProfile($symbols, $profile, $main::opt_focus); 631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Ignore? 634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_ignore ne '') { 635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore); 636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = ExtractCalls($symbols, $profile); 639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reduce profiles to required output granularity, and also clean 641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # each stack trace so a given entry exists at most once. 642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print 649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$main::opt_interactive) { 650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm) { 65125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm); 652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_list) { 65325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintListing($total, $libs, $flat, $cumulative, $main::opt_list, 0); 654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_text) { 655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make sure the output is empty when have nothing to report 656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (only matters when --heapcheck is given but we must be 657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # compatible with old branches that did not pass --heapcheck always): 658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($total != 0) { 659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("Total: %s %s\n", Unparse($total), Units()); 660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 66125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintText($symbols, $flat, $cumulative, -1); 662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_raw) { 663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintSymbolizedProfile($symbols, $profile, $main::prog); 664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_callgrind) { 665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintCallgrind($calls); 666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { 668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_gv) { 669d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunGV(TempName($main::next_tmpfile, "ps"), ""); 6709a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($main::opt_evince) { 67125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans RunEvince(TempName($main::next_tmpfile, "pdf"), ""); 672d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web) { 673d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $tmp = TempName($main::next_tmpfile, "svg"); 674d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunWeb($tmp); 675d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # The command we run might hand the file name off 676d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # to an already running browser instance and then exit. 677d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Normally, we'd remove $tmp on exit (right now), 678d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # but fork a child to remove $tmp a little later, so that the 679d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # browser has time to load it first. 680d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delete $main::tempnames{$tmp}; 681d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (fork() == 0) { 682d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans sleep 5; 683d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink($tmp); 684d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans exit(0); 685d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 688d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans cleanup(); 689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans InteractiveMode($profile, $symbols, $libs, $total); 694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Entry Point ##### 701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 702a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansMain(); 703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Temporary code to detect if we're running on a Goobuntu system. 705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These systems don't have the right stuff installed for the special 706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Readline libraries to work, so as a temporary workaround, we default 707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# to using the normal stdio code, rather than the fancier readline-based 708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# code 709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadlineMightFail { 710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-e '/lib/libtermcap.so.2') { 711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; # libtermcap exists, so readline should be okay 712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunGV { 718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $bg = shift; # "" or " &" if we should run in background 72025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (!system(ShellEscape(@GV, "--version") . " >$dev_null 2>&1")) { 721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Options using double dash are supported by this gv version. 722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Also, turn on noantialias to better handle bug in gv for 723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # postscript files with large dimensions. 724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Maybe we should not pass the --noantialias flag 725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if the gv version is known to work properly without the flag. 72625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system(ShellEscape(@GV, "--scale=$main::opt_scale", "--noantialias", $fname) 72725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans . $bg); 728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Old gv version - only supports options that use single dash. 73025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print STDERR ShellEscape(@GV, "-scale", $main::opt_scale) . "\n"; 73125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system(ShellEscape(@GV, "-scale", "$main::opt_scale", $fname) . $bg); 732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 7359a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evanssub RunEvince { 7369a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $fname = shift; 7379a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $bg = shift; # "" or " &" if we should run in background 73825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system(ShellEscape(@EVINCE, $fname) . $bg); 7399a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans} 7409a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 741d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub RunWeb { 742d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fname = shift; 743d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Loading web page file:///$fname\n"; 744d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 745d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (`uname` =~ /Darwin/) { 746d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # OS X: open will use standard preference for SVG files. 747d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans system("/usr/bin/open", $fname); 748d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return; 749d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 750d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 751d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Some kind of Unix; try generic symlinks, then specific browsers. 752d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # (Stop once we find one.) 753d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Works best if the browser is already running. 754d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my @alt = ( 755d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "/etc/alternatives/gnome-www-browser", 756d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "/etc/alternatives/x-www-browser", 757d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "google-chrome", 758d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "firefox", 759d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ); 760d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $b (@alt) { 761d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (system($b, $fname) == 0) { 762d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return; 763d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 764d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 765d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 766d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Could not load web browser.\n"; 767d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 768d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunKcachegrind { 770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $bg = shift; # "" or " &" if we should run in background 77225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print STDERR "Starting '@KCACHEGRIND " . $fname . $bg . "'\n"; 77325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system(ShellEscape(@KCACHEGRIND, $fname) . $bg); 774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Interactive helper routines ##### 778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveMode { 780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $| = 1; # Make output unbuffered for interactive mode 781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($orig_profile, $symbols, $libs, $total) = @_; 782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Welcome to pprof! For help, type 'help'.\n"; 784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Use ReadLine if it's installed and input comes from a console. 786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( -t STDIN && 787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans !ReadlineMightFail() && 788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans defined(eval {require Term::ReadLine}) ) { 789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $term = new Term::ReadLine 'pprof'; 790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ( defined ($_ = $term->readline('(pprof) '))) { 791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $term->addhistory($_) if /\S/; 792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) { 793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # exit when we get an interactive command to quit 794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { # don't have readline 797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (1) { 798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "(pprof) "; 799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = <STDIN>; 800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last if ! defined $_ ; 801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Save some flags that might be reset by InteractiveCommand() 804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $save_opt_lines = $main::opt_lines; 805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) { 807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # exit when we get an interactive command to quit 808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Restore flags 811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = $save_opt_lines; 812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Takes two args: orig profile, and command to run. 817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns 1 if we should keep going, or 0 if we were asked to quit 818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveCommand { 819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my($orig_profile, $symbols, $libs, $total, $command) = @_; 820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = $command; # just to make future m//'s easier 821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($_)) { 822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 825d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*quit/) { 826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 828d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*help/) { 829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans InteractiveHelpMessage(); 830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Clear all the mode options -- mode is controlled by "$command" 833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 0; 834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 0; 835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = 0; 836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = 0; 837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv = 0; 8389a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_evince = 0; 839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 0; 840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 841d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*(text|top)(\d*)\s*(.*)/) { 842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 1; 843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line_limit = ($2 ne "") ? int($2) : 10; 845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($routine, $ignore) = ParseInteractiveArgs($3); 849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 85025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); 851a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 852a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 853a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 854a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 855a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 85725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintText($symbols, $flat, $cumulative, $line_limit); 858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 860d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*callgrind\s*([^ \n]*)/) { 861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 1; 862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = ExtractCalls($symbols, $orig_profile); 865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = $1; 866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $1 eq '' ) { 867d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $filename = TempName($main::next_tmpfile, "callgrind"); 868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintCallgrind($calls, $filename); 870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $1 eq '' ) { 871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans RunKcachegrind($filename, " & "); 872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile++; 873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 87725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (m/^\s*(web)?list\s*(.+)/) { 87825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $html = (defined($1) && ($1 eq "web")); 879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = 1; 880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 88325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ($routine, $ignore) = ParseInteractiveArgs($2); 884a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 88525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); 886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 89225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintListing($total, $libs, $flat, $cumulative, $routine, $html); 893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 895d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*disasm\s*(.+)/) { 896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = 1; 897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($routine, $ignore) = ParseInteractiveArgs($1); 901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 90325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore); 904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 906a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 91025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans PrintDisassembly($libs, $flat, $cumulative, $routine); 911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 9139a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if (m/^\s*(gv|web|evince)\s*(.*)/) { 914d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_gv = 0; 9159a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_evince = 0; 916d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 0; 917d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($1 eq "gv") { 918d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_gv = 1; 9199a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($1 eq "evince") { 9209a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::opt_evince = 1; 921d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($1 eq "web") { 922d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 1; 923d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus; 926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 927d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ($focus, $ignore) = ParseInteractiveArgs($2); 928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 93025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $profile = ProcessProfile($total, $orig_profile, $symbols, 93125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $focus, $ignore); 932a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 934a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { 939d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_gv) { 940d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunGV(TempName($main::next_tmpfile, "ps"), " &"); 9419a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($main::opt_evince) { 9429a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans RunEvince(TempName($main::next_tmpfile, "pdf"), " &"); 943d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web) { 944d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunWeb(TempName($main::next_tmpfile, "svg")); 945d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile++; 947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 950d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*$/) { 951d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 1; 952d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 953d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Unknown command: try 'help'.\n"; 954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ProcessProfile { 95925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total_count = shift; 960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $orig_profile = shift; 961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = shift; 963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = shift; 964a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = $orig_profile; 967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("Total: %s %s\n", Unparse($total_count), Units()); 968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($focus ne '') { 969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = FocusProfile($symbols, $profile, $focus); 970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus_count = TotalProfile($profile); 971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n", 972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $focus, 973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($focus_count), Units(), 974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total_count), ($focus_count*100.0) / $total_count); 975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ignore ne '') { 977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = IgnoreProfile($symbols, $profile, $ignore); 978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore_count = TotalProfile($profile); 979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("After ignoring '%s': %s %s of %s (%0.1f%%)\n", 980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ignore, 981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($ignore_count), Units(), 982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total_count), 983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($ignore_count*100.0) / $total_count); 984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile; 987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveHelpMessage { 990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR <<ENDOFHELP; 991a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansInteractive pprof mode 992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 993a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCommands: 994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans gv 995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans gv [focus] [-ignore1] [-ignore2] 996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show graphical hierarchical display of current profile. Without 997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans any arguments, shows all samples in the profile. With the optional 998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "focus" argument, restricts the samples shown to just those where 999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans the "focus" regular expression matches a routine name on the stack 1000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans trace. 1001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1002d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans web 1003d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans web [focus] [-ignore1] [-ignore2] 1004d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Like GV, but displays profile in your web browser instead of using 1005d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Ghostview. Works best if your web browser is already running. 1006d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans To change the browser that gets used: 1007d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans On Linux, set the /etc/alternatives/gnome-www-browser symlink. 1008d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans On OS X, change the Finder association for SVG files. 1009d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans list [routine_regexp] [-ignore1] [-ignore2] 1011a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show source listing of routines whose names match "routine_regexp" 1012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 101325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans weblist [routine_regexp] [-ignore1] [-ignore2] 101425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Displays a source listing of routines whose names match "routine_regexp" 101525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans in a web browser. You can click on source lines to view the 101625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans corresponding disassembly. 101725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 1018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top [--cum] [-ignore1] [-ignore2] 1019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top20 [--cum] [-ignore1] [-ignore2] 1020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top37 [--cum] [-ignore1] [-ignore2] 1021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show top lines ordered by flat profile count, or cumulative count 1022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if --cum is specified. If a number is present after 'top', the 1023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top K routines will be shown (defaults to showing the top 10) 1024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans disasm [routine_regexp] [-ignore1] [-ignore2] 1026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show disassembly of routines whose names match "routine_regexp", 1027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans annotated with sample counts. 1028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans callgrind 1030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans callgrind [filename] 1031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Generates callgrind file. If no filename is given, kcachegrind is called. 1032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans help - This listing 1034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans quit or ^D - End pprof 1035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1036a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansFor commands that accept optional -ignore tags, samples where any routine in 1037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansthe stack trace matches the regular expression in any of the -ignore 1038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansparameters will be ignored. 1039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1040a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansFurther pprof details are available at this location (or one similar): 1041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 104225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans /usr/doc/gperftools-$PPROF_VERSION/cpu_profiler.html 104325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans /usr/doc/gperftools-$PPROF_VERSION/heap_profiler.html 1044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1045a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansENDOFHELP 1046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseInteractiveArgs { 1048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $args = shift; 1049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = ""; 1050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = ""; 1051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split(/ +/, $args); 1052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach $a (@x) { 1053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a =~ m/^(--|-)lines$/) { 1054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 1; 1055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($a =~ m/^(--|-)cum$/) { 1056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 1; 1057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($a =~ m/^-(.*)/) { 1058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ignore .= (($ignore ne "") ? "|" : "" ) . $1; 1059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $focus .= (($focus ne "") ? "|" : "" ) . $a; 1061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ignore ne "") { 1064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Ignoring samples in call stacks that match '$ignore'\n"; 1065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ($focus, $ignore); 1067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Output code ##### 1070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1071d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub TempName { 1072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fnum = shift; 1073d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $ext = shift; 1074d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $file = "$main::tmpfile_ps.$fnum.$ext"; 1075d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::tempnames{$file} = 1; 1076d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $file; 1077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print profile data in packed binary format (64-bit) to standard out 1080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintProfileData { 1081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 1082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print header (64-bit style) 1084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (zero) (header-size) (version) (sample-period) (zero) 1085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', 0, 0, 3, 0, 0, 0, 1, 0, 0, 0); 1086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 1088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 1089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 1090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 1091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $depth = $#addrs + 1; 1092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # int(foo / 2**32) is the only reliable way to get rid of bottom 1093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 32 bits on both 32- and 64-bit systems. 1094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', $count & 0xFFFFFFFF, int($count / 2**32)); 1095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', $depth & 0xFFFFFFFF, int($depth / 2**32)); 1096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $full_addr (@addrs) { 1098a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = $full_addr; 1099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr =~ s/0x0*//; # strip off leading 0x, zeroes 1100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($addr) > 16) { 1101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Invalid address in profile: $full_addr\n"; 1102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 1103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $low_addr = substr($addr, -8); # get last 8 hex chars 1105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $high_addr = substr($addr, -16, 8); # get up to 8 more hex chars 1106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', hex('0x' . $low_addr), hex('0x' . $high_addr)); 1107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print symbols and profile data 1113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSymbolizedProfile { 1114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 1116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 1119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_marker = $&; 1120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '--- ', $symbol_marker, "\n"; 1122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($prog)) { 1123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print 'binary=', $prog, "\n"; 1124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (my ($pc, $name) = each(%{$symbols})) { 1126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sep = ' '; 1127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '0x', $pc; 1128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We have a list of function names, which include the inlined 1129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # calls. They are separated (and terminated) by --, which is 1130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # illegal in function names. 1131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = 2; $j <= $#{$name}; $j += 3) { 1132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print $sep, $name->[$j]; 1133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep = '--'; 1134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print "\n"; 1136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '---', "\n"; 1138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash 1140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_marker = $&; 1141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '--- ', $profile_marker, "\n"; 1142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($main::collected_profile)) { 1143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if used with remote fetch, simply dump the collected profile to output. 1144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(SRC, "<$main::collected_profile"); 1145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<SRC>) { 1146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print $_; 1147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SRC); 1149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # dump a cpu-format profile to standard out 1151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintProfileData($profile); 1152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print text output 1156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintText { 1157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line_limit = shift; 1161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 116225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total = TotalProfile($flat); 116325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 1164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Which profile to sort by? 1165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $s = $main::opt_cum ? $cumulative : $flat; 1166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $running_sum = 0; 1168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = 0; 1169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b } 1170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$cumulative})) { 1171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = GetEntry($flat, $k); 1172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = GetEntry($cumulative, $k); 1173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running_sum += $f; 1174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $k; 1176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$k})) { 1177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = $symbols->{$k}->[0] . " " . $symbols->{$k}->[1]; 1178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_addresses) { 1179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = $k . " " . $sym; 1180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f != 0 || $c != 0) { 1184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%8s %6s %6s %8s %6s %s\n", 1185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($f), 1186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($f, $total), 1187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($running_sum, $total), 1188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($c), 1189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($c, $total), 1190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym); 1191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lines++; 119325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans last if ($line_limit >= 0 && $lines >= $line_limit); 119425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 119525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 119625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 119725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Callgrind format has a compression for repeated function and file 119825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# names. You show the name the first time, and just use its number 119925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# subsequently. This can cut down the file to about a third or a 120025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# quarter of its uncompressed size. $key and $val are the key/value 120125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# pair that would normally be printed by callgrind; $map is a map from 120225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# value to number. 120325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub CompressedCGName { 120425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my($key, $val, $map) = @_; 120525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $idx = $map->{$val}; 120625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # For very short keys, providing an index hurts rather than helps. 120725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (length($val) <= 3) { 120825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return "$key=$val\n"; 120925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif (defined($idx)) { 121025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return "$key=($idx)\n"; 121125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 121225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # scalar(keys $map) gives the number of items in the map. 121325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $idx = scalar(keys(%{$map})) + 1; 121425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $map->{$val} = $idx; 121525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return "$key=($idx) $val\n"; 1216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print the call graph in a way that's suiteable for callgrind. 1220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintCallgrind { 1221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = shift; 1222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename; 122325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my %filename_to_index_map; 122425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my %fnname_to_index_map; 122525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 1226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_interactive) { 1227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = shift; 1228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Writing callgrind file to '$filename'.\n" 1229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = "&STDOUT"; 1231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 123225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(CG, ">$filename"); 1233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("events: Hits\n\n"); 1234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $call ( map { $_->[0] } 1235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sort { $a->[1] cmp $b ->[1] || 1236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a->[2] <=> $b->[2] } 1237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [$_, $1, $2] } 1239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys %$calls ) { 1240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = int($calls->{$call}); 1241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ( $caller_file, $caller_line, $caller_function, 1243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $callee_file, $callee_line, $callee_function ) = 1244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ( $1, $2, $3, $5, $6, $7 ); 1245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 124625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # TODO(csilvers): for better compression, collect all the 124725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # caller/callee_files and functions first, before printing 124825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # anything, and only compress those referenced more than once. 124925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf CG CompressedCGName("fl", $caller_file, \%filename_to_index_map); 125025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf CG CompressedCGName("fn", $caller_function, \%fnname_to_index_map); 1251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined $6) { 125225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf CG CompressedCGName("cfl", $callee_file, \%filename_to_index_map); 125325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf CG CompressedCGName("cfn", $callee_function, \%fnname_to_index_map); 1254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("calls=$count $callee_line\n"); 1255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("$caller_line $count\n\n"); 1257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print disassembly for all all routines that match $main::opt_disasm 1261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDisassembly { 1262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 1263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $disasm_opts = shift; 126625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 126725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total = TotalProfile($flat); 1268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $lib (@{$libs}) { 1270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts); 1271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = AddressSub($lib->[1], $lib->[3]); 1272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $routine (sort ByName keys(%{$symbol_table})) { 1273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = $symbol_table->{$routine}->[0]; 1274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = $symbol_table->{$routine}->[1]; 1275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # See if there are any samples in this routine 1276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $length = hex(AddressSub($end_addr, $start_addr)); 1277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = AddressAdd($start_addr, $offset); 1278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $length; $i++) { 1279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($cumulative->{$addr})) { 1280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintDisassembledFunction($lib->[0], $offset, 1281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine, $flat, $cumulative, 1282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start_addr, $end_addr, $total); 1283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = AddressInc($addr); 1286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return reference to array of tuples of the form: 1292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# [start_address, filename, linenumber, instruction, limit_address] 1293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# E.g., 1294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] 1295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Disassemble { 1296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 1300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $objdump = $obj_tool_map{"objdump"}; 130225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $cmd = ShellEscape($objdump, "-C", "-d", "-l", "--no-show-raw-insn", 130325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "--start-address=0x$start_addr", 130425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "--stop-address=0x$end_addr", $prog); 130525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); 1306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @result = (); 1307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = ""; 1308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $linenumber = -1; 1309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last = ["", "", "", ""]; 1310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<OBJDUMP>) { 1311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chop; 1313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m|\s*([^:\s]+):(\d+)\s*$|) { 1314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Location line of the form: 1315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # <filename>:<linenumber> 1316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = $1; 1317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $linenumber = $2; 1318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^ +([0-9a-f]+):\s*(.*)/) { 1319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassembly line -- zero-extend address to full length 1320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = HexExtend($1); 1321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = AddressAdd($addr, $offset); 1322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last->[4] = $k; # Store ending address for previous instruction 1323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last = [$k, $filename, $linenumber, $2, $end_addr]; 1324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $last); 1325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OBJDUMP); 1328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return @result; 1329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# The input file should contain lines of the form /proc/maps-like 1332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# output (same format as expected from the profiles) or that looks 1333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# like hex addresses (like "0xDEADBEEF"). We will parse all 1334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /proc/maps output, and for all the hex addresses, we will output 1335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# "short" symbol names, one per line, in the same order as the input. 1336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSymbols { 1337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maps_and_symbols_file = shift; 1338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ParseLibraries expects pcs to be in a set. Fine by us... 1340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pclist = (); # pcs in sorted order 1341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 1342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ""; 1343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $line (<$maps_and_symbols_file>) { 1344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 1345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /\b(0x[0-9a-f]+)\b/i) { 1346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@pclist, HexExtend($1)); 1347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pclist[-1]} = 1; 1348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $line; 1350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = ParseLibraries($main::prog, $map, $pcs); 1354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = ExtractSymbols($libs, $pcs); 1355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@pclist) { 1357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ->[0] is the shortname, ->[2] is the full name 1358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print(($symbols->{$pc}->[0] || "??") . "\n"); 1359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# For sorting functions by name 1364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ByName { 1365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ShortFunctionName($a) cmp ShortFunctionName($b); 1366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 136825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Print source-listing for all all routines that match $list_opts 1369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintListing { 137025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total = shift; 1371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 1372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $list_opts = shift; 137525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $html = shift; 137625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 137725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $output = \*STDOUT; 137825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fname = ""; 1379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 138025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 138125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Arrange to write the output to a temporary file 138225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $fname = TempName($main::next_tmpfile, "html"); 138325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $main::next_tmpfile++; 138425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (!open(TEMP, ">$fname")) { 138525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print STDERR "$fname: $!\n"; 138625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return; 138725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 138825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = \*TEMP; 138925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print $output HtmlListingHeader(); 139025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf $output ("<div class=\"legend\">%s<br>Total: %s %s</div>\n", 139125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $main::prog, Unparse($total), Units()); 139225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 139325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 139425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $listed = 0; 1395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $lib (@{$libs}) { 1396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts); 1397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = AddressSub($lib->[1], $lib->[3]); 1398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $routine (sort ByName keys(%{$symbol_table})) { 1399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print if there are any samples in this routine 1400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = $symbol_table->{$routine}->[0]; 1401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = $symbol_table->{$routine}->[1]; 1402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $length = hex(AddressSub($end_addr, $start_addr)); 1403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = AddressAdd($start_addr, $offset); 1404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $length; $i++) { 1405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($cumulative->{$addr})) { 140625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $listed += PrintSource( 140725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $lib->[0], $offset, 140825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $routine, $flat, $cumulative, 140925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $start_addr, $end_addr, 141025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $html, 141125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output); 1412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = AddressInc($addr); 1415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 141825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 141925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 142025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($listed > 0) { 142125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print $output HtmlListingFooter(); 142225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans close($output); 142325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans RunWeb($fname); 142425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 142525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans close($output); 142625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans unlink($fname); 142725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 142825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 142925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 143025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 143125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub HtmlListingHeader { 143225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return <<'EOF'; 143325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<DOCTYPE html> 143425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<html> 143525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<head> 143625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<title>Pprof listing</title> 143725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<style type="text/css"> 143825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansbody { 143925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans font-family: sans-serif; 144025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 144125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansh1 { 144225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans font-size: 1.5em; 144325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans margin-bottom: 4px; 144425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 144525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.legend { 144625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans font-size: 1.25em; 144725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 144825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.line { 144925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #aaaaaa; 145025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 145125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.nop { 145225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #aaaaaa; 145325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 145425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.unimportant { 145525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #cccccc; 145625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 145725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.disasmloc { 145825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #000000; 145925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 146025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.deadsrc { 146125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans cursor: pointer; 146225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 146325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.deadsrc:hover { 146425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans background-color: #eeeeee; 146525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 146625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.livesrc { 146725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #0000ff; 146825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans cursor: pointer; 146925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 147025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.livesrc:hover { 147125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans background-color: #eeeeee; 147225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 147325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans.asm { 147425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans color: #008800; 147525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans display: none; 147625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 147725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans</style> 147825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<script type="text/javascript"> 147925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evansfunction pprof_toggle_asm(e) { 148025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans var target; 148125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (!e) e = window.event; 148225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (e.target) target = e.target; 148325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans else if (e.srcElement) target = e.srcElement; 148425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 148525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (target) { 148625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans var asm = target.nextSibling; 148725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (asm && asm.className == "asm") { 148825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans asm.style.display = (asm.style.display == "block" ? "" : "block"); 148925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans e.preventDefault(); 149025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return false; 149125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 149225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 149325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 149425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans</script> 149525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans</head> 149625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans<body> 149725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason EvansEOF 149825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 149925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 150025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub HtmlListingFooter { 150125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return <<'EOF'; 150225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans</body> 150325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans</html> 150425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason EvansEOF 150525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 150625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 150725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub HtmlEscape { 150825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $text = shift; 150925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $text =~ s/&/&/g; 151025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $text =~ s/</</g; 151125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $text =~ s/>/>/g; 151225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return $text; 1513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns the indentation of the line, if it has any non-whitespace 1516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# characters. Otherwise, returns -1. 1517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Indentation { 1518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = shift; 1519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^(\s*)\S/) { 1520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return length($1); 1521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; 1523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 152625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# If the symbol table contains inlining info, Disassemble() may tag an 152725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# instruction with a location inside an inlined function. But for 152825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# source listings, we prefer to use the location in the function we 152925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# are listing. So use MapToSymbols() to fetch full location 153025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# information for each instruction and then pick out the first 153125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# location from a location list (location list contains callers before 153225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# callees in case of inlining). 153325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# 153425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# After this routine has run, each entry in $instructions contains: 153525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [0] start address 153625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [1] filename for function we are listing 153725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [2] line number for function we are listing 153825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [3] disassembly 153925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [4] limit address 154025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [5] most specific filename (may be different from [1] due to inlining) 154125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# [6] most specific line number (may be different from [2] due to inlining) 154225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub GetTopLevelLineNumbers { 154325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my ($lib, $offset, $instructions) = @_; 154425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $pcs = []; 154525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans for (my $i = 0; $i <= $#{$instructions}; $i++) { 154625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@{$pcs}, $instructions->[$i]->[0]); 154725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 154825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $symbols = {}; 154925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans MapToSymbols($lib, $offset, $pcs, $symbols); 155025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans for (my $i = 0; $i <= $#{$instructions}; $i++) { 155125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $e = $instructions->[$i]; 155225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@{$e}, $e->[1]); 155325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@{$e}, $e->[2]); 155425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $addr = $e->[0]; 155525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $sym = $symbols->{$addr}; 155625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($sym)) { 155725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($#{$sym} >= 2 && $sym->[1] =~ m/^(.*):(\d+)$/) { 155825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $e->[1] = $1; # File name 155925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $e->[2] = $2; # Line number 156025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 156125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 156225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 156325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 156425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 1565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print source-listing for one routine 1566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSource { 1567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = shift; 1570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 157425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $html = shift; 157525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $output = shift; 1576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassemble all instructions (just to get line numbers) 1578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); 157925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans GetTopLevelLineNumbers($prog, $offset, \@instructions); 1580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 1: assume that the first source file encountered in the 1582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # disassembly contains the routine 1583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = undef; 1584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($instructions[$i]->[2] >= 0) { 1586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = $instructions[$i]->[1]; 1587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($filename)) { 1591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "no filename found in $routine\n"; 159225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return 0; 1593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 2: assume that the largest line number from $filename is the 1596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # end of the procedure. This is typically safe since if P1 contains 1597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # an inlined call to P2, then P2 usually occurs earlier in the 1598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # source file. If this does not work, we might have to compute a 1599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # density profile or just print all regions we find. 1600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lastline = 0; 1601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = $instructions[$i]->[1]; 1603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = $instructions[$i]->[2]; 1604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($f eq $filename) && ($l > $lastline)) { 1605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lastline = $l; 1606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 3: assume the first source location from "filename" is the start of 1610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the source code. 1611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $firstline = 1; 1612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($instructions[$i]->[1] eq $filename) { 1614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $firstline = $instructions[$i]->[2]; 1615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 4: Extend last line forward until its indentation is less than 1620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the indentation we saw on $firstline 1621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $oldlastline = $lastline; 1622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans { 1623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$filename")) { 1624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$filename: $!\n"; 162525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return 0; 1626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = 0; 1628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_indentation = -1; 1629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l++; 1632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $indent = Indentation($_); 1633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $firstline) { 1634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($first_indentation < 0 && $indent >= 0) { 1635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $first_indentation = $indent; 1636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last if ($first_indentation == 0); 1637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $lastline && $indent >= 0) { 1640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($indent >= $first_indentation) { 1641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lastline = $l+1; 1642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 1648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign all samples to the range $firstline,$lastline, 1651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 4: If an instruction does not occur in the range, its samples 1652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # are moved to the next instruction that occurs in the range. 165325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $samples1 = {}; # Map from line number to flat count 165425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $samples2 = {}; # Map from line number to cumulative count 165525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $running1 = 0; # Unassigned flat counts 165625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $running2 = 0; # Unassigned cumulative counts 165725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total1 = 0; # Total flat counts 165825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $total2 = 0; # Total cumulative counts 165925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my %disasm = (); # Map from line number to disassembly 166025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $running_disasm = ""; # Unassigned disassembly 166125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $skip_marker = "---\n"; 166225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 166325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $skip_marker = ""; 166425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans for (my $l = $firstline; $l <= $lastline; $l++) { 166525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $disasm{$l} = ""; 166625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 166725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 166825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $last_dis_filename = ''; 166925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $last_dis_linenum = -1; 167025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $last_touched_line = -1; # To detect gaps in disassembly for a line 1671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@instructions) { 1672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add up counts for all address that fall inside this instruction 1673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c1 = 0; 1674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c2 = 0; 1675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { 1676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c1 += GetEntry($flat, $a); 1677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c2 += GetEntry($cumulative, $a); 1678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 167925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 168025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 168125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $dis = sprintf(" %6s %6s \t\t%8s: %s ", 168225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlPrintNumber($c1), 168325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlPrintNumber($c2), 168425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans UnparseAddress($offset, $e->[0]), 168525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans CleanDisassembly($e->[3])); 168625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 168725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Append the most specific source line associated with this instruction 168825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (length($dis) < 80) { $dis .= (' ' x (80 - length($dis))) }; 168925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $dis = HtmlEscape($dis); 169025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $f = $e->[5]; 169125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $l = $e->[6]; 169225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($f ne $last_dis_filename) { 169325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $dis .= sprintf("<span class=disasmloc>%s:%d</span>", 169425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape(CleanFileName($f)), $l); 169525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif ($l ne $last_dis_linenum) { 169625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # De-emphasize the unchanged file name portion 169725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $dis .= sprintf("<span class=unimportant>%s</span>" . 169825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "<span class=disasmloc>:%d</span>", 169925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape(CleanFileName($f)), $l); 170025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 170125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # De-emphasize the entire location 170225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $dis .= sprintf("<span class=unimportant>%s:%d</span>", 170325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape(CleanFileName($f)), $l); 170425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 170525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $last_dis_filename = $f; 170625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $last_dis_linenum = $l; 170725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $running_disasm .= $dis; 170825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $running_disasm .= "\n"; 170925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 171025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 1711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running1 += $c1; 1712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running2 += $c2; 1713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $total1 += $c1; 1714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $total2 += $c2; 1715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = $e->[1]; 1716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = $e->[2]; 1717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($file eq $filename) && 1718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($line >= $firstline) && 1719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($line <= $lastline)) { 1720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign all accumulated samples to this line 1721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples1, $line, $running1); 1722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples2, $line, $running2); 1723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running1 = 0; 1724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running2 = 0; 172525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 172625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($line != $last_touched_line && $disasm{$line} ne '') { 172725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $disasm{$line} .= "\n"; 172825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 172925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $disasm{$line} .= $running_disasm; 173025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $running_disasm = ''; 173125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $last_touched_line = $line; 173225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 1733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign any leftover samples to $lastline 1737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples1, $lastline, $running1); 1738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples2, $lastline, $running2); 173925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 174025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($lastline != $last_touched_line && $disasm{$lastline} ne '') { 174125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $disasm{$lastline} .= "\n"; 174225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 174325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $disasm{$lastline} .= $running_disasm; 174425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 174525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 174625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 174725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf $output ( 174825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "<h1>%s</h1>%s\n<pre onClick=\"pprof_toggle_asm()\">\n" . 174925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "Total:%6s %6s (flat / cumulative %s)\n", 175025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape(ShortFunctionName($routine)), 175125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape(CleanFileName($filename)), 175225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Unparse($total1), 175325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Unparse($total2), 175425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Units()); 175525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 175625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf $output ( 175725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "ROUTINE ====================== %s in %s\n" . 175825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "%6s %6s Total %s (flat / cumulative)\n", 175925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ShortFunctionName($routine), 176025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans CleanFileName($filename), 176125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Unparse($total1), 176225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Unparse($total2), 176325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Units()); 176425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 1765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$filename")) { 1766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$filename: $!\n"; 176725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return 0; 1768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = 0; 1770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l++; 1773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $firstline - 5 && 1774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (($l <= $oldlastline + 5) || ($l <= $lastline))) { 1775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chop; 1776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = $_; 177725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($l == $firstline) { print $output $skip_marker; } 177825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $n1 = GetEntry($samples1, $l); 177925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $n2 = GetEntry($samples2, $l); 178025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 178125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Emit a span that has one of the following classes: 178225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # livesrc -- has samples 178325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # deadsrc -- has disassembly, but with no samples 178425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # nop -- has no matching disasembly 178525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Also emit an optional span containing disassembly. 178625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $dis = $disasm{$l}; 178725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $asm = ""; 178825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($dis) && $dis ne '') { 178925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $asm = "<span class=\"asm\">" . $dis . "</span>"; 179025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 179125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $source_class = (($n1 + $n2 > 0) 179225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ? "livesrc" 179325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans : (($asm ne "") ? "deadsrc" : "nop")); 179425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf $output ( 179525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "<span class=\"line\">%5d</span> " . 179625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "<span class=\"%s\">%6s %6s %s</span>%s\n", 179725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $l, $source_class, 179825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlPrintNumber($n1), 179925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlPrintNumber($n2), 180025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans HtmlEscape($text), 180125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $asm); 180225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 180325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf $output( 180425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "%6s %6s %4d: %s\n", 180525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans UnparseAlt($n1), 180625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans UnparseAlt($n2), 180725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $l, 180825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $text); 180925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 181025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($l == $lastline) { print $output $skip_marker; } 1811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 1812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 181425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($html) { 181525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print $output "</pre>\n"; 181625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 181725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return 1; 1818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return the source line for the specified file/linenumber. 1821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns undef if not found. 1822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SourceLine { 1823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 1824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = shift; 1825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Look in cache 1827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($main::source_cache{$file})) { 1828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (100 < scalar keys(%main::source_cache)) { 1829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Clear the cache when it gets too big 1830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache = (); 1831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read all lines from the file 1834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$file")) { 1835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$file: $!\n"; 1836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache{$file} = []; # Cache the negative result 1837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 1838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = []; 1840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$lines}, ""); # So we can use 1-based line numbers as indices 1841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$lines}, $_); 1843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 1845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Save the lines in the cache 1847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache{$file} = $lines; 1848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1850a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = $main::source_cache{$file}; 1851a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($line < 0) || ($line > $#{$lines})) { 1852a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 1853a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1854a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $lines->[$line]; 1855a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1857a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print disassembly for one routine with interspersed source if available 1859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDisassembledFunction { 1860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = shift; 1863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 1867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = shift; 1868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassemble all instructions 1870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); 1871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make array of counts per instruction 1873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @flat_count = (); 1874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @cum_count = (); 1875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat_total = 0; 1876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cum_total = 0; 1877a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@instructions) { 1878a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add up counts for all address that fall inside this instruction 1879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c1 = 0; 1880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c2 = 0; 1881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { 1882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c1 += GetEntry($flat, $a); 1883a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c2 += GetEntry($cumulative, $a); 1884a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1885a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@flat_count, $c1); 1886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@cum_count, $c2); 1887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_total += $c1; 1888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_total += $c2; 1889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print header with total counts 1892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("ROUTINE ====================== %s\n" . 1893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "%6s %6s %s (flat, cumulative) %.1f%% of total\n", 1894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ShortFunctionName($routine), 1895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($flat_total), 1896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($cum_total), 1897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Units(), 1898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($cum_total * 100.0) / $total); 1899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process instructions in order 1901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $current_file = ""; 1902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; ) { 1903a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $e = $instructions[$i]; 1904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print the new file name whenever we switch files 1906a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($e->[1] ne $current_file) { 1907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $current_file = $e->[1]; 1908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = $current_file; 1909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fname =~ s|^\./||; # Trim leading "./" 1910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Shorten long file names 1912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($fname) >= 58) { 1913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fname = "..." . substr($fname, -55); 1914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("-------------------- %s\n", $fname); 1916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Compute range of lines to print together to deal with 1919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # small reorderings. 1920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_line = $e->[2]; 1921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_line = $first_line; 1922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %flat_sum = (); 1923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %cum_sum = (); 1924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $l = $first_line; $l <= $last_line; $l++) { 1925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_sum{$l} = 0; 1926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_sum{$l} = 0; 1927a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find run of instructions for this range of source lines 1930a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_inst = $i; 1931a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($i <= $#instructions) && 1932a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($instructions[$i]->[2] >= $first_line) && 1933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($instructions[$i]->[2] <= $last_line)) { 1934a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $e = $instructions[$i]; 1935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_sum{$e->[2]} += $flat_count[$i]; 1936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_sum{$e->[2]} += $cum_count[$i]; 1937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i++; 1938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_inst = $i - 1; 1940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print source lines 1942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $l = $first_line; $l <= $last_line; $l++) { 1943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = SourceLine($current_file, $l); 1944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($line)) { 1945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line = "?\n"; 1946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 1947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/^\s+//; 1949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%6s %6s %5d: %s", 1951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($flat_sum{$l}), 1952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($cum_sum{$l}), 1953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l, 1954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line); 1955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print disassembly 1958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $x = $first_inst; $x <= $last_inst; $x++) { 1959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $e = $instructions[$x]; 1960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%6s %6s %8s: %6s\n", 1961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($flat_count[$x]), 1962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($cum_count[$x]), 196325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans UnparseAddress($offset, $e->[0]), 196425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans CleanDisassembly($e->[3])); 1965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print DOT graph 1970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDot { 1971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $raw = shift; 1974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $overall_total = shift; 1977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get total 1979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $local_total = TotalProfile($flat); 1980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nodelimit = int($main::opt_nodefraction * $local_total); 1981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edgelimit = int($main::opt_edgefraction * $local_total); 1982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nodecount = $main::opt_nodecount; 1983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find nodes to include 1985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @list = (sort { abs(GetEntry($cumulative, $b)) <=> 1986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans abs(GetEntry($cumulative, $a)) 1987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || $a cmp $b } 1988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$cumulative})); 1989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last = $nodecount - 1; 1990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($last > $#list) { 1991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last = $#list; 1992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($last >= 0) && 1994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (abs(GetEntry($cumulative, $list[$last])) <= $nodelimit)) { 1995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last--; 1996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($last < 0) { 1998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "No nodes to print\n"; 1999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 2000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($nodelimit > 0 || $edgelimit > 0) { 2003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", 2004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($nodelimit), Units(), 2005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($edgelimit), Units()); 2006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Open DOT output file 2009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $output; 201025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_dot = ShellEscape(@DOT); 201125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_ps2pdf = ShellEscape(@PS2PDF); 2012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_gv) { 201325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "ps")); 201425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tps2 >$escaped_outfile"; 20159a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($main::opt_evince) { 201625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "pdf")); 201725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - $escaped_outfile"; 2018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_ps) { 201925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tps2"; 2020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_pdf) { 202125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - -"; 2022d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web || $main::opt_svg) { 2023d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # We need to post-process the SVG, so write to a temporary file always. 202425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "svg")); 202525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tsvg >$escaped_outfile"; 2026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_gif) { 202725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $output = "| $escaped_dot -Tgif"; 2028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $output = ">&STDOUT"; 2030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(DOT, $output) || error("$output: $!\n"); 2032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Title 2034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("digraph \"%s; %s %s\" {\n", 2035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $prog, 2036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($overall_total), 2037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Units()); 2038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_pdf) { 2039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The output is more printable if we set the page size for dot. 2040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("size=\"8,11\"\n"); 2041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("node [width=0.375,height=0.25];\n"); 2043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print legend 2045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("Legend [shape=box,fontsize=24,shape=plaintext," . 2046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "label=\"%s\\l%s\\l%s\\l%s\\l%s\\l\"];\n", 2047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $prog, 2048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Total %s: %s", Units(), Unparse($overall_total)), 2049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Focusing on: %s", Unparse($local_total)), 2050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Dropped nodes with <= %s abs(%s)", 2051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($nodelimit), Units()), 2052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Dropped edges with <= %s %s", 2053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($edgelimit), Units()) 2054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ); 2055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print nodes 2057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %node = (); 2058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nextnode = 1; 2059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@list[0..$last]) { 2060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Pick font size 2061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = GetEntry($flat, $a); 2062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = GetEntry($cumulative, $a); 2063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fs = 8; 2065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($local_total > 0) { 2066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fs = 8 + (50.0 * sqrt(abs($f * 1.0 / $local_total))); 2067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$a} = $nextnode++; 2070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $a; 2071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym =~ s/\s+/\\n/g; 2072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym =~ s/::/\\n/g; 2073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Extra cumulative info to print for non-leaves 2075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $extra = ""; 2076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f != $c) { 2077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $extra = sprintf("\\rof %s (%s)", 2078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($c), 207925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Percent($c, $local_total)); 2080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $style = ""; 2082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_heapcheck) { 2083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f > 0) { 2084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # make leak-causing nodes more visible (add a background) 2085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style = ",style=filled,fillcolor=gray" 2086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($f < 0) { 2087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # make anti-leak-causing nodes (which almost never occur) 2088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # stand out as well (triple border) 2089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style = ",peripheries=3" 2090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" . 2094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "\",shape=box,fontsize=%.1f%s];\n", 2095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$a}, 2096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym, 2097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($f), 209825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans Percent($f, $local_total), 2099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $extra, 2100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fs, 2101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style, 2102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ); 2103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get edges and counts per edge 2106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %edge = (); 2107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n; 210825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname_to_shortname_map = {}; 210925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map); 2110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$raw})) { 2111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: omit low %age edges 2112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n = $raw->{$k}; 211325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); 2114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#translated; $i++) { 2115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $src = $translated[$i]; 2116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $dst = $translated[$i-1]; 2117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans #next if ($src eq $dst); # Avoid self-edges? 2118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($node{$src}) && exists($node{$dst})) { 2119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edge_label = "$src\001$dst"; 2120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($edge{$edge_label})) { 2121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edge{$edge_label} = 0; 2122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edge{$edge_label} += $n; 2124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 21289a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Print edges (process in order of decreasing counts) 21299a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my %indegree = (); # Number of incoming edges added per node so far 21309a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my %outdegree = (); # Number of outgoing edges added per node so far 21319a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans foreach my $e (sort { $edge{$b} <=> $edge{$a} } keys(%edge)) { 2132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split(/\001/, $e); 2133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n = $edge{$e}; 2134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 21359a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Initialize degree of kept incoming and outgoing edges if necessary 21369a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $src = $x[0]; 21379a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $dst = $x[1]; 21389a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if (!exists($outdegree{$src})) { $outdegree{$src} = 0; } 21399a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if (!exists($indegree{$dst})) { $indegree{$dst} = 0; } 21409a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 21419a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $keep; 21429a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($indegree{$dst} == 0) { 21439a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Keep edge if needed for reachability 21449a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $keep = 1; 21459a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif (abs($n) <= $edgelimit) { 21469a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Drop if we are below --edgefraction 21479a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $keep = 0; 21489a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($outdegree{$src} >= $main::opt_maxdegree || 21499a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $indegree{$dst} >= $main::opt_maxdegree) { 21509a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Keep limited number of in/out edges per node 21519a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $keep = 0; 21529a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } else { 21539a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $keep = 1; 21549a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } 21559a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 21569a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($keep) { 21579a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $outdegree{$src}++; 21589a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $indegree{$dst}++; 21599a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 2160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Compute line width based on edge count 2161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0); 2162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fraction > 1) { $fraction = 1; } 2163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $w = $fraction * 2; 2164d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($w < 1 && ($main::opt_web || $main::opt_svg)) { 2165d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # SVG output treats line widths < 1 poorly. 2166d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $w = 1; 2167d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Dot sometimes segfaults if given edge weights that are too large, so 2170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we cap the weights at a large value 2171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edgeweight = abs($n) ** 0.7; 2172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($edgeweight > 100000) { $edgeweight = 100000; } 2173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edgeweight = int($edgeweight); 2174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $style = sprintf("setlinewidth(%f)", $w); 2176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($x[1] =~ m/\(inline\)/) { 2177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style .= ",dashed"; 2178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Use a slightly squashed function of the edge count as the weight 2181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("N%s -> N%s [label=%s, weight=%d, style=\"%s\"];\n", 2182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$x[0]}, 2183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$x[1]}, 2184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($n), 2185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edgeweight, 2186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style); 2187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print DOT ("}\n"); 2191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(DOT); 2192d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2193d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_web || $main::opt_svg) { 2194d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Rewrite SVG to be more usable inside web browser. 2195d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RewriteSvg(TempName($main::next_tmpfile, "svg")); 2196d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2197d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 2199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2201d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub RewriteSvg { 2202d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svgfile = shift; 2203d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2204d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(SVG, $svgfile) || die "open temp svg: $!"; 2205d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my @svg = <SVG>; 2206d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(SVG); 2207d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink $svgfile; 2208d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svg = join('', @svg); 2209d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2210d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Dot's SVG output is 2211d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 2212d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <svg width="___" height="___" 2213d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # viewBox="___" xmlns=...> 2214d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="graph0" transform="..."> 2215d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # ... 2216d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 2217d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </svg> 2218d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 2219d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Change it to 2220d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 2221d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <svg width="100%" height="100%" 2222d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # xmlns=...> 2223d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # $svg_javascript 2224d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="viewport" transform="translate(0,0)"> 2225d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="graph0" transform="..."> 2226d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # ... 2227d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 2228d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 2229d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </svg> 2230d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2231d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Fix width, height; drop viewBox. 2232d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/(?s)<svg width="[^"]+" height="[^"]+"(.*?)viewBox="[^"]+"/<svg width="100%" height="100%"$1/; 2233d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2234d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Insert script, viewport <g> above first <g> 2235d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svg_javascript = SvgJavascript(); 2236d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $viewport = "<g id=\"viewport\" transform=\"translate(0,0)\">\n"; 2237d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/<g id="graph\d"/$svg_javascript$viewport$&/; 2238d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2239d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Insert final </g> above </svg>. 2240d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/(.*)(<\/svg>)/$1<\/g>$2/; 2241d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/<g id="graph\d"(.*?)/<g id="viewport"$1/; 2242d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2243d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_svg) { 2244d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # --svg: write to standard output. 2245d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print $svg; 2246d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 2247d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Write back to temporary file. 2248d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(SVG, ">$svgfile") || die "open $svgfile: $!"; 2249d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print SVG $svg; 2250d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(SVG); 2251d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2252d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2253d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2254d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub SvgJavascript { 2255d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return <<'EOF'; 2256d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans<script type="text/ecmascript"><![CDATA[ 2257d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// SVGPan 2258d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// http://www.cyberz.org/blog/2009/12/08/svgpan-a-javascript-svg-panzoomdrag-library/ 2259d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// Local modification: if(true || ...) below to force panning, never moving. 2260d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2261d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2262d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * SVGPan library 1.2 2263d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ==================== 2264d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2265d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Given an unique existing element with id "viewport", including the 2266d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * the library into any SVG adds the following capabilities: 2267d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2268d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Mouse panning 2269d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Mouse zooming (using the wheel) 2270d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Object dargging 2271d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2272d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Known issues: 2273d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2274d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Zooming (while panning) on Safari has still some issues 2275d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2276d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Releases: 2277d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2278d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.2, Sat Mar 20 08:42:50 GMT 2010, Zeng Xiaohui 2279d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Fixed a bug with browser mouse handler interaction 2280d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2281d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.1, Wed Feb 3 17:39:33 GMT 2010, Zeng Xiaohui 2282d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Updated the zoom code to support the mouse wheel on Safari/Chrome 2283d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2284d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.0, Andrea Leofreddi 2285d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * First release 2286d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2287d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * This code is licensed under the following BSD license: 2288d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2289d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Copyright 2009-2010 Andrea Leofreddi <a.leofreddi@itcharm.com>. All rights reserved. 2290d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2291d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Redistribution and use in source and binary forms, with or without modification, are 2292d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * permitted provided that the following conditions are met: 2293d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2294d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1. Redistributions of source code must retain the above copyright notice, this list of 2295d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * conditions and the following disclaimer. 2296d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2297d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2. Redistributions in binary form must reproduce the above copyright notice, this list 2298d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * of conditions and the following disclaimer in the documentation and/or other materials 2299d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * provided with the distribution. 2300d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2301d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * THIS SOFTWARE IS PROVIDED BY Andrea Leofreddi ``AS IS'' AND ANY EXPRESS OR IMPLIED 2302d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 2303d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Andrea Leofreddi OR 2304d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 2305d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 2306d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 2307d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 2308d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 2309d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 2310d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2311d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * The views and conclusions contained in the software and documentation are those of the 2312d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * authors and should not be interpreted as representing official policies, either expressed 2313d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * or implied, of Andrea Leofreddi. 2314d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2315d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2316d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansvar root = document.documentElement; 2317d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2318d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansvar state = 'none', stateTarget, stateOrigin, stateTf; 2319d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2320d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason EvanssetupHandlers(root); 2321d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2322d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2323d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Register handlers 2324d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2325d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setupHandlers(root){ 2326d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setAttributes(root, { 2327d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmouseup" : "add(evt)", 2328d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmousedown" : "handleMouseDown(evt)", 2329d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmousemove" : "handleMouseMove(evt)", 2330d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmouseup" : "handleMouseUp(evt)", 2331d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans //"onmouseout" : "handleMouseUp(evt)", // Decomment this to stop the pan functionality when dragging out of the SVG element 2332d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans }); 2333d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2334d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(navigator.userAgent.toLowerCase().indexOf('webkit') >= 0) 2335d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans window.addEventListener('mousewheel', handleMouseWheel, false); // Chrome/Safari 2336d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans else 2337d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans window.addEventListener('DOMMouseScroll', handleMouseWheel, false); // Others 2338d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2339d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("svg"); 2340d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans g.width = "100%"; 2341d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans g.height = "100%"; 2342d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2343d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2344d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2345d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Instance an SVGPoint object with given event coordinates. 2346d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2347d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction getEventPoint(evt) { 2348d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = root.createSVGPoint(); 2349d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2350d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p.x = evt.clientX; 2351d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p.y = evt.clientY; 2352d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2353d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return p; 2354d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2355d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2356d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2357d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Sets the current transform matrix of an element. 2358d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2359d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setCTM(element, matrix) { 2360d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var s = "matrix(" + matrix.a + "," + matrix.b + "," + matrix.c + "," + matrix.d + "," + matrix.e + "," + matrix.f + ")"; 2361d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2362d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans element.setAttribute("transform", s); 2363d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2364d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2365d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2366d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Dumps a matrix to a string (useful for debug). 2367d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2368d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction dumpMatrix(matrix) { 2369d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var s = "[ " + matrix.a + ", " + matrix.c + ", " + matrix.e + "\n " + matrix.b + ", " + matrix.d + ", " + matrix.f + "\n 0, 0, 1 ]"; 2370d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2371d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return s; 2372d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2373d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2374d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2375d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Sets attributes of an element. 2376d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2377d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setAttributes(element, attributes){ 2378d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for (i in attributes) 2379d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans element.setAttributeNS(null, i, attributes[i]); 2380d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2381d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2382d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2383d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse move event. 2384d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2385d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseWheel(evt) { 2386d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2387d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2388d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2389d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2390d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2391d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2392d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2393d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var delta; 2394d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2395d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.wheelDelta) 2396d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delta = evt.wheelDelta / 3600; // Chrome/Safari 2397d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans else 2398d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delta = evt.detail / -90; // Mozilla 2399d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2400d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var z = 1 + delta; // Zoom factor: 0.9/1.1 2401d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2402d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2403d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2404d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt); 2405d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2406d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p = p.matrixTransform(g.getCTM().inverse()); 2407d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2408d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Compute new scale matrix in current mouse position 2409d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var k = root.createSVGMatrix().translate(p.x, p.y).scale(z).translate(-p.x, -p.y); 2410d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2411d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(g, g.getCTM().multiply(k)); 2412d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2413d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = stateTf.multiply(k.inverse()); 2414d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2415d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2416d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2417d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse move event. 2418d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2419d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseMove(evt) { 2420d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2421d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2422d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2423d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2424d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2425d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2426d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2427d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2428d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2429d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(state == 'pan') { 2430d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Pan mode 2431d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt).matrixTransform(stateTf); 2432d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2433d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(g, stateTf.inverse().translate(p.x - stateOrigin.x, p.y - stateOrigin.y)); 2434d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else if(state == 'move') { 2435d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Move mode 2436d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt).matrixTransform(g.getCTM().inverse()); 2437d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2438d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(stateTarget, root.createSVGMatrix().translate(p.x - stateOrigin.x, p.y - stateOrigin.y).multiply(g.getCTM().inverse()).multiply(stateTarget.getCTM())); 2439d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2440d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = p; 2441d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2442d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2443d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2444d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2445d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle click event. 2446d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2447d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseDown(evt) { 2448d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2449d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2450d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2451d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2452d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2453d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2454d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2455d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2456d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2457d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(true || evt.target.tagName == "svg") { 2458d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Pan mode 2459d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = 'pan'; 2460d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2461d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = g.getCTM().inverse(); 2462d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2463d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = getEventPoint(evt).matrixTransform(stateTf); 2464d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 2465d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Move mode 2466d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = 'move'; 2467d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2468d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTarget = evt.target; 2469d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2470d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = g.getCTM().inverse(); 2471d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2472d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = getEventPoint(evt).matrixTransform(stateTf); 2473d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2474d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2475d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2476d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2477d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse button release event. 2478d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2479d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseUp(evt) { 2480d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2481d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2482d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2483d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2484d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2485d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2486d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2487d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(state == 'pan' || state == 'move') { 2488d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Quit pan mode 2489d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = ''; 2490d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2491d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2492d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2493d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans]]></script> 2494d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason EvansEOF 2495d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2496d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 249725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Provides a map from fullname to shortname for cases where the 249825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# shortname is ambiguous. The symlist has both the fullname and 249925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# shortname for all symbols, which is usually fine, but sometimes -- 250025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# such as overloaded functions -- two different fullnames can map to 250125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# the same shortname. In that case, we use the address of the 250225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# function to disambiguate the two. This function fills in a map that 250325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# maps fullnames to modified shortnames in such cases. If a fullname 250425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# is not present in the map, the 'normal' shortname provided by the 250525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# symlist is the appropriate one to use. 250625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub FillFullnameToShortnameMap { 250725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $symbols = shift; 250825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname_to_shortname_map = shift; 250925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $shortnames_seen_once = {}; 251025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $shortnames_seen_more_than_once = {}; 251125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 251225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans foreach my $symlist (values(%{$symbols})) { 251325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # TODO(csilvers): deal with inlined symbols too. 251425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $shortname = $symlist->[0]; 251525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname = $symlist->[2]; 251625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($fullname !~ /<[0-9a-fA-F]+>$/) { # fullname doesn't end in an address 251725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans next; # the only collisions we care about are when addresses differ 251825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 251925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($shortnames_seen_once->{$shortname}) && 252025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $shortnames_seen_once->{$shortname} ne $fullname) { 252125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $shortnames_seen_more_than_once->{$shortname} = 1; 252225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 252325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $shortnames_seen_once->{$shortname} = $fullname; 252425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 252525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 252625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 252725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans foreach my $symlist (values(%{$symbols})) { 252825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $shortname = $symlist->[0]; 252925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname = $symlist->[2]; 253025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # TODO(csilvers): take in a list of addresses we care about, and only 253125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # store in the map if $symlist->[1] is in that list. Saves space. 253225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans next if defined($fullname_to_shortname_map->{$fullname}); 253325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($shortnames_seen_more_than_once->{$shortname})) { 253425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($fullname =~ /<0*([^>]*)>$/) { # fullname has address at end of it 253525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $fullname_to_shortname_map->{$fullname} = "$shortname\@$1"; 253625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 253725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 253825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 253925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 254025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 25419a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# Return a small number that identifies the argument. 25429a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# Multiple calls with the same argument will return the same number. 25439a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# Calls with different arguments will return different numbers. 25449a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evanssub ShortIdFor { 25459a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $key = shift; 25469a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $id = $main::uniqueid{$key}; 25479a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if (!defined($id)) { 25489a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $id = keys(%main::uniqueid) + 1; 25499a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::uniqueid{$key} = $id; 25509a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } 25519a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans return $id; 25529a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans} 25539a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 2554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Translate a stack of addresses into a stack of symbols 2555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TranslateStack { 2556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 255725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname_to_shortname_map = shift; 2558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 2559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @result = (); 2562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#addrs; $i++) { 2563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a = $addrs[$i]; 2564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Skip large addresses since they sometimes show up as fake entries on RH9 2566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($a) > 8 && $a gt "7fffffffffffffff") { 2567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm || $main::opt_list) { 2571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We want just the address for the key 2572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $a); 2573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symlist = $symbols->{$a}; 2577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($symlist)) { 2578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symlist = [$a, "", $a]; 2579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We can have a sequence of symbols for a particular entry 2582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (more than one symbol in the case of inlining). Callers 2583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # come before callees in symlist, so walk backwards since 2584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the translated stack should contain callees before callers. 2585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { 2586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = $symlist->[$j-2]; 2587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fileline = $symlist->[$j-1]; 2588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullfunc = $symlist->[$j]; 258925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($fullname_to_shortname_map->{$fullfunc})) { 259025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $func = $fullname_to_shortname_map->{$fullfunc}; 259125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 2592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($j > 2) { 2593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $func = "$func (inline)"; 2594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 25959a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 25969a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Do not merge nodes corresponding to Callback::Run since that 25979a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # causes confusing cycles in dot display. Instead, we synthesize 25989a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # a unique name for this frame per caller. 25999a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($func =~ m/Callback.*::Run$/) { 26009a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $caller = ($i > 0) ? $addrs[$i-1] : 0; 26019a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $func = "Run#" . ShortIdFor($caller); 26029a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } 26039a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 2604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_addresses) { 2605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a $func $fileline"); 2606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_lines) { 2607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($func eq '??' && $fileline eq '??:0') { 2608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$func $fileline"); 2611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_functions) { 2613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($func eq '??') { 2614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $func); 2617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_files) { 2619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fileline eq '??:0' || $fileline eq '') { 2620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = $fileline; 2623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $f =~ s/:\d+$//; 2624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $f); 2625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $a); 2628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # Do not print inlined info 2629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print join(",", @addrs), " => ", join(",", @result), "\n"; 2634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return @result; 2635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate percent string for a number and a total 2638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Percent { 2639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tot = shift; 2641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($tot != 0) { 2642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.1f%%", $num * 100.0 / $tot); 2643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf"); 2645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate pretty-printed form of number 2649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Unparse { 2650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_objects || $main::opt_alloc_objects) { 2653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_show_bytes) { 2656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.1f", $num / 1048576.0); 2659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) { 2662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds 2663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Alternate pretty-printed form: 0 maps to "." 2669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub UnparseAlt { 2670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($num == 0) { 2672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "."; 2673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return Unparse($num); 2675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 267825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Alternate pretty-printed form: 0 maps to "" 267925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub HtmlPrintNumber { 268025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $num = shift; 268125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($num == 0) { 268225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return ""; 268325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 268425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return Unparse($num); 268525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 268625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 268725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 2688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return output units 2689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Units { 2690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_objects || $main::opt_alloc_objects) { 2692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "objects"; 2693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_show_bytes) { 2695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "B"; 2696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "MB"; 2698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) { 2701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "seconds"; 2702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "samples"; 2704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Profile manipulation code ##### 2708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate flattened profile: 2710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If count is charged to stack [a,b,c,d], in generated profile, 2711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will be charged to [a] 2712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FlatProfile { 2713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 2719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $addrs[0], $count); 2720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate cumulative profile: 2726a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If count is charged to stack [a,b,c,d], in generated profile, 2727a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will be charged to [a], [b], [c], [d] 2728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CumulativeProfile { 2729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2730a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $a, $count); 2736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2739a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If the second-youngest PC on the stack is always the same, returns 2742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# that pc. Otherwise, returns undef. 2743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IsSecondPcAlwaysTheSame { 2744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $second_pc = undef; 2747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs < 1) { 2750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 2751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2752a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (not defined $second_pc) { 2753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $second_pc = $addrs[1]; 2754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($second_pc ne $addrs[1]) { 2756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 2757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $second_pc; 2761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractSymbolLocation { 2764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $address = shift; 2766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 'addr2line' outputs "??:0" for unknown locations; we do the 2767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # same to be consistent. 2768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $location = "??:0:unknown"; 2769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $symbols->{$address}) { 2770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = $symbols->{$address}->[1]; 2771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file eq "?") { 2772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file = "??:0" 2773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $location = $file . ":" . $symbols->{$address}->[0]; 2775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $location; 2777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Extracts a graph of calls. 2780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractCalls { 2781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = {}; 2785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while( my ($stack_trace, $count) = each %$profile ) { 2786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @address = split(/\n/, $stack_trace); 2787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $destination = ExtractSymbolLocation($symbols, $address[0]); 2788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($calls, $destination, $count); 2789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#address; $i++) { 2790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $source = ExtractSymbolLocation($symbols, $address[$i]); 2791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $call = "$source -> $destination"; 2792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($calls, $call, $count); 2793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $destination = $source; 2794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $calls; 2798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RemoveUninterestingFrames { 2801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # List of function names to skip 2805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %skip = (); 2806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $skip_regexp = 'NOMATCH'; 2807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $name ('calloc', 2809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'cfree', 2810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'malloc', 2811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'free', 2812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'memalign', 2813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'posix_memalign', 281473b37a9697acd53496bbef06ed25696e0c897341Jason Evans 'aligned_alloc', 2815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'pvalloc', 2816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'valloc', 2817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'realloc', 281873b37a9697acd53496bbef06ed25696e0c897341Jason Evans 'mallocx', # jemalloc 281973b37a9697acd53496bbef06ed25696e0c897341Jason Evans 'rallocx', # jemalloc 282073b37a9697acd53496bbef06ed25696e0c897341Jason Evans 'xallocx', # jemalloc 282173b37a9697acd53496bbef06ed25696e0c897341Jason Evans 'dallocx', # jemalloc 2822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_calloc', 2823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_cfree', 2824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_malloc', 2825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_free', 2826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_memalign', 2827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_posix_memalign', 2828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_pvalloc', 2829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_valloc', 2830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_realloc', 2831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_new', 2832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_delete', 2833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_newarray', 2834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_deletearray', 2835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_new_nothrow', 2836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_newarray_nothrow', 2837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'do_malloc', 2838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '::do_malloc', # new name -- got moved to an unnamed ns 2839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '::do_malloc_or_cpp_alloc', 2840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'DoSampledAllocation', 2841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'simple_alloc::allocate', 2842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__malloc_alloc_template::allocate', 2843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_delete', 2844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_new', 2845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_vec_delete', 2846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_vec_new', 2847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'operator new', 2848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'operator new[]', 284925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # The entry to our memory-allocation routines on OS X 285025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_malloc', 285125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_calloc', 285225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_valloc', 285325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_realloc', 285425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_memalign', 285525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 'malloc_zone_free', 2856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # These mark the beginning/end of our custom sections 2857a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__start_google_malloc', 2858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__stop_google_malloc', 2859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__start_malloc_hook', 2860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__stop_malloc_hook') { 2861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$name} = 1; 2862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything 2863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Remove TCMalloc once everything has been 2865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # moved into the tcmalloc:: namespace and we have flushed 2866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # old code out of the system. 2867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip_regexp = "TCMalloc|^tcmalloc::"; 2868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention') { 28699a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans foreach my $vname ('base::RecordLockProfileData', 28709a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'base::SubmitMutexProfileData', 28719a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'base::SubmitSpinLockProfileData', 28729a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'Mutex::Unlock', 28739a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'Mutex::UnlockSlow', 28749a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'Mutex::ReaderUnlock', 28759a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'MutexLock::~MutexLock', 28769a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'SpinLock::Unlock', 28779a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'SpinLock::SlowUnlock', 28789a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 'SpinLockHolder::~SpinLockHolder') { 2879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$vname} = 1; 2880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'cpu') { 2882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Drop signal handlers used for CPU profile collection 2883a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(dpeng): this should not be necessary; it's taken 2884a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # care of by the general 2nd-pc mechanism below. 2885a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $name ('ProfileData::Add', # historical 2886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'ProfileData::prof_handler', # historical 2887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'CpuProfiler::prof_handler', 2888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__FRAME_END__', 2889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__pthread_sighandler', 2890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__restore') { 2891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$name} = 1; 2892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Nothing skipped for unknown types 2895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'cpu') { 2898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If all the second-youngest program counters are the same, 2899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # this STRONGLY suggests that it is an artifact of measurement, 2900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # i.e., stack frames pushed by the CPU profiler signal handler. 2901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hence, we delete them. 2902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (The topmost PC is read from the signal structure, not from 2903a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the stack, so it does not get involved.) 2904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (my $second_pc = IsSecondPcAlwaysTheSame($profile)) { 2905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2906a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = ''; 2907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$second_pc})) { 2908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $second_pc = $symbols->{$second_pc}->[0]; 2909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Removing $second_pc from all stack traces.\n"; 2911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans splice @addrs, 1, 1; 2915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @addrs); 2916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = $result; 2919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @path = (); 2927a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$a})) { 2929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = $symbols->{$a}->[0]; 2930a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($skip{$func} || ($func =~ m/$skip_regexp/)) { 293173b37a9697acd53496bbef06ed25696e0c897341Jason Evans # Throw away the portion of the backtrace seen so far, under the 293273b37a9697acd53496bbef06ed25696e0c897341Jason Evans # assumption that previous frames were for functions internal to the 293373b37a9697acd53496bbef06ed25696e0c897341Jason Evans # allocator. 293473b37a9697acd53496bbef06ed25696e0c897341Jason Evans @path = (); 2935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@path, $a); 2939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @path); 2941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Reduce profile to granularity given by user 2947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReduceProfile { 2948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 295125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $fullname_to_shortname_map = {}; 295225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map); 2953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 295525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k); 2956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @path = (); 2957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %seen = (); 2958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen{''} = 1; # So that empty keys are skipped 2959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@translated) { 2960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # To avoid double-counting due to recursion, skip a stack-trace 2961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # entry if it has already been seen 2962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$seen{$e}) { 2963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen{$e} = 1; 2964a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@path, $e); 2965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @path); 2968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Does the specified symbol array match the regexp? 2974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SymbolMatches { 2975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = shift; 2976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $re = shift; 2977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sym)) { 2978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $#{$sym}; $i += 3) { 2979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) { 2980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 2981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 2985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Focus only on paths involving specified regexps 2988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FocusProfile { 2989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = shift; 2992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reply if it matches either the address/shortname/fileline 2998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) { 2999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $k, $count); 3000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Focus only on paths not involving specified regexps 3008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IgnoreProfile { 3009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 3010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 3011a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = shift; 3012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 3013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 3014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 3015a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 3016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $matched = 0; 3017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 3018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reply if it matches either the address/shortname/fileline 3019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) { 3020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $matched = 1; 3021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$matched) { 3025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $k, $count); 3026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Get total count in profile 3032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TotalProfile { 3033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 3034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = 0; 3035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 3036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result += $profile->{$k}; 3037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add A to B 3042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddProfile { 3043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 3044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 3045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 3047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in A 3048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 3049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $A->{$k}; 3050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 3051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in B 3053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 3054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $B->{$k}; 3055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 3056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 3058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Merges symbol maps 3061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MergeSymbols { 3062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 3063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 3064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 3066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 3067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = $A->{$k}; 3068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($B)) { 3070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 3071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = $B->{$k}; 3072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 3075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add A to B 3079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddPcs { 3080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 3081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 3082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 3084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in A 3085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 3086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = 1 3087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in B 3089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 3090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = 1 3091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 3093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract B from A 3096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SubtractProfile { 3097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 3098a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 3099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 3101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 3102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $A->{$k} - GetEntry($B, $k); 3103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($v < 0 && $main::opt_drop_negative) { 3104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $v = 0; 3105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 3107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$main::opt_drop_negative) { 3109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Take care of when subtracted profile has more entries 3110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 3111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($A->{$k})) { 3112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, 0 - $B->{$k}); 3113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 3117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Get entry from profile; zero if not present 3120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetEntry { 3121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 3122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 3123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($profile->{$k})) { 3124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile->{$k}; 3125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 3127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add entry to specified profile 3131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddEntry { 3132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 3133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 3134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n = shift; 3135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($profile->{$k})) { 3136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile->{$k} = 0; 3137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile->{$k} += $n; 3139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add a stack of entries to specified profile, and add them to the $pcs 3142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# list. 3143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddEntries { 3144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 3145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = shift; 3146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = shift; 3147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = shift; 3148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @k = (); 3149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (split(/\s+/, $stack)) { 3151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pc = HexExtend($e); 3152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pc} = 1; 3153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push @k, $pc; 3154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($profile, (join "\n", @k), $count); 3156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Code to profile a server dynamically ##### 3159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CheckSymbolPage { 3161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = SymbolPageURL(); 316225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $command = ShellEscape(@URL_FETCHER, $url); 316325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(SYMBOL, "$command |") or error($command); 3164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = <SYMBOL>; 3165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOL); 3167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unless (defined($line)) { 3168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$url doesn't exist\n"); 3169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /^num_symbols:\s+(\d+)$/) { 3172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($1 == 0) { 3173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Stripped binary. No symbols available.\n"); 3174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Failed to get the number of symbols from $url\n"); 3177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IsProfileURL { 3181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 3182d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (-f $profile_name) { 3183d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans printf STDERR "Using local file $profile_name.\n"; 3184d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 3185d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3186d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 1; 3187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseProfileURL { 3190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 3191d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3192d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!defined($profile_name) || $profile_name eq "") { 3193d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return (); 3194d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3195d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3196d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Split profile URL - matches all non-empty strings, so no test. 3197d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,; 3198d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3199d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $proto = $1 || "http://"; 3200d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $hostport = $2; 3201d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $prefix = $3; 3202d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $profile = $4 || "/"; 3203d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3204d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $host = $hostport; 3205d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $host =~ s/:.*//; 3206d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3207d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $baseurl = "$proto$hostport$prefix"; 3208d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return ($host, $baseurl, $profile); 3209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# We fetch symbols from the first profile argument. 3212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SymbolPageURL { 3213d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 3214d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return "$baseURL$SYMBOL_PAGE"; 3215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchProgramName() { 3218d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 3219d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $url = "$baseURL$PROGRAM_NAME_PAGE"; 322025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $command_line = ShellEscape(@URL_FETCHER, $url); 3221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(CMDLINE, "$command_line |") or error($command_line); 3222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmdline = <CMDLINE>; 3223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(CMDLINE); 3225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Failed to get program name from $url\n") unless defined($cmdline); 3226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. 3227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s!\n!!g; # Remove LFs. 3228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $cmdline; 3229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Gee, curl's -L (--location) option isn't reliable at least 3232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# with its 7.12.3 version. Curl will forget to post data if 3233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# there is a redirection. This function is a workaround for 3234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# curl. Redirection happens on borg hosts. 3235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ResolveRedirectionForCurl { 3236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = shift; 323725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $command_line = ShellEscape(@URL_FETCHER, "--head", $url); 3238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(CMDLINE, "$command_line |") or error($command_line); 3239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<CMDLINE>) { 3240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^Location: (.*)/) { 3242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $url = $1; 3243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(CMDLINE); 3246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $url; 3247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 324925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Add a timeout flat to URL_FETCHER. Returns a new list. 3250d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub AddFetchTimeout { 3251d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $timeout = shift; 325225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @fetcher = shift; 3253d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (defined($timeout)) { 325425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (join(" ", @fetcher) =~ m/\bcurl -s/) { 325525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@fetcher, "--max-time", sprintf("%d", $timeout)); 325625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif (join(" ", @fetcher) =~ m/\brpcget\b/) { 325725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@fetcher, sprintf("--deadline=%d", $timeout)); 3258d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3259d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 326025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return @fetcher; 3261d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 3262d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Reads a symbol map from the file handle name given as $1, returning 3264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# the resulting symbol map. Also processes variables relating to symbols. 3265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Currently, the only variable processed is 'binary=<value>' which updates 3266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $main::prog to have the correct program name. 3267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadSymbols { 3268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $in = shift; 3269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = {}; 3270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<$in>) { 3271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Removes all the leading zeroes from the symbols, see comment below. 3273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^0x0*([0-9a-f]+)\s+(.+)/) { 3274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map->{$1} = $2; 3275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^---/) { 3276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^([a-z][^=]*)=(.*)$/ ) { 3278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($variable, $value) = ($1, $2); 3279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for ($variable, $value) { 3280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s+//; 3281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s+$//; 3282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($variable eq "binary") { 3284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::prog ne $UNKNOWN_BINARY && $main::prog ne $value) { 3285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Warning: Mismatched binary name '%s', using '%s'.\n", 3286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog, $value); 3287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = $value; 3289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Ignoring unknown variable in symbols list: " . 3291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "'%s' = '%s'\n", $variable, $value); 3292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $map; 3296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Fetches and processes symbols to prepare them for use in the profile output 3299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# code. If the optional 'symbol_map' arg is not given, fetches symbols from 3300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $SYMBOL_PAGE for all PC values found in profile. Otherwise, the raw symbols 3301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# are assumed to have already been fetched into 'symbol_map' and are simply 3302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# extracted and processed. 3303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchSymbols { 3304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcset = shift; 3305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_map = shift; 3306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %seen = (); 3308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pcs = grep { !$seen{$_}++ } keys(%$pcset); # uniq 3309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($symbol_map)) { 3311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); 3312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(POSTFILE, ">$main::tmpfile_sym"); 3314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print POSTFILE $post_data; 3315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(POSTFILE); 3316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = SymbolPageURL(); 3318d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3319d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $command_line; 332025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (join(" ", @URL_FETCHER) =~ m/\bcurl -s/) { 3321d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url = ResolveRedirectionForCurl($url); 332225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $command_line = ShellEscape(@URL_FETCHER, "-d", "\@$main::tmpfile_sym", 332325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $url); 3324d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 332525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $command_line = (ShellEscape(@URL_FETCHER, "--post", $url) 332625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans . " < " . ShellEscape($main::tmpfile_sym)); 3327d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols. 332925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_cppfilt = ShellEscape($obj_tool_map{"c++filt"}); 333025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(SYMBOL, "$command_line | $escaped_cppfilt |") or error($command_line); 3331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = ReadSymbols(*SYMBOL{IO}); 3332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOL); 3333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = {}; 3336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@pcs) { 3337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullname; 3338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For 64 bits binaries, symbols are extracted with 8 leading zeroes. 3339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Then /symbol reads the long symbols in as uint64, and outputs 3340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the result with a "0x%08llx" format which get rid of the zeroes. 3341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # By removing all the leading zeroes in both $pc and the symbols from 3342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # /symbol, the symbols match and are retrievable from the map. 3343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $shortpc = $pc; 3344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $shortpc =~ s/^0*//; 3345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Each line may have a list of names, which includes the function 334625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # and also other functions it has inlined. They are separated (in 334725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # PrintSymbolizedProfile), by --, which is illegal in function names. 3348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullnames; 3349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbol_map->{$shortpc})) { 3350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullnames = $symbol_map->{$shortpc}; 3351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullnames = "0x" . $pc; # Just use addresses 3353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = []; 3355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = $sym; 3356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $fullname (split("--", $fullnames)) { 3357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $name = ShortFunctionName($fullname); 3358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$sym}, $name, "?", $fullname); 3359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbols; 3362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub BaseName { 3365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_name = shift; 3366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_name =~ s!^.*/!!; # Remove directory name 3367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $file_name; 3368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MakeProfileBaseName { 3371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($binary_name, $profile_name) = @_; 3372d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($profile_name); 3373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $binary_shortname = BaseName($binary_name); 3374d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return sprintf("%s.%s.%s", 3375d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $binary_shortname, $main::op_time, $host); 3376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfile { 3379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $binary_name = shift; 3380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 3381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fetch_name_only = shift; 3382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $encourage_patience = shift; 3383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!IsProfileURL($profile_name)) { 3385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile_name; 3386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3387d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($profile_name); 3388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($path eq "" || $path eq "/") { 3389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Missing type specifier defaults to cpu-profile 3390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = $PROFILE_PAGE; 3391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_file = MakeProfileBaseName($binary_name, $profile_name); 3394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3395d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $url = "$baseURL$path"; 3396d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fetch_timeout = undef; 3397d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) { 3398d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($path =~ m/[?]/) { 3399d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= "&"; 3400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3401d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= "?"; 3402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3403d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= sprintf("seconds=%d", $main::opt_seconds); 3404d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $fetch_timeout = $main::opt_seconds * 1.01 + 60; 3405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For non-CPU profiles, we add a type-extension to 3407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the target profile file name. 3408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $suffix = $path; 3409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $suffix =~ s,/,.,g; 3410d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $profile_file .= $suffix; 3411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof"); 3414d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (! -d $profile_dir) { 3415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans mkdir($profile_dir) 3416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || die("Unable to create profile directory $profile_dir: $!\n"); 3417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tmp_profile = "$profile_dir/.tmp.$profile_file"; 3419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $real_profile = "$profile_dir/$profile_file"; 3420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fetch_name_only > 0) { 3422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $real_profile; 3423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 342525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @fetcher = AddFetchTimeout($fetch_timeout, @URL_FETCHER); 342625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $cmd = ShellEscape(@fetcher, $url) . " > " . ShellEscape($tmp_profile); 34279a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){ 3428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n ${real_profile}\n"; 3429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($encourage_patience) { 3430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Be patient...\n"; 3431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3433d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; 3434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); 343725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans (system("mv", $tmp_profile, $real_profile) == 0) || error("Unable to rename profile\n"); 3438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Wrote profile to $real_profile\n"; 3439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = $real_profile; 3440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $main::collected_profile; 3441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Collect profiles in parallel 3445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfiles { 3446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $items = scalar(@main::pfile_args); 3447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $levels = log($items) / log(2); 3448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($items == 1) { 3450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_files[0] = FetchDynamicProfile($main::prog, $main::pfile_args[0], 0, 1); 3451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # math rounding issues 3453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ((2 ** $levels) < $items) { 3454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $levels++; 3455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = scalar(@main::pfile_args); 3457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $count; $i++) { 3458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_files[$i] = FetchDynamicProfile($main::prog, $main::pfile_args[$i], 1, 0); 3459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Fetching $count profiles, Be patient...\n"; 3461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfilesRecurse($levels, 0, 0); 3462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = join(" \\\n ", @main::profile_files); 3463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Recursively fork a process to get enough processes 3467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# collecting profiles 3468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfilesRecurse { 3469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maxlevel = shift; 3470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $level = shift; 3471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $position = shift; 3472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (my $pid = fork()) { 3474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $position = 0 | ($position << 1); 3475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans TryCollectProfile($maxlevel, $level, $position); 3476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans wait; 3477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $position = 1 | ($position << 1); 3479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans TryCollectProfile($maxlevel, $level, $position); 3480d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans cleanup(); 3481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 3482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Collect a single profile 3486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TryCollectProfile { 3487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maxlevel = shift; 3488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $level = shift; 3489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $position = shift; 3490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($level >= ($maxlevel - 1)) { 3492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($position < scalar(@main::pfile_args)) { 3493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfile($main::prog, $main::pfile_args[$position], 0, 0); 3494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfilesRecurse($maxlevel, $level+1, $position); 3497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Parsing code ##### 3501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Provide a small streaming-read module to handle very large 3503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# cpu-profile files. Stream in chunks along a sliding window. 3504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Provides an interface to get one 'slot', correctly handling 3505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# endian-ness differences. A slot is one 32-bit or 64-bit word 3506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# (depending on the input profile). We tell endianness and bit-size 3507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# for the profile by looking at the first 8 bytes: in cpu profiles, 3508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# the second slot is always 3 (we'll accept anything that's not 0). 3509a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansBEGIN { 3510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans package CpuProfileStream; 3511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub new { 3513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($class, $file, $fname) = @_; 3514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $self = { file => $file, 3515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans base => 0, 3516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans stride => 512 * 1024, # must be a multiple of bitsize/8 3517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans slots => [], 3518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unpack_code => "", # N for big-endian, V for little 3519d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans perl_is_64bit => 1, # matters if profile is 64-bit 3520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 3521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans bless $self, $class; 3522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Let unittests adjust the stride 3523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_test_stride > 0) { 3524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{stride} = $main::opt_test_stride; 3525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read the first two slots to figure out bitsize and endianness. 3527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $str; 3529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, 8); 3530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Set the global $address_length based on what we see here. 3531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars). 3532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = ($str eq (chr(0)x8)) ? 16 : 8; 3533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 3534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (substr($str, 6, 2) eq chr(0)x2) { 3535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'V'; # Little-endian. 3536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (substr($str, 4, 2) eq chr(0)x2) { 3537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'N'; # Big-endian 3538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ::error("$fname: header size >= 2**16\n"); 3540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = unpack($self->{unpack_code} . "*", $str); 3542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3543d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # If we're a 64-bit profile, check if we're a 64-bit-capable 3544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # perl. Otherwise, each slot will be represented as a float 3545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # instead of an int64, losing precision and making all the 3546d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 64-bit addresses wrong. We won't complain yet, but will 3547d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # later if we ever see a value that doesn't fit in 32 bits. 3548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $has_q = 0; 3549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans eval { $has_q = pack("Q", "1") ? 1 : 1; }; 3550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$has_q) { 355125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $self->{perl_is_64bit} = 0; 3552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, 8); 3554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (substr($str, 4, 4) eq chr(0)x4) { 3555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. 3556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'V'; # Little-endian. 3557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (substr($str, 0, 4) eq chr(0)x4) { 3558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'N'; # Big-endian 3559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ::error("$fname: header size >= 2**32\n"); 3561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pair = unpack($self->{unpack_code} . "*", $str); 3563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Since we know one of the pair is 0, it's fine to just add them. 3564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = (0, $pair[0] + $pair[1]); 3565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $self; 3567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Load more data when we access slots->get(X) which is not yet in memory. 3570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub overflow { 3571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($self) = @_; 3572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{base} += $#$slots + 1; # skip over data we're replacing 3574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $str; 3575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, $self->{stride}); 3576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { # the 32-bit case 3577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is the easy case: unpack provides 32-bit unpacking primitives. 3578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = unpack($self->{unpack_code} . "*", $str); 3579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We need to unpack 32 bits at a time and combine. 3581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @b32_values = unpack($self->{unpack_code} . "*", $str); 3582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @b64_values = (); 3583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $#b32_values; $i += 2) { 3584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(csilvers): if this is a 32-bit perl, the math below 3585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # could end up in a too-large int, which perl will promote 3586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to a double, losing necessary precision. Deal with that. 358725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Right now, we just die. 358825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); 3589d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($self->{unpack_code} eq 'N') { # big-endian 359025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ($lo, $hi) = ($hi, $lo); 359125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 359225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $value = $lo + $hi * (2**32); 359325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (!$self->{perl_is_64bit} && # check value is exactly represented 359425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { 359525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ::error("Need a 64-bit perl to process this 64-bit profile.\n"); 359625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 359725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@b64_values, $value); 3598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = @b64_values; 3600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Access the i-th long in the file (logically), or -1 at EOF. 3604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub get { 3605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($self, $idx) = @_; 3606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($#$slots >= 0) { 3608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($idx < $self->{base}) { 3609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The only time we expect a reference to $slots[$i - something] 3610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # after referencing $slots[$i] is reading the very first header. 3611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Since $stride > |header|, that shouldn't cause any lookback 3612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # errors. And everything after the header is sequential. 3613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Unexpected look-back reading CPU profile"; 3614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; # shrug, don't know what better to return 3615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($idx > $self->{base} + $#$slots) { 3616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->overflow(); 3617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $slots->[$idx - $self->{base}]; 3619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If we get here, $slots is [], which means we've reached EOF 3622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; # unique since slots is supposed to hold unsigned numbers 3623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 36269a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# Reads the top, 'header' section of a profile, and returns the last 36279a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# line of the header, commonly called a 'header line'. The header 36289a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# section of a profile consists of zero or more 'command' lines that 36299a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# are instructions to pprof, which pprof executes when reading the 36309a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# header. All 'command' lines start with a %. After the command 36319a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# lines is the 'header line', which is a profile-specific line that 36329a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# indicates what type of profile it is, and perhaps other global 36339a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# information about the profile. For instance, here's a header line 36349a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# for a heap profile: 36359a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# heap profile: 53: 38236 [ 5525: 1284029] @ heapprofile 36369a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# For historical reasons, the CPU profile does not contain a text- 36379a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# readable header line. If the profile looks like a CPU profile, 36389a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# this function returns "". If no header line could be found, this 36399a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# function returns undef. 36409a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# 36419a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# The following commands are recognized: 36429a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# %warn -- emit the rest of this line to stderr, prefixed by 'WARNING:' 36439a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# 36449a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans# The input file should be in binmode. 36459a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evanssub ReadProfileHeader { 3646d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans local *PROFILE = shift; 3647d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $firstchar = ""; 3648d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $line = ""; 3649d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans read(PROFILE, $firstchar, 1); 36509a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans seek(PROFILE, -1, 1); # unread the firstchar 36519a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($firstchar !~ /[[:print:]]/) { # is not a text character 3652d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return ""; 3653d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 36549a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans while (defined($line = <PROFILE>)) { 3655d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 36569a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if ($line =~ /^%warn\s+(.*)/) { # 'warn' command 36579a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Note this matches both '%warn blah\n' and '%warn\n'. 36589a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans print STDERR "WARNING: $1\n"; # print the rest of the line 36599a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } elsif ($line =~ /^%/) { 36609a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans print STDERR "Ignoring unknown command from profile header: $line"; 36619a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } else { 36629a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # End of commands, must be the header line. 36639a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans return $line; 36649a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } 3665d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 36669a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans return undef; # got to EOF without seeing a header line 3667d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 3668d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3669d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub IsSymbolizedProfileFile { 3670d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $file_name = shift; 3671d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!(-e $file_name) || !(-r $file_name)) { 3672d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 3673d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3674d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Check if the file contains a symbol-section marker. 3675d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(TFILE, "<$file_name"); 3676d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans binmode TFILE; 36779a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $firstline = ReadProfileHeader(*TFILE); 3678d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(TFILE); 3679d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!$firstline) { 3680d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 3681d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3682d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3683d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $symbol_marker = $&; 3684d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $firstline =~ /^--- *$symbol_marker/; 3685d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 3686d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse profile generated by common/profiler.cc and return a reference 3688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# to a map: 3689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{version} Version number of profile file 3690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{period} Sampling period (in microseconds) 3691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{profile} Profile object 3692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{map} Memory map info from profile 3693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{pcs} Hash of all PC values seen, key is hex address 3694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadProfile { 3695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 3696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 36979a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $result; # return value 3698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $CONTENTION_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $contention_marker = $&; 3701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $GROWTH_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $growth_marker = $&; 3703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_marker = $&; 3705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_marker = $&; 3707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Look at first line to see if it is a heap or a CPU profile. 3709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # CPU profile may start with no header at all, and just binary data 3710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (starting with \0\0\0\0) -- in that case, don't try to read the 3711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # whole firstline, since it may be gigabytes(!) of data. 3712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(PROFILE, "<$fname") || error("$fname: $!\n"); 3713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans binmode PROFILE; # New perls do UTF-8 processing 37149a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $header = ReadProfileHeader(*PROFILE); 3715d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!defined($header)) { # means "at EOF" 3716d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans error("Profile is empty.\n"); 3717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols; 3720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m/^--- *$symbol_marker/o) { 37219a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Verify that the user asked for a symbolized profile 37229a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans if (!$main::use_symbolized_profile) { 37239a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # we have both a binary and symbolized profiles, abort 37249a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " . 372525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans "a binary arg. Try again without passing\n $prog\n"); 37269a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans } 3727d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Read the symbol section of the symbolized profile file. 3728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = ReadSymbols(*PROFILE{IO}); 3729d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Read the next line to get the header for the remaining profile. 37309a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $header = ReadProfileHeader(*PROFILE) || ""; 3731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 37339a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $main::profile_type = ''; 3734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m/^heap profile:.*$growth_marker/o) { 3735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'growth'; 37369a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadHeapProfile($prog, *PROFILE, $header); 3737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^heap profile:/) { 3738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'heap'; 37399a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadHeapProfile($prog, *PROFILE, $header); 3740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *$contention_marker/o) { 3741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'contention'; 37429a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadSynchProfile($prog, *PROFILE); 3743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *Stacks:/) { 3744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR 3745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "Old format contention profile: mistakenly reports " . 3746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "condition variable signals as lock contentions.\n"; 3747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'contention'; 37489a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadSynchProfile($prog, *PROFILE); 3749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *$profile_marker/) { 3750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the binary cpu profile data starts immediately after this line 3751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'cpu'; 37529a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadCPUProfile($prog, $fname, *PROFILE); 3753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbols)) { 3755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # a symbolized profile contains a format we don't recognize, bail out 3756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: Cannot recognize profile section after symbols.\n"); 3757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # no ascii header present -- must be a CPU profile 3759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'cpu'; 37609a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans $result = ReadCPUProfile($prog, $fname, *PROFILE); 3761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 37639a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans close(PROFILE); 37649a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans 3765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if we got symbols along with the profile, return those as well 3766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbols)) { 3767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result->{symbols} = $symbols; 3768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract one from caller pc so we map back to call instr. 3774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# However, don't do this if we're reading a symbolized profile 3775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# file, in which case the subtract-one was done when the file 3776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# was written. 3777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 3778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# We apply the same logic to all readers, though ReadCPUProfile uses an 3779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# independent implementation. 3780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FixCallerAddresses { 3781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = shift; 3782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbolized_profile) { 3783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $stack; 3784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $stack =~ /(\s)/; 3786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $delimiter = $1; 3787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(' ', $stack); 3788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @fixedaddrs; 3789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $#fixedaddrs = $#addrs; 3790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 3791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fixedaddrs[0] = $addrs[0]; 3792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#addrs; $i++) { 3794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1"); 3795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return join $delimiter, @fixedaddrs; 3797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# CPU profile reader 3801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadCPUProfile { 3802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 38039a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $fname = shift; # just used for logging 38049a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans local *PROFILE = shift; 3805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $version; 3806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $period; 3807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $i; 3808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 3809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 3810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse string into array of slots. 3812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = CpuProfileStream->new(*PROFILE, $fname); 3813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read header. The current header version is a 5-element structure 3815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # containing: 3816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 0: header count (always 0) 3817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 1: header "words" (after this one: 3) 3818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 2: format version (0) 3819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 3: sampling period (usec) 3820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 4: unused padding (always 0) 3821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($slots->get(0) != 0 ) { 3822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: not a profile file, or old format profile file\n"); 3823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i = 2 + $slots->get(1); 3825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $version = $slots->get(2); 3826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $period = $slots->get(3); 3827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do some sanity checking on these header values. 3828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) { 3829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: not a profile file, or corrupted profile file\n"); 3830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse profile 3833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($slots->get($i) != -1) { 3834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n = $slots->get($i++); 3835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $d = $slots->get($i++); 3836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($d > (2**16)) { # TODO(csilvers): what's a reasonable max-stack-depth? 3837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = sprintf("0%o", $i * ($address_length == 8 ? 4 : 8)); 3838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "At index $i (address $addr):\n"; 3839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: stack trace depth >= 2**32\n"); 3840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($slots->get($i) == 0) { 3842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # End of profile data marker 3843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i += $d; 3844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make key out of the stack entries 3848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @k = (); 3849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = 0; $j < $d; $j++) { 3850a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pc = $slots->get($i+$j); 3851a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Subtract one from caller pc so we map back to call instr. 3852a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # However, don't do this if we're reading a symbolized profile 3853a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # file, in which case the subtract-one was done when the file 3854a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # was written. 3855a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($j > 0 && !$main::use_symbolized_profile) { 3856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pc--; 3857a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pc = sprintf("%0*x", $address_length, $pc); 3859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pc} = 1; 3860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push @k, $pc; 3861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($profile, (join "\n", @k), $n); 3864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i += $d; 3865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse map 3868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ''; 3869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans seek(PROFILE, $i * 4, 0); 3870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read(PROFILE, $map, (stat PROFILE)[7]); 3871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = $version; 3874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = $period; 3875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 3876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 3877a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 3878a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadHeapProfile { 3883a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 38849a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans local *PROFILE = shift; 3885a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $header = shift; 3886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 1; 3888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_space) { 3889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 1; 3890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_inuse_objects) { 3891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 0; 3892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_alloc_space) { 3893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 3; 3894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_alloc_objects) { 3895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 2; 3896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find the type of this profile. The header line looks like: 3899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap profile: 1246: 8800744 [ 1246: 8800744] @ <heap-url>/266053 3900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # There are two pairs <count: size>, the first inuse objects/space, and the 3901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # second allocated objects/space. This is followed optionally by a profile 3902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # type, and if that is present, optionally by a sampling frequency. 3903a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote heap profiles (v1): 3904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The interpretation of the sampling frequency is that the profiler, for 3905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # each sample, calculates a uniformly distributed random integer less than 3906a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the given value, and records the next sample after that many bytes have 3907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # been allocated. Therefore, the expected sample interval is half of the 3908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # given frequency. By default, if not specified, the expected sample 3909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # interval is 128KB. Only remote-heap-page profiles are adjusted for 3910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # sample size. 3911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote heap profiles (v2): 3912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The sampling frequency is the rate of a Poisson process. This means that 3913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the probability of sampling an allocation of size X with sampling rate Y 3914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # is 1 - exp(-X/Y) 3915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For version 2, a typical header line might look like this: 3916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap profile: 1922: 127792360 [ 1922: 127792360] @ <heap-url>_v2/524288 3917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the trailing number (524288) is the sampling rate. (Version 1 showed 3918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # double the 'rate' here) 3919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sampling_algorithm = 0; 3920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sample_adjustment = 0; 3921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chomp($header); 3922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $type = "unknown"; 3923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m"^heap profile:\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\](\s*@\s*([^/]*)(/(\d+))?)?") { 3924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($6) && ($6 ne '')) { 3925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $type = $6; 3926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sample_period = $8; 3927a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # $type is "heapprofile" for profiles generated by the 3928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap-profiler, and either "heap" or "heap_v2" for profiles 3929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # generated by sampling directly within tcmalloc. It can also 3930a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # be "growth" for heap-growth profiles. The first is typically 3931a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # found for profiles generated locally, and the others for 3932a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # remote profiles. 3933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($type eq "heapprofile") || ($type !~ /heap/) ) { 3934a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # No need to adjust for the sampling rate with heap-profiler-derived data 3935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 0; 3936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($type =~ /_v2/) { 3937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 2; # version 2 sampling 3938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sample_period) && ($sample_period ne '')) { 3939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = int($sample_period); 3940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 1; # version 1 sampling 3943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sample_period) && ($sample_period ne '')) { 3944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = int($sample_period)/2; 3945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We detect whether or not this is a remote-heap profile by checking 3949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that the total-allocated stats ($n2,$s2) are exactly the 3950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # same as the in-use stats ($n1,$s1). It is remotely conceivable 3951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that a non-remote-heap profile may pass this check, but it is hard 3952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to imagine how that could happen. 3953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this case it's so old it's guaranteed to be remote-heap version 1. 3954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); 3955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($n1 == $n2) && ($s1 == $s2)) { 3956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is likely to be a remote-heap based sample profile 3957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 1; 3958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm > 0) { 3963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote-heap generated profiles, adjust the counts and sizes to 3964a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # account for the sample rate (we sample once every 128KB by default). 3965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sample_adjustment == 0) { 3966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Turn on profile adjustment. 3967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = 128*1024; 3968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Adjusting heap profiles for 1-in-128KB sampling rate\n"; 3969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Adjusting heap profiles for 1-in-%d sampling rate\n", 3971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment); 3972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm > 1) { 3974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We don't bother printing anything for the original version (version 1) 3975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "Heap version $sampling_algorithm\n"; 3976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 3980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 3981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ""; 3982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^MAPPED_LIBRARIES:/) { 3986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read the /proc/self/maps data 3987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $_; 3990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^--- Memory map:/) { 3995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read /proc/self/maps data as formatted by DumpAddressMap() 3996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $buildvar = ""; 3997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse "build=<dir>" specification if supplied 4000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^\s*build=(.*)\n/) { 4001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $buildvar = $1; 4002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Expand "$build" variable if available 4005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ =~ s/\$build\b/$buildvar/g; 4006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $_; 4008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 4010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4011a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read entry of the form: 4013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # <count1>: <bytes1> [<count2>: <bytes2>] @ a1 a2 a3 ... an 4014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s*//; 4015a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s*$//; 4016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { 4017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = $5; 4018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); 4019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sample_adjustment) { 4021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm == 2) { 4022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote-heap version 2 4023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The sampling frequency is the rate of a Poisson process. 4024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This means that the probability of sampling an allocation of 4025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # size X with sampling rate Y is 1 - exp(-X/Y) 402625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($n1 != 0) { 402725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 402825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $scale_factor = 1/(1 - exp(-$ratio)); 402925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $n1 *= $scale_factor; 403025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $s1 *= $scale_factor; 403125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 403225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($n2 != 0) { 403325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 403425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $scale_factor = 1/(1 - exp(-$ratio)); 403525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $n2 *= $scale_factor; 403625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $s2 *= $scale_factor; 403725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 4038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote-heap version 1 4040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ratio; 4041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 4042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ratio < 1) { 4043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n1 /= $ratio; 4044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $s1 /= $ratio; 4045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 4047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ratio < 1) { 4048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n2 /= $ratio; 4049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $s2 /= $ratio; 4050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @counts = ($n1, $s1, $n2, $s2); 4055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]); 4056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 4060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = "heap"; 4061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = 1; 4062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 4063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 4064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 4065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadSynchProfile { 40699a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $prog = shift; 40709a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans local *PROFILE = shift; 40719a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my $header = shift; 4072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ''; 4074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 4075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 4076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sampling_period = 1; 4077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cyclespernanosec = 2.8; # Default assumption for old binaries 4078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $seen_clockrate = 0; 4079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line; 4080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 0; 4082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_total_delay) { 4083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 0; 4084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_contentions) { 4085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 1; 4086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_mean_delay) { 4087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 2; 4088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ( $line = <PROFILE> ) { 4091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 4092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $line =~ /^\s*(\d+)\s+(\d+) \@\s*(.*?)\s*$/ ) { 4093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($cycles, $count, $stack) = ($1, $2, $3); 4094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Convert cycles to nanoseconds 4096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles /= $cyclespernanosec; 4097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4098a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for sampling done by application 4099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles *= $sampling_period; 4100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count *= $sampling_period; 4101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @values = ($cycles, $count, $cycles / $count); 4103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]); 4104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ( $line =~ /^(slow release).*thread \d+ \@\s*(.*?)\s*$/ || 4106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) { 4107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($cycles, $stack) = ($1, $2); 4108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($cycles !~ /^\d+$/) { 4109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Convert cycles to nanoseconds 4113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles /= $cyclespernanosec; 4114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for sampling done by application 4116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles *= $sampling_period; 4117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles); 4119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) { 4121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($variable, $value) = ($1,$2); 4122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for ($variable, $value) { 4123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s+//; 4124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s+$//; 4125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($variable eq "cycles/second") { 4127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cyclespernanosec = $value / 1e9; 4128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen_clockrate = 1; 4129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "sampling period") { 4130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_period = $value; 4131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "ms since reset") { 4132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Currently nothing is done with this value in pprof 4133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # So we just silently ignore it for now 4134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "discarded samples") { 4135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Currently nothing is done with this value in pprof 4136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # So we just silently ignore it for now 4137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Ignoring unnknown variable in /contention output: " . 4139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "'%s' = '%s'\n",$variable,$value); 4140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Memory map entry 4143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $line; 4144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$seen_clockrate) { 4148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n", 4149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cyclespernanosec); 4150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 4153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = 0; 4154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = $sampling_period; 4155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 4156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 4157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 4158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 416125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Given a hex value in the form "0x1abcd" or "1abcd", return either 416225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# "0001abcd" or "000000000001abcd", depending on the current (global) 416325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# address length. 4164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub HexExtend { 4165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = shift; 4166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 416725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $addr =~ s/^(0x)?0*//; 416825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $zeros_needed = $address_length - length($addr); 416925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($zeros_needed < 0) { 417025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans printf STDERR "Warning: address $addr is longer than address length $address_length\n"; 417125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return $addr; 4172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 417325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return ("0" x $zeros_needed) . $addr; 4174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Symbol extraction ##### 4177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Aggressively search the lib_prefix values for the given library 4179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If all else fails, just return the name of the library unmodified. 4180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so" 4181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will search the following locations in this order, until it finds a file: 4182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/lib/dir/mylib.so 4183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/lib/dir/mylib.so 4184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/dir/mylib.so 4185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/dir/mylib.so 4186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/mylib.so 4187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/mylib.so 4188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /lib/dir/mylib.so (returned as last resort) 4189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FindLibrary { 4190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 4191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $suffix = $file; 4192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Search for the library as described above 4194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans do { 4195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $prefix (@prefix_list) { 4196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullpath = $prefix . $suffix; 4197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-e $fullpath) { 4198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $fullpath; 4199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } while ($suffix =~ s|^/[^/]+/|/|); 4202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $file; 4203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return path to library with debugging symbols. 4206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# For libc libraries, the copy in /usr/lib/debug contains debugging symbols 4207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub DebuggingLibrary { 4208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 4209bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner if ($file =~ m|^/|) { 4210bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner if (-f "/usr/lib/debug$file") { 4211bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner return "/usr/lib/debug$file"; 4212bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner } elsif (-f "/usr/lib/debug$file.debug") { 4213bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner return "/usr/lib/debug$file.debug"; 4214bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner } 4215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 4217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse text section header of a library using objdump 4220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeaderFromObjdump { 4221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib = shift; 4222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $size = undef; 4224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma; 4225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_offset; 4226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get objdump output from the library file to figure out how to 4227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # map between mapped addresses and addresses in the library. 422825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $cmd = ShellEscape($obj_tool_map{"objdump"}, "-h", $lib); 422925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(OBJDUMP, "$cmd |") || error("$cmd: $!\n"); 4230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<OBJDUMP>) { 4231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 4232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Idx Name Size VMA LMA File off Algn 4233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4 4234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file 4235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # offset may still be 8. But AddressSub below will still handle that. 4236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split; 4237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($#x >= 6) && ($x[1] eq '.text')) { 4238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $size = $x[2]; 4239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $vma = $x[3]; 4240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_offset = $x[5]; 4241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 4242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OBJDUMP); 4245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($size)) { 4247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 4248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 4251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{size} = $size; 4252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{vma} = $vma; 4253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{file_offset} = $file_offset; 4254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse text section header of a library using otool (on OS X) 4259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeaderFromOtool { 4260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib = shift; 4261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $size = undef; 4263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma = undef; 4264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_offset = undef; 4265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get otool output from the library file to figure out how to 4266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # map between mapped addresses and addresses in the library. 426725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $command = ShellEscape($obj_tool_map{"otool"}, "-l", $lib); 426825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(OTOOL, "$command |") || error("$command: $!\n"); 4269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmd = ""; 4270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sectname = ""; 4271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $segname = ""; 4272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $line (<OTOOL>) { 4273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 4274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Load command <#> 4275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # cmd LC_SEGMENT 4276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # [...] 4277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Section 4278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # sectname __text 4279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # segname __TEXT 4280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr 0x000009f8 4281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # size 0x00018b9e 4282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # offset 2552 4283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # align 2^2 (4) 4284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We will need to strip off the leading 0x from the hex addresses, 4285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and convert the offset into hex. 4286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /Load command/) { 4287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd = ""; 4288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = ""; 4289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = ""; 4290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /Section/) { 4291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = ""; 4292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = ""; 4293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /cmd (\w+)/) { 4294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd = $1; 4295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /sectname (\w+)/) { 4296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = $1; 4297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /segname (\w+)/) { 4298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = $1; 4299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (!(($cmd eq "LC_SEGMENT" || $cmd eq "LC_SEGMENT_64") && 4300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname eq "__text" && 4301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname eq "__TEXT")) { 4302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\baddr 0x([0-9a-fA-F]+)/) { 4304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $vma = $1; 4305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\bsize 0x([0-9a-fA-F]+)/) { 4306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $size = $1; 4307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\boffset ([0-9]+)/) { 4308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_offset = sprintf("%016x", $1); 4309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($vma) && defined($size) && defined($file_offset)) { 4311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 4312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OTOOL); 4315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($vma) || !defined($size) || !defined($file_offset)) { 4317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 4318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 4321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{size} = $size; 4322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{vma} = $vma; 4323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{file_offset} = $file_offset; 4324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeader { 4329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # obj_tool_map("otool") is only defined if we're in a Mach-O environment 4330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($obj_tool_map{"otool"})) { 4331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = ParseTextSectionHeaderFromOtool(@_); 4332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($r)){ 4333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If otool doesn't work, or we don't have it, fall back to objdump 4337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ParseTextSectionHeaderFromObjdump(@_); 4338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Split /proc/pid/maps dump into a list of libraries 4341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseLibraries { 4342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return if $main::use_symbol_page; # We don't need libraries info. 4343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 4344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = shift; 4345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = shift; 4346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = []; 4348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $h = "[a-f0-9]+"; 4349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $zero_offset = HexExtend("0"); 4350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $buildvar = ""; 4352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $l (split("\n", $map)) { 4353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l =~ m/^\s*build=(.*)$/) { 4354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $buildvar = $1; 4355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start; 4358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish; 4359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset; 4360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib; 4361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 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) { 4362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Full line from /proc/self/maps. Example: 4363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so 4364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start = HexExtend($1); 4365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $finish = HexExtend($2); 4366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = HexExtend($3); 4367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = $4; 4368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths 4369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) { 4370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Cooked line from DumpAddressMap. Example: 4371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 40000000-40015000: /lib/ld-2.3.2.so 4372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start = HexExtend($1); 4373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $finish = HexExtend($2); 4374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = $zero_offset; 4375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = $3; 4376bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner } 4377bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # FreeBSD 10.0 virtual memory map /proc/curproc/map as defined in 4378bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # function procfs_doprocmap (sys/fs/procfs/procfs_map.c) 4379bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # 4380bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # Example: 4381bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # 0x800600000 0x80061a000 26 0 0xfffff800035a0000 r-x 75 33 0x1004 COW NC vnode /libexec/ld-elf.s 4382bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner # o.1 NCH -1 4383bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner elsif ($l =~ /^(0x$h)\s(0x$h)\s\d+\s\d+\s0x$h\sr-x\s\d+\s\d+\s0x\d+\s(COW|NCO)\s(NC|NNC)\svnode\s(\S+\.so(\.\d+)*)/) { 4384bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner $start = HexExtend($1); 4385bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner $finish = HexExtend($2); 4386bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner $offset = $zero_offset; 4387bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner $lib = FindLibrary($5); 4388bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner 4389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Expand "$build" variable if available 4394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib =~ s/\$build\b/$buildvar/g; 4395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = FindLibrary($lib); 4397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check for pre-relocated libraries, which use pre-relocated symbol tables 4399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and thus require adjusting the offset that we'll use to translate 4400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # VM addresses into symbol table addresses. 4401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Only do this if we're not going to fetch the symbol table from a 4402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # debugging copy of the library. 4403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!DebuggingLibrary($lib)) { 4404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = ParseTextSectionHeader($lib); 4405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($text)) { 4406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma_offset = AddressSub($text->{vma}, $text->{file_offset}); 4407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = AddressAdd($offset, $vma_offset); 4408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4411bf543df20ccd9e2c422751908cabf073bc7f5d4bHarald Weppner if($main::opt_debug) { printf STDERR "$start:$finish ($offset) $lib\n"; } 4412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$lib, $start, $finish, $offset]); 4413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Append special entry for additional library (not relocated) 4416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_lib ne "") { 4417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = ParseTextSectionHeader($main::opt_lib); 4418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($text)) { 4419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start = $text->{vma}; 4420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish = AddressAdd($start, $text->{size}); 4421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$main::opt_lib, $start, $finish, $start]); 4423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Append special entry for the main program. This covers 4427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 0..max_pc_value_seen, so that we assume pc values not found in one 4428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # of the library ranges will be treated as coming from the main 4429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # program binary. 4430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $min_pc = HexExtend("0"); 4431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $max_pc = $min_pc; # find the maximal PC value in any sample 4432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (keys(%{$pcs})) { 4433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (HexExtend($pc) gt $max_pc) { $max_pc = HexExtend($pc); } 4434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$prog, $min_pc, $max_pc, $zero_offset]); 4436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 4438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add two hex addresses of length $address_length. 4441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 4442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressAdd { 4443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr1 = shift; 4444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2 = shift; 4445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum; 4446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 4448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 4449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = (hex($addr1)+hex($addr2)) % (0x10000000 * 16); 4450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $sum); 4451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize carry handling. 4454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { 4456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "AddressAdd $addr1 + $addr2 = "; 4457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = substr($addr1,-7); 4460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a2 = substr($addr2,-7); 4462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + hex($a2); 4464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = 0; 4465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xfffffff) { 4466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 1; 4467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum -= 0x10000000; 4468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $sum); 4470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = substr($addr1,-7); 4472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = substr($addr2,-7); 4474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + hex($a2) + $c; 4476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 0; 4477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xfffffff) { 4478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 1; 4479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum -= 0x10000000; 4480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $sum) . $r; 4482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($addr1) + hex($addr2) + $c; 4484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xff) { $sum -= 0x100; } 4485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $sum) . $r; 4486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "$r\n"; } 4488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract two hex addresses of length $address_length. 4495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 4496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressSub { 4497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr1 = shift; 4498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2 = shift; 4499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $diff; 4500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 4502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 4503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = (hex($addr1)-hex($addr2)) % (0x10000000 * 16); 4504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $diff); 4505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize borrow handling. 4508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "AddressSub $addr1 - $addr2 = "; } 4509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = hex(substr($addr1,-7)); 4511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a2 = hex(substr($addr2,-7)); 4513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $b = 0; 4515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { 4516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 1; 4517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 += 0x10000000; 4518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $diff); 4521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = hex(substr($addr1,-7)); 4523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = hex(substr($addr2,-7)) + $b; 4525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 0; 4527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { 4528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 1; 4529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 += 0x10000000; 4530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $diff) . $r; 4533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = hex($addr1); 4535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = hex($addr2) + $b; 4536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { $a1 += 0x100; } 4537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $diff) . $r; 4539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Increment a hex addresses of length $address_length. 4547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 4548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressInc { 4549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = shift; 4550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum; 4551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 4553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 4554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = (hex($addr)+1) % (0x10000000 * 16); 4555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $sum); 4556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize carry handling. 4559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We are always doing this to step through the addresses in a function, 4560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and will almost never overflow the first chunk, so we check for this 4561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # case and exit early. 4562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "AddressInc $addr1 = "; } 4564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = substr($addr,-7); 4566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = substr($addr,0,-7); 4567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + 1; 4568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $sum); 4569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum <= 0xfffffff) { 4570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = $addr . $r; 4571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return HexExtend($r); 4573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = "0000000"; 4575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = substr($addr,-7); 4578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = substr($addr,0,-7); 4579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + 1; 4580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $sum) . $r; 4581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum <= 0xfffffff) { 4582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = $addr . $r; 4583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return HexExtend($r); 4585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = "00000000000000"; 4587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($addr) + 1; 4590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xff) { $sum -= 0x100; } 4591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $sum) . $r; 4592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Extract symbols for all PC values found in profile 4599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractSymbols { 4600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 4601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcset = shift; 4602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = {}; 4604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4605d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Map each PC value to the containing library. To make this faster, 4606d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # we sort libraries by their starting pc value (highest first), and 4607d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # advance through the libraries as we advance the pc. Sometimes the 4608d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # addresses of libraries may overlap with the addresses of the main 4609d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # binary, so to make sure the libraries 'win', we iterate over the 46109a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # libraries in reverse order (which assumes the binary doesn't start 46119a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # in the middle of a library, which seems a fair assumption). 46129a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans my @pcs = (sort { $a cmp $b } keys(%{$pcset})); # pcset is 0-extended strings 4613d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $lib (sort {$b->[1] cmp $a->[1]} @{$libs}) { 4614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libname = $lib->[0]; 4615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start = $lib->[1]; 4616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish = $lib->[2]; 4617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = $lib->[3]; 4618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 46194bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner # Use debug library if it exists 46204bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner my $debug_libname = DebuggingLibrary($libname); 46214bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner if ($debug_libname) { 46224bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner $libname = $debug_libname; 46234bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner } 46244bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner 4625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get list of pcs that belong in this library. 4626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $contained = []; 4627d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($start_pc_index, $finish_pc_index); 46289a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index]. 4629d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; 463025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $finish_pc_index--) { 4631d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last if $pcs[$finish_pc_index - 1] le $finish; 46325fe764f83f03d30e0bc3582c2967e3b7cb92cf3cJason Evans } 46339a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # Find smallest start_pc_index such that $start <= $pc[$start_pc_index]. 4634d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; 463525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $start_pc_index--) { 4636d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last if $pcs[$start_pc_index - 1] lt $start; 4637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 46389a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # This keeps PC values higher than $pc[$finish_pc_index] in @pcs, 46399a8fc41bb9752129510f3387f5c20cb798ff6b1aJason Evans # in case there are overlaps in libraries and the main binary. 4640d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans @{$contained} = splice(@pcs, $start_pc_index, 464125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $finish_pc_index - $start_pc_index); 4642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Map to symbols 4643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); 4644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbols; 4647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Map list of PC values to symbols for a given image 4650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MapToSymbols { 4651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 4652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 4653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pclist = shift; 4654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 4655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $debug = 0; 4657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Ignore empty binaries 4659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#{$pclist} < 0) { return; } 4660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Figure out the addr2line command to use 4662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2line = $obj_tool_map{"addr2line"}; 466325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image); 4664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $obj_tool_map{"addr2line_pdb"}) { 4665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2line = $obj_tool_map{"addr2line_pdb"}; 466625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $cmd = ShellEscape($addr2line, "--demangle", "-f", "-C", "-e", $image); 4667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If "addr2line" isn't installed on the system at all, just use 4670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # nm to get what info we can (function names, but not line numbers). 467125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (system(ShellEscape($addr2line, "--help") . " >$dev_null 2>&1") != 0) { 4672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapSymbolsWithNM($image, $offset, $pclist, $symbols); 4673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 4674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # "addr2line -i" can produce a variable number of lines per input 4677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # address, with no separator that allows us to tell when data for 4678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the next address starts. So we find the address for a special 4679a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # symbol (_fini) and interleave this address between all real 4680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addresses passed to addr2line. The name of this special symbol 4681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # can then be used as a separator. 4682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = undef; # May be filled in by MapSymbolsWithNM() 4683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm_symbols = {}; 4684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); 4685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address)) { 4686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Only add " -i" to addr2line if the binary supports it. 4687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr2line --help returns 0, but not if it sees an unknown flag first. 468825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (system("$cmd -i --help >$dev_null 2>&1") == 0) { 4689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd .= " -i"; 4690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = undef; # no need for sep_address if we don't support -i 4692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make file with all PC values with intervening 'sep_address' so 4696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that we can reliably detect the end of inlined function list 4697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); 4698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { print("---- $image ---\n"); } 4699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#{$pclist}; $i++) { 4700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr2line always reads hex addresses, and does not need '0x' prefix. 4701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); } 4702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset)); 4703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address)) { 4704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf ADDRESSES ("%s\n", $sep_address); 4705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(ADDRESSES); 4708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { 4709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 471025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system("cat", $main::tmpfile_sym); 4711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 471225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans system("$cmd < " . ShellEscape($main::tmpfile_sym)); 4713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 4714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 471625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(SYMBOLS, "$cmd <" . ShellEscape($main::tmpfile_sym) . " |") 471725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans || error("$cmd: $!\n"); 4718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = 0; # Index in pclist 4719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<SYMBOLS>) { 4720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read fullfunction and filelineinfo from next pair of lines 4721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r?\n$//g; 4722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullfunction = $_; 4723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = <SYMBOLS>; 4724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r?\n$//g; 4725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filelinenum = $_; 4726a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4727a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address) && $fullfunction eq $sep_symbol) { 4728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Terminating marker for data for this address 4729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count++; 4730a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths 4734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = $pclist->[$count]; 4736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $function = ShortFunctionName($fullfunction); 473725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $nms = $nm_symbols->{$pcstr}; 473825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (defined($nms)) { 473925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($fullfunction eq '??') { 474025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # nm found a symbol for us. 4741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $function = $nms->[0]; 4742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullfunction = $nms->[2]; 474325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 474425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # MapSymbolsWithNM tags each routine with its starting address, 474525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # useful in case the image has multiple occurrences of this 474625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # routine. (It uses a syntax that resembles template paramters, 474725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # that are automatically stripped out by ShortFunctionName().) 474825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # addr2line does not provide the same information. So we check 474925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # if nm disambiguated our symbol, and if so take the annotated 475025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # (nm) version of the routine-name. TODO(csilvers): this won't 475125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # catch overloaded, inlined symbols, which nm doesn't see. 475225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Better would be to do a check similar to nm's, in this fn. 475325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($nms->[2] =~ m/^\Q$function\E/) { # sanity check it's the right fn 475425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $function = $nms->[0]; 475525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $fullfunction = $nms->[2]; 475625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 4757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 475925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 4760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Prepend to accumulated symbols for pcstr 4761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (so that caller comes before callee) 4762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $symbols->{$pcstr}; 4763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($sym)) { 4764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = []; 4765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pcstr} = $sym; 4766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@{$sym}, $function, $filelinenum, $fullfunction); 4768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } 4769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($sep_address)) { 477025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Inlining is off, so this entry ends immediately 4771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count++; 4772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOLS); 4775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Use nm to map the list of referenced PCs to symbols. Return true iff we 4778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# are able to read procedure information via nm. 4779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MapSymbolsWithNM { 4780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 4781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 4782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pclist = shift; 4783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 4784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get nm output sorted by increasing address 4786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($image, "."); 4787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!%{$symbol_table}) { 4788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 4789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Start addresses are already the right length (8 or 16 hex digits). 4791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @names = sort { $symbol_table->{$a}->[0] cmp $symbol_table->{$b}->[0] } 4792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$symbol_table}); 4793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#names < 0) { 4795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # No symbols: just use addresses 4796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@{$pclist}) { 4797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = "0x" . $pc; 4798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$pcstr, "?", $pcstr]; 4799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 4801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Sort addresses so we can do a join against nm output 4804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 0; 4805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullname = $names[0]; 4806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $name = ShortFunctionName($fullname); 4807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (sort { $a cmp $b } @{$pclist}) { 4808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for mapped offset 4809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $mpc = AddressSub($pc, $offset); 4810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($index < $#names) && ($mpc ge $symbol_table->{$fullname}->[1])){ 4811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index++; 4812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullname = $names[$index]; 4813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $name = ShortFunctionName($fullname); 4814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($mpc lt $symbol_table->{$fullname}->[1]) { 4816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$name, "?", $fullname]; 4817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = "0x" . $pc; 4819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$pcstr, "?", $pcstr]; 4820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 4823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ShortFunctionName { 4826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $function = shift; 4827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types 4828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments 4829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type 4830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $function; 4831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 483325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Trim overly long symbols found in disassembler output 483425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub CleanDisassembly { 483525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $d = shift; 483625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax) 483725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments 483825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return $d; 483925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 484025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 484125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Clean file name for display 484225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub CleanFileName { 484325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my ($f) = @_; 484425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $f =~ s|^/proc/self/cwd/||; 484525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $f =~ s|^\./||; 484625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return $f; 484725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 484825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 484925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans# Make address relative to section and clean up for display 485025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub UnparseAddress { 485125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my ($offset, $address) = @_; 485225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $address = AddressSub($address, $offset); 485325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $address =~ s/^0x//; 485425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $address =~ s/^0*//; 485525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return $address; 485625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 485725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 4858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Miscellaneous ##### 4859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Find the right versions of the above object tools to use. The 4861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# argument is the program file being analyzed, and should be an ELF 4862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 32-bit or ELF 64-bit executable file. The location of the tools 4863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# is determined by considering the following options in this order: 4864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 1) --tools option, if set 4865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 2) PPROF_TOOLS environment variable, if set 4866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 3) the environment 4867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ConfigureObjTools { 4868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog_file = shift; 4869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check for the existence of $prog_file because /usr/bin/file does not 4871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # predictably return error status in prod. 4872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (-e $prog_file) || error("$prog_file does not exist.\n"); 4873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 487425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $file_type = undef; 487525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (-e "/usr/bin/file") { 487625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # Follow symlinks (at least for systems where "file" supports that). 487725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_prog_file = ShellEscape($prog_file); 487825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $file_type = `/usr/bin/file -L $escaped_prog_file 2>$dev_null || 487925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans /usr/bin/file $escaped_prog_file`; 488025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif ($^O == "MSWin32") { 488125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $file_type = "MS Windows"; 488225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } else { 488325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans print STDERR "WARNING: Can't determine the file type of $prog_file"; 488425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 488525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 4886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /64-bit/) { 4887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Change $address_length to 16 if the program file is ELF 64-bit. 4888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We can't detect this from many (most?) heap or lock contention 4889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # profiles, since the actual addresses referenced are generally in low 4890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # memory even for 64-bit programs. 4891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 4892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /MS Windows/) { 4895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For windows, we provide a version of nm and addr2line as part of 4896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the opensource release, which is capable of parsing 4897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Windows-style PDB executables. It should live in the path, or 4898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # in the same directory as pprof. 4899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"nm_pdb"} = "nm-pdb"; 4900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"addr2line_pdb"} = "addr2line-pdb"; 4901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4903a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /Mach-O/) { 4904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # OS X uses otool to examine Mach-O files, rather than objdump. 4905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"otool"} = "otool"; 4906d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $obj_tool_map{"addr2line"} = "false"; # no addr2line 4907d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $obj_tool_map{"objdump"} = "false"; # no objdump 4908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Go fill in %obj_tool_map with the pathnames to use: 4911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $tool (keys %obj_tool_map) { 4912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{$tool} = ConfigureTool($obj_tool_map{$tool}); 4913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns the path of a caller-specified object tool. If --tools or 4917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# PPROF_TOOLS are specified, then returns the full path to the tool 4918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# with that prefix. Otherwise, returns the path unmodified (which 4919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# means we will look for it on PATH). 4920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ConfigureTool { 4921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tool = shift; 4922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $path; 4923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4924d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # --tools (or $PPROF_TOOLS) is a comma separated list, where each 4925d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # item is either a) a pathname prefix, or b) a map of the form 4926d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <tool>:<path>. First we look for an entry of type (b) for our 4927d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # tool. If one is found, we use it. Otherwise, we consider all the 4928d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # pathname prefixes in turn, until one yields an existing file. If 4929d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # none does, we use a default path. 4930d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $tools = $main::opt_tools || $ENV{"PPROF_TOOLS"} || ""; 4931d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($tools =~ m/(,|^)\Q$tool\E:([^,]*)/) { 4932d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $path = $2; 4933d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # TODO(csilvers): sanity-check that $path exists? Hard if it's relative. 4934d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($tools ne '') { 4935d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $prefix (split(',', $tools)) { 4936d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans next if ($prefix =~ /:/); # ignore "tool:fullpath" entries in the list 4937d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (-x $prefix . $tool) { 4938d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $path = $prefix . $tool; 4939d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last; 4940d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 4941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4942d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!$path) { 4943d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans error("No '$tool' found with prefix specified by " . 4944d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "--tools (or \$PPROF_TOOLS) '$tools'\n"); 4945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ... otherwise use the version that exists in the same directory as 4948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # pprof. If there's nothing there, use $PATH. 4949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $0 =~ m,[^/]*$,; # this is everything after the last slash 4950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $dirname = $`; # this is everything up to and including the last slash 4951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-x "$dirname$tool") { 4952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = "$dirname$tool"; 4953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = $tool; 4955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; } 4958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $path; 4959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 496125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evanssub ShellEscape { 496225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @escaped_words = (); 496325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans foreach my $word (@_) { 496425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_word = $word; 496525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if ($word =~ m![^a-zA-Z0-9/.,_=-]!) { # check for anything not in whitelist 496625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $escaped_word =~ s/'/'\\''/; 496725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $escaped_word = "'$escaped_word'"; 496825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 496925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@escaped_words, $escaped_word); 497025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } 497125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans return join(" ", @escaped_words); 497225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans} 497325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 4974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub cleanup { 4975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unlink($main::tmpfile_sym); 4976d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink(keys %main::tempnames); 4977d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 4978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We leave any collected profiles in $HOME/pprof in case the user wants 4979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to look at them later. We print a message informing them of this. 4980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ((scalar(@main::profile_files) > 0) && 4981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans defined($main::collected_profile)) { 4982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (scalar(@main::profile_files) == 1) { 4983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Dynamically gathered profile is in $main::collected_profile\n"; 4984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "If you want to investigate this profile further, you can do:\n"; 4986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 4987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " pprof \\\n"; 4988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " $main::prog \\\n"; 4989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " $main::collected_profile\n"; 4990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 4991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub sighandler { 4995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 4996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 4997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub error { 5000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $msg = shift; 5001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR $msg; 5002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 5003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 5004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run $nm_command and get all the resulting procedure boundaries whose 5008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# names match "$regexp" and returns them in a hashtable mapping from 5009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# procedure name to a two-element vector of [start address, end address] 5010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetProcedureBoundariesViaNm { 501125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $escaped_nm_command = shift; # shell-escaped 5012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $regexp = shift; 5013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = {}; 501525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans open(NM, "$escaped_nm_command |") || error("$escaped_nm_command: $!\n"); 5016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_start = "0"; 5017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = ""; 5018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<NM>) { 5019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 5020d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*([0-9a-f]+) (.) (..*)/) { 5021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_val = $1; 5022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $type = $2; 5023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $this_routine = $3; 5024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # It's possible for two symbols to share the same address, if 5026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one is a zero-length variable (like __start_google_malloc) or 5027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one symbol is a weak alias to another (like __libc_malloc). 5028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In such cases, we want to ignore all values except for the 5029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # actual symbol, which in nm-speak has type "T". The logic 5030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # below does this, though it's a bit tricky: what happens when 5031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we have a series of lines with the same address, is the first 5032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one gets queued up to be processed. However, it won't 5033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # *actually* be processed until later, when we read a line with 5034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # a different address. That means that as long as we're reading 5035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # lines with the same address, we have a chance to replace that 5036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # item in the queue, which we do whenever we see a 'T' entry -- 5037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that is, a line with type 'T'. If we never see a 'T' entry, 5038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we'll just go ahead and process the first entry (which never 5039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # got touched in the queue), and ignore the others. 5040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($start_val eq $last_start && $type =~ /t/i) { 5041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We are the 'T' symbol at this address, replace previous symbol. 5042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine = $this_routine; 5043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 5044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($start_val eq $last_start) { 5045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We're not the 'T' symbol at this address, so ignore us. 5046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 5047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($this_routine eq $sep_symbol) { 5050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = HexExtend($start_val); 5051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Tag this routine with the starting address in case the image 5054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # has multiple occurrences of this routine. We use a syntax 50554bbf8181f384d6bd8a634b22543f83e5b949b609Harald Weppner # that resembles template parameters that are automatically 5056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # stripped out by ShortFunctionName() 5057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $this_routine .= "<$start_val>"; 5058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($routine) && $routine =~ m/$regexp/) { 5060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_table->{$routine} = [HexExtend($last_start), 5061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans HexExtend($start_val)]; 5062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last_start = $start_val; 5064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine = $this_routine; 5065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^Loaded image name: (.+)/) { 5066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The win32 nm workalike emits information about the binary it is using. 5067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using Image $1\n"; } 5068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^PDB file name: (.+)/) { 5069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The win32 nm workalike emits information about the pdb it is using. 5070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using PDB $1\n"; } 5071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(NM); 5074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Handle the last line in the nm output. Unfortunately, we don't know 5075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # how big this last symbol is, because we don't know how big the file 5076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # is. For now, we just give it a size of 0. 5077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(csilvers): do better here. 5078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($routine) && $routine =~ m/$regexp/) { 5079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_table->{$routine} = [HexExtend($last_start), 5080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans HexExtend($last_start)]; 5081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table; 5083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Gets the procedure boundaries for all routines in "$image" whose names 5086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# match "$regexp" and returns them in a hashtable mapping from procedure 5087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# name to a two-element vector of [start address, end address]. 5088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Will return an empty map if nm is not installed or not working properly. 5089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetProcedureBoundaries { 5090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 5091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $regexp = shift; 5092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 509325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # If $image doesn't start with /, then put ./ in front of it. This works 509425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # around an obnoxious bug in our probing of nm -f behavior. 509525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # "nm -f $image" is supposed to fail on GNU nm, but if: 509625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # 509725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # a. $image starts with [BbSsPp] (for example, bin/foo/bar), AND 509825a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # b. you have a.out in your current directory (a not uncommon occurence) 509925a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # 510025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # then "nm -f $image" succeeds because -f only looks at the first letter of 510125a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # the argument, which looks valid because it's [BbSsPp], and then since 510225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # there's no image provided, it looks for a.out and finds it. 510325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # 510425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # This regex makes sure that $image starts with . or /, forcing the -f 510525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans # parsing to fail since . and / are not valid formats. 510625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $image =~ s#^[^/]#./$&#; 510725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans 5108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For libc libraries, the copy in /usr/lib/debug contains debugging symbols 5109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $debugging = DebuggingLibrary($image); 5110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debugging) { 5111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $image = $debugging; 5112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm = $obj_tool_map{"nm"}; 5115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cppfilt = $obj_tool_map{"c++filt"}; 5116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm 5118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # binary doesn't support --demangle. In addition, for OS X we need 5119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to use the -f flag to get 'flat' nm output (otherwise we don't sort 5120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # properly and get incorrect results). Unfortunately, GNU nm uses -f 5121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # in an incompatible way. So first we test whether our nm supports 5122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # --demangle and -f. 5123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $demangle_flag = ""; 5124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cppfilt_flag = ""; 512525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my $to_devnull = ">$dev_null 2>&1"; 512625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (system(ShellEscape($nm, "--demangle", "image") . $to_devnull) == 0) { 5127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this mode, we do "nm --demangle <foo>" 5128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $demangle_flag = "--demangle"; 5129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cppfilt_flag = ""; 513025a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans } elsif (system(ShellEscape($cppfilt, $image) . $to_devnull) == 0) { 5131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this mode, we do "nm <foo> | c++filt" 513225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $cppfilt_flag = " | " . ShellEscape($cppfilt); 5133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 5134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flatten_flag = ""; 513525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans if (system(ShellEscape($nm, "-f", $image) . $to_devnull) == 0) { 5136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flatten_flag = "-f"; 5137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Finally, in the case $imagie isn't a debug library, we try again with 5140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # -D to at least get *exported* symbols. If we can't use --demangle, 5141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we use c++filt instead, if it exists on this system. 514225a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans my @nm_commands = (ShellEscape($nm, "-n", $flatten_flag, $demangle_flag, 514325a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $image) . " 2>$dev_null $cppfilt_flag", 514425a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ShellEscape($nm, "-D", "-n", $flatten_flag, $demangle_flag, 514525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans $image) . " 2>$dev_null $cppfilt_flag", 5146d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 6nm is for Go binaries 514725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ShellEscape("6nm", "$image") . " 2>$dev_null | sort", 5148d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ); 5149d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 5150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If the executable is an MS Windows PDB-format executable, we'll 5151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # have set up obj_tool_map("nm_pdb"). In this case, we actually 5152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # want to use both unix nm and windows-specific nm_pdb, since 5153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # PDB-format executables can apparently include dwarf .o files. 5154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $obj_tool_map{"nm_pdb"}) { 515525a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans push(@nm_commands, 515625a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans ShellEscape($obj_tool_map{"nm_pdb"}, "--demangle", $image) 515725a000e89649d9ce5aacc1089408b8b3bafeb5e4Jason Evans . " 2>$dev_null"); 5158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $nm_command (@nm_commands) { 5161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); 5162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table if (%{$symbol_table}); 5163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = {}; 5165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table; 5166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# The test vectors for AddressAdd/Sub/Inc are 8-16-nibble hex strings. 5170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# To make them more readable, we add underscores at interesting places. 5171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# This routine removes the underscores, producing the canonical representation 5172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# used by pprof to represent addresses, particularly in the tested routines. 5173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CanonicalHex { 5174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $arg = shift; 5175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return join '', (split '_',$arg); 5176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressAdd: 5180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressAddUnitTest { 5181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 5182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 5183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 5184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 5185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 5186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressAddUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 5187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 5189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 5190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 5191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 5192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 5193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressAdd ($row->[0], $row->[1]); 5195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[2]) { 5196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + %s = %s\n", $sum, 5197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[2]; 5198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressAdd 32-bit tests: %d passes, %d failures\n", 5204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 5206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 5207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 5208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 5210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 5211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 5212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressAdd (CanonicalHex($row->[0]), CanonicalHex($row->[1])); 5214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $expected = join '', (split '_',$row->[2]); 5215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[2])) { 5216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + %s = %s\n", $sum, 5217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[2]; 5218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressAdd 64-bit tests: %d passes, %d failures\n", 5224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 5226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 5228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressSub: 5232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressSubUnitTest { 5233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 5234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 5235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 5236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 5237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 5238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressSubUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 5239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 5241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 5242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 5243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 5244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 5245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressSub ($row->[0], $row->[1]); 5247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[3]) { 5248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s - %s = %s\n", $sum, 5249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[3]; 5250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressSub 32-bit tests: %d passes, %d failures\n", 5256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 5258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 5259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 5260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 5262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 5263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 5264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressSub (CanonicalHex($row->[0]), CanonicalHex($row->[1])); 5266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[3])) { 5267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s - %s = %s\n", $sum, 5268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[3]; 5269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressSub 64-bit tests: %d passes, %d failures\n", 5275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 5277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 5279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressInc: 5283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressIncUnitTest { 5284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 5285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 5286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 5287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 5288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 5289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressIncUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 5290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 5292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 5293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 5294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 5295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 5296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressInc ($row->[0]); 5298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[4]) { 5299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum, 5300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[4]; 5301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressInc 32-bit tests: %d passes, %d failures\n", 5307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 5309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 5310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 5311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 5313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 5314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 5315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 5316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressInc (CanonicalHex($row->[0])); 5317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[4])) { 5318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum, 5319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[4]; 5320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 5321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 5323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressInc 64-bit tests: %d passes, %d failures\n", 5326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 5327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 5328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 5330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Driver for unit tests. 5334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Currently just the address add/subtract/increment routines for 64-bit. 5335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunUnitTests { 5336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 5337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is a list of tuples [a, b, a+b, a-b, a+1] 5339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $unit_test_data_8 = [ 5340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(aaaaaaaa 50505050 fafafafa 5a5a5a5a aaaaaaab)], 5341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(50505050 aaaaaaaa fafafafa a5a5a5a6 50505051)], 5342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(ffffffff aaaaaaaa aaaaaaa9 55555555 00000000)], 5343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 ffffffff 00000000 00000002 00000002)], 5344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 fffffff0 fffffff1 00000011 00000002)], 5345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ]; 5346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $unit_test_data_16 = [ 5347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The implementation handles data in 7-nibble chunks, so those are the 5348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # interesting boundaries. 5349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(aaaaaaaa 50505050 5350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_afafafa 00_0000005_a5a5a5a 00_000000a_aaaaaab)], 5351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(50505050 aaaaaaaa 5352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_afafafa ff_ffffffa_5a5a5a6 00_0000005_0505051)], 5353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(ffffffff aaaaaaaa 5354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000001a_aaaaaa9 00_0000005_5555555 00_0000010_0000000)], 5355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 ffffffff 5356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_0000010_0000000 ff_ffffff0_0000002 00_0000000_0000002)], 5357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 fffffff0 5358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_ffffff1 ff_ffffff0_0000011 00_0000000_0000002)], 5359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_a00000a_aaaaaaa 50505050 5361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_a00000f_afafafa 00_a000005_a5a5a5a 00_a00000a_aaaaaab)], 5362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(0f_fff0005_0505050 aaaaaaaa 5363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0f_fff000f_afafafa 0f_ffefffa_5a5a5a6 0f_fff0005_0505051)], 5364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_000000f_fffffff 01_800000a_aaaaaaa 5365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 01_800001a_aaaaaa9 fe_8000005_5555555 00_0000010_0000000)], 5366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_0000000_0000001 ff_fffffff_fffffff 5367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_0000000_0000000 00_0000000_0000002 00_0000000_0000002)], 5368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_0000000_0000001 ff_fffffff_ffffff0 5369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ff_fffffff_ffffff1 00_0000000_0000011 00_0000000_0000002)], 5370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ]; 5371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 5372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); 5373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); 5374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); 5375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($error_count > 0) { 5376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR $error_count, " errors: FAILED\n"; 5377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 5378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "PASS\n"; 5379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 5380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit ($error_count); 5381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 5382