pprof revision d65cdfe23310253f065bea02ba8e0016dc9b6aee
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 75a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PPROF_VERSION = "1.5"; 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); 90a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $DOT = "dot"; # leave non-absolute, since it may be in /usr/local 91a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $GV = "gv"; 92a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $KCACHEGRIND = "kcachegrind"; 93a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PS2PDF = "ps2pdf"; 94a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These are used for dynamic profiles 95d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansmy $URL_FETCHER = "curl -s"; 96a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 97a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These are the web pages that servers need to support for dynamic profiles 98a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $HEAP_PAGE = "/pprof/heap"; 99a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" 100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param 101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ?seconds=#&event=x&period=n 102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $GROWTH_PAGE = "/pprof/growth"; 103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $CONTENTION_PAGE = "/pprof/contention"; 104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter 105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; 106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST 107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $PROGRAM_NAME_PAGE = "/pprof/cmdline"; 108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 109d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# These are the web pages that can be named on the command line. 110d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# All the alternatives must begin with /. 111d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansmy $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" . 112d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" . 113d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "$FILTEREDPROFILE_PAGE)"; 114d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# default binary name 116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $UNKNOWN_BINARY = "(unknown)"; 117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# There is a pervasive dependency on the length (in hex characters, 119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# i.e., nibbles) of an address, distinguishing between 32-bit and 120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 64-bit profiles. To err on the safe size, default to 64-bit here: 121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $address_length = 16; 122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# A list of paths to search for shared object files 124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy @prefix_list = (); 125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Special routine name that should not have any symbols. 127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Used as separator to parse "addr2line -i" output. 128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $sep_symbol = '_fini'; 129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansmy $sep_address = undef; 130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Argument parsing ##### 132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub usage_string { 134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return <<EOF; 135a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansUsage: 136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <program> <profiles> 137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <profiles> is a space separated list of profile names. 138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <symbolized-profiles> 139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <symbolized-profiles> is a list of profile files where each file contains 140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans the necessary symbol mappings as well as profile data (likely generated 141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans with --raw). 142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof [options] <profile> 143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE 144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Each name can be: 146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans /path/to/profile - a path to a profile file 147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans host:port[/<service>] - a location of a service to get profile from 148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, 150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, 151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans or /pprof/filteredprofile. 152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans For instance: "pprof http://myserver.com:80$HEAP_PAGE". 153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profiling). 154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --symbols <program> 155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Maps addresses to symbol names. In this mode, stdin should be a 156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans list of library mappings, in the same format as is found in the heap- 157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans and cpu-profile files (this loosely matches that of /proc/self/maps 158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans on linux), followed by a list of hex addresses to map, one per line. 159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans For more help with querying remote servers, including how to add the 161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans necessary server-side support code, see this filename (or one like it): 162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans /usr/doc/google-perftools-$PPROF_VERSION/pprof_remote_servers.html 164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 165a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansOptions: 166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --cum Sort by cumulative data 167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --base=<base> Subtract <base> from <profile> before display 168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --interactive Run in interactive mode (interactive "help" gives help) [default] 169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --seconds=<n> Length of time for dynamic profiles [default=30 secs] 170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --add_lib=<file> Read additional symbols and line info from the given library 171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --lib_prefix=<dir> Comma separated list of library path prefixes 172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 173a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansReporting Granularity: 174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --addresses Report at address level 175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --lines Report at source line level 176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --functions Report at function level [default] 177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --files Report at source file level 178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 179a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansOutput type: 180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --text Generate text report 181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --callgrind Generate callgrind format to stdout 182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --gv Generate Postscript and display 183d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --web Generate SVG and display 184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --list=<regexp> Generate source listing of matching routines 185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --disasm=<regexp> Generate disassembly of matching routines 186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --symbols Print demangled symbol names found at given addresses 187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --dot Generate DOT file to stdout 188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --ps Generate Postcript to stdout 189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --pdf Generate PDF to stdout 190d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --svg Generate SVG to stdout 191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --gif Generate GIF to stdout 192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --raw Generate symbolized pprof data (useful with remote fetch) 193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 194a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansHeap-Profile Options: 195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --inuse_space Display in-use (mega)bytes [default] 196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --inuse_objects Display in-use objects 197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --alloc_space Display allocated (mega)bytes 198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --alloc_objects Display allocated objects 199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --show_bytes Display space in bytes 200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --drop_negative Ignore negative differences 201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 202a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansContention-profile options: 203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --total_delay Display total delay at each region [default] 204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --contentions Display number of delays at each region 205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --mean_delay Display mean delay at each region 206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 207a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCall-graph Options: 208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --nodecount=<n> Show at most so many nodes [default=80] 209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --nodefraction=<f> Hide nodes below <f>*total [default=.005] 210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --edgefraction=<f> Hide edges below <f>*total [default=.001] 211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --focus=<regexp> Focus on nodes matching <regexp> 212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --ignore=<regexp> Ignore nodes matching <regexp> 213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --scale=<n> Set GV scaling [default=0] 214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --heapcheck Make nodes with non-0 object counts 215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (i.e. direct leak generators) more visible 216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 217a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansMiscellaneous: 218d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans --tools=<prefix or binary:fullpath>[,...] \$PATH for object tool pathnames 219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --test Run unit tests 220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --help This message 221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans --version Version information 222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 223a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEnvironment Variables: 224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof 225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PPROF_TOOLS Prefix for object tools pathnames 226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 227a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansExamples: 228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof /bin/ls ls.prof 230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Enters "interactive" mode 231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text /bin/ls ls.prof 232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Outputs one line per procedure 233d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanspprof --web /bin/ls ls.prof 234d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Displays annotated call-graph in web browser 235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv /bin/ls ls.prof 236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Displays annotated call-graph via 'gv' 237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv --focus=Mutex /bin/ls ls.prof 238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Restricts to code paths including a .*Mutex.* entry 239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --gv --focus=Mutex --ignore=string /bin/ls ls.prof 240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Code paths including Mutex but not string 241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --list=getdir /bin/ls ls.prof 242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (Per-line) annotated source listing for getdir() 243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --disasm=getdir /bin/ls ls.prof 244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (Per-PC) annotated disassembly for getdir() 245d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 246d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanspprof http://localhost:1234/ 247d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Enters "interactive" mode 248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text localhost:1234 249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Outputs one line per procedure for localhost:1234 250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --raw localhost:1234 > ./local.raw 251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof --text ./local.raw 252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Fetches a remote profile for later analysis and then 253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans analyzes it in text mode. 254a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEOF 255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub version_string { 258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return <<EOF 259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanspprof (part of google-perftools $PPROF_VERSION) 260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 261a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCopyright 1998-2007 Google Inc. 262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 263a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansThis is BSD licensed software; see the source for copying conditions 264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansand license information. 265a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansThere is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A 266a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansPARTICULAR PURPOSE. 267a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansEOF 268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub usage { 271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $msg = shift; 272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$msg\n\n"; 273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR usage_string(); 274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\nFATAL ERROR: $msg\n"; # just as a reminder 275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Init() { 279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Setup tmp-file name and handler to clean it up. 280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We do this in the very beginning so that we can use 281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # error() and cleanup() function anytime here after. 282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::tmpfile_sym = "/tmp/pprof$$.sym"; 283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::tmpfile_ps = "/tmp/pprof$$"; 284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile = 0; 285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SIG{'INT'} = \&sighandler; 286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Cache from filename/linenumber to source code 288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache = (); 289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_help = 0; 291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_version = 0; 292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 0; 294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_base = ''; 295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses = 0; 296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 0; 297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 0; 298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files = 0; 299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lib_prefix = ""; 300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 0; 302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 0; 303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = ""; 304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = ""; 305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_symbols = 0; 306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv = 0; 307d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 0; 308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_dot = 0; 309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ps = 0; 310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_pdf = 0; 311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gif = 0; 312d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_svg = 0; 313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_raw = 0; 314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_nodecount = 80; 316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_nodefraction = 0.005; 317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_edgefraction = 0.001; 318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_focus = ''; 319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ignore = ''; 320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_scale = 0; 321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_heapcheck = 0; 322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_seconds = 30; 323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lib = ""; 324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_space = 0; 326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_objects = 0; 327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_space = 0; 328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_objects = 0; 329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_show_bytes = 0; 330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_drop_negative = 0; 331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive = 0; 332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_total_delay = 0; 334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_contentions = 0; 335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_mean_delay = 0; 336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_tools = ""; 338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_debug = 0; 339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_test = 0; 340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # These are undocumented flags used only by unittests. 342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_test_stride = 0; 343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Are we using $SYMBOL_PAGE? 345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::use_symbol_page = 0; 346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 347d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Files returned by TempName. 348d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans %main::tempnames = (); 349d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Type of profile we are dealing with 351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Supported types: 352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # cpu 353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap 354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # growth 355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # contention 356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = ''; # Empty type means "unknown" 357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans GetOptions("help!" => \$main::opt_help, 359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "version!" => \$main::opt_version, 360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "cum!" => \$main::opt_cum, 361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "base=s" => \$main::opt_base, 362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "seconds=i" => \$main::opt_seconds, 363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "add_lib=s" => \$main::opt_lib, 364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "lib_prefix=s" => \$main::opt_lib_prefix, 365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "functions!" => \$main::opt_functions, 366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "lines!" => \$main::opt_lines, 367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "addresses!" => \$main::opt_addresses, 368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "files!" => \$main::opt_files, 369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "text!" => \$main::opt_text, 370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "callgrind!" => \$main::opt_callgrind, 371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "list=s" => \$main::opt_list, 372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "disasm=s" => \$main::opt_disasm, 373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "symbols!" => \$main::opt_symbols, 374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "gv!" => \$main::opt_gv, 375d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "web!" => \$main::opt_web, 376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "dot!" => \$main::opt_dot, 377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "ps!" => \$main::opt_ps, 378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "pdf!" => \$main::opt_pdf, 379d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "svg!" => \$main::opt_svg, 380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "gif!" => \$main::opt_gif, 381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "raw!" => \$main::opt_raw, 382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "interactive!" => \$main::opt_interactive, 383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "nodecount=i" => \$main::opt_nodecount, 384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "nodefraction=f" => \$main::opt_nodefraction, 385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "edgefraction=f" => \$main::opt_edgefraction, 386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "focus=s" => \$main::opt_focus, 387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "ignore=s" => \$main::opt_ignore, 388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "scale=i" => \$main::opt_scale, 389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "heapcheck" => \$main::opt_heapcheck, 390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "inuse_space!" => \$main::opt_inuse_space, 391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "inuse_objects!" => \$main::opt_inuse_objects, 392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "alloc_space!" => \$main::opt_alloc_space, 393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "alloc_objects!" => \$main::opt_alloc_objects, 394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "show_bytes!" => \$main::opt_show_bytes, 395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "drop_negative!" => \$main::opt_drop_negative, 396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "total_delay!" => \$main::opt_total_delay, 397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "contentions!" => \$main::opt_contentions, 398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "mean_delay!" => \$main::opt_mean_delay, 399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "tools=s" => \$main::opt_tools, 400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "test!" => \$main::opt_test, 401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "debug!" => \$main::opt_debug, 402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Undocumented flags used only by unittests: 403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "test_stride=i" => \$main::opt_test_stride, 404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ) || usage("Invalid option(s)"); 405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Deal with the standard --help and --version 407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_help) { 408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print usage_string(); 409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_version) { 413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print version_string(); 414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassembly/listing/symbols mode requires address-level info 418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm || $main::opt_list || $main::opt_symbols) { 419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 0; 420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 0; 421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses = 1; 422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files = 0; 423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check heap-profiling flags 426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_space + 427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_inuse_objects + 428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_space + 429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_alloc_objects > 1) { 430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Specify at most on of --inuse/--alloc options"); 431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check output granularities 434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $grains = 435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions + 436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines + 437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_addresses + 438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_files + 439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0; 440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($grains > 1) { 441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Only specify one output granularity option"); 442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($grains == 0) { 444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_functions = 1; 445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check output modes 448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $modes = 449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text + 450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind + 451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_list eq '' ? 0 : 1) + 452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_disasm eq '' ? 0 : 1) + 453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($main::opt_symbols == 0 ? 0 : 1) + 454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv + 455d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web + 456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_dot + 457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_ps + 458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_pdf + 459d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_svg + 460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gif + 461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_raw + 462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive + 463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0; 464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($modes > 1) { 465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Only specify one output mode"); 466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($modes == 0) { 468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-t STDOUT) { # If STDOUT is a tty, activate interactive mode 469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_interactive = 1; 470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 1; 472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_test) { 476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans RunUnitTests(); 477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Should not return 478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Binary name and profile arguments list 482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = ""; 483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @main::pfile_args = (); 484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote profiling without a binary (using $SYMBOL_PAGE instead) 486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (IsProfileURL($ARGV[0])) { 487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::use_symbol_page = 1; 488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (IsSymbolizedProfileFile($ARGV[0])) { 489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::use_symbolized_profile = 1; 490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file 491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbol_page || $main::use_symbolized_profile) { 494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We don't need a binary! 495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %disabled = ('--lines' => $main::opt_lines, 496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '--disasm' => $main::opt_disasm); 497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for my $option (keys %disabled) { 498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("$option cannot be used without a binary") if $disabled{$option}; 499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Set $main::prog later... 501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans scalar(@ARGV) || usage("Did not specify profile file"); 502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_symbols) { 503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # --symbols needs a binary-name (to run nm on, etc) but not profiles 504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = shift(@ARGV) || usage("Did not specify program"); 505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = shift(@ARGV) || usage("Did not specify program"); 507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans scalar(@ARGV) || usage("Did not specify profile file"); 508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse profile file/location arguments 511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $farg (@ARGV) { 512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($farg =~ m/(.*)\@([0-9]+)(|\/.*)$/ ) { 513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $machine = $1; 514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num_machines = $2; 515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $path = $3; 516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $num_machines; $i++) { 517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@main::pfile_args, "$i.$machine$path"); 518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@main::pfile_args, $farg); 521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbol_page) { 525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unless (IsProfileURL($main::pfile_args[0])) { 526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("The first profile should be a remote form to use $SYMBOL_PAGE\n"); 527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans CheckSymbolPage(); 529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = FetchProgramName(); 530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (!$main::use_symbolized_profile) { # may not need objtools! 531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ConfigureObjTools($main::prog) 532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Break the opt_list_prefix into the prefix_list array 535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @prefix_list = split (',', $main::opt_lib_prefix); 536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remove trailing / from the prefixes, in the list to prevent 538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # searching things like /my/path//lib/mylib.so 539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach (@prefix_list) { 540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s|/+$||; 541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Main() { 545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Init(); 546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = undef; 547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @main::profile_files = (); 548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::op_time = time(); 549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Printing symbols is special and requires a lot less info that most. 551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_symbols) { 552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintSymbols(*STDIN); # Get /proc/maps and symbols output from stdin 553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Fetch all profile data 557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfiles(); 558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # this will hold symbols that we read from the profile files 560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_map = {}; 561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read one profile, pick the last item on the list 563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $data = ReadProfile($main::prog, pop(@main::profile_files)); 564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = $data->{profile}; 565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = $data->{pcs}; 566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = $data->{libs}; # Info about main program and shared libraries 567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $data->{symbols}); 568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add additional profiles, if available. 570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (scalar(@main::profile_files) > 0) { 571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pname (@main::profile_files) { 572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $data2 = ReadProfile($main::prog, $pname); 573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = AddProfile($profile, $data2->{profile}); 574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs = AddPcs($pcs, $data2->{pcs}); 575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $data2->{symbols}); 576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Subtract base from profile, if specified 580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_base ne '') { 581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $base = ReadProfile($main::prog, $main::opt_base); 582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = SubtractProfile($profile, $base->{profile}); 583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs = AddPcs($pcs, $base->{pcs}); 584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = MergeSymbols($symbol_map, $base->{symbols}); 585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get total data in profile 588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = TotalProfile($profile); 589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Collect symbols 591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols; 592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbolized_profile) { 593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = FetchSymbols($pcs, $symbol_map); 594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::use_symbol_page) { 595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = FetchSymbols($pcs); 596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 597d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # TODO(csilvers): $libs uses the /proc/self/maps data from profile1, 598d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # which may differ from the data from subsequent profiles, especially 599d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # if they were run on different machines. Use appropriate libs for 600d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # each pc somehow. 601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = ExtractSymbols($libs, $pcs); 602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remove uniniteresting stack items 605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = RemoveUninterestingFrames($symbols, $profile); 606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Focus? 608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_focus ne '') { 609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = FocusProfile($symbols, $profile, $main::opt_focus); 610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Ignore? 613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_ignore ne '') { 614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore); 615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = ExtractCalls($symbols, $profile); 618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reduce profiles to required output granularity, and also clean 620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # each stack trace so a given entry exists at most once. 621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print 628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$main::opt_interactive) { 629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm) { 630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm, $total); 631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_list) { 632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintListing($libs, $flat, $cumulative, $main::opt_list); 633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_text) { 634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make sure the output is empty when have nothing to report 635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (only matters when --heapcheck is given but we must be 636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # compatible with old branches that did not pass --heapcheck always): 637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($total != 0) { 638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("Total: %s %s\n", Unparse($total), Units()); 639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintText($symbols, $flat, $cumulative, $total, -1); 641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_raw) { 642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintSymbolizedProfile($symbols, $profile, $main::prog); 643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_callgrind) { 644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintCallgrind($calls); 645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { 647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_gv) { 648d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunGV(TempName($main::next_tmpfile, "ps"), ""); 649d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web) { 650d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $tmp = TempName($main::next_tmpfile, "svg"); 651d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunWeb($tmp); 652d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # The command we run might hand the file name off 653d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # to an already running browser instance and then exit. 654d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Normally, we'd remove $tmp on exit (right now), 655d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # but fork a child to remove $tmp a little later, so that the 656d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # browser has time to load it first. 657d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delete $main::tempnames{$tmp}; 658d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (fork() == 0) { 659d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans sleep 5; 660d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink($tmp); 661d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans exit(0); 662d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 665d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans cleanup(); 666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans InteractiveMode($profile, $symbols, $libs, $total); 671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Entry Point ##### 678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 679a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansMain(); 680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Temporary code to detect if we're running on a Goobuntu system. 682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# These systems don't have the right stuff installed for the special 683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Readline libraries to work, so as a temporary workaround, we default 684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# to using the normal stdio code, rather than the fancier readline-based 685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# code 686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadlineMightFail { 687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-e '/lib/libtermcap.so.2') { 688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; # libtermcap exists, so readline should be okay 689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunGV { 695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $bg = shift; # "" or " &" if we should run in background 697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!system("$GV --version >/dev/null 2>&1")) { 698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Options using double dash are supported by this gv version. 699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Also, turn on noantialias to better handle bug in gv for 700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # postscript files with large dimensions. 701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Maybe we should not pass the --noantialias flag 702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if the gv version is known to work properly without the flag. 703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans system("$GV --scale=$main::opt_scale --noantialias " . $fname . $bg); 704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Old gv version - only supports options that use single dash. 706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$GV -scale $main::opt_scale\n"; 707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans system("$GV -scale $main::opt_scale " . $fname . $bg); 708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 711d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub RunWeb { 712d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fname = shift; 713d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Loading web page file:///$fname\n"; 714d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 715d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (`uname` =~ /Darwin/) { 716d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # OS X: open will use standard preference for SVG files. 717d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans system("/usr/bin/open", $fname); 718d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return; 719d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 720d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 721d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Some kind of Unix; try generic symlinks, then specific browsers. 722d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # (Stop once we find one.) 723d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Works best if the browser is already running. 724d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my @alt = ( 725d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "/etc/alternatives/gnome-www-browser", 726d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "/etc/alternatives/x-www-browser", 727d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "google-chrome", 728d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "firefox", 729d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ); 730d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $b (@alt) { 731d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (system($b, $fname) == 0) { 732d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return; 733d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 734d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 735d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 736d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Could not load web browser.\n"; 737d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 738d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 739a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunKcachegrind { 740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $bg = shift; # "" or " &" if we should run in background 742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n"; 743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans system("$KCACHEGRIND " . $fname . $bg); 744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Interactive helper routines ##### 748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveMode { 750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $| = 1; # Make output unbuffered for interactive mode 751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($orig_profile, $symbols, $libs, $total) = @_; 752a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Welcome to pprof! For help, type 'help'.\n"; 754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Use ReadLine if it's installed and input comes from a console. 756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( -t STDIN && 757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans !ReadlineMightFail() && 758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans defined(eval {require Term::ReadLine}) ) { 759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $term = new Term::ReadLine 'pprof'; 760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ( defined ($_ = $term->readline('(pprof) '))) { 761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $term->addhistory($_) if /\S/; 762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) { 763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # exit when we get an interactive command to quit 764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { # don't have readline 767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (1) { 768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "(pprof) "; 769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = <STDIN>; 770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last if ! defined $_ ; 771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Save some flags that might be reset by InteractiveCommand() 774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $save_opt_lines = $main::opt_lines; 775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) { 777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # exit when we get an interactive command to quit 778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Restore flags 781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = $save_opt_lines; 782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Takes two args: orig profile, and command to run. 787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns 1 if we should keep going, or 0 if we were asked to quit 788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveCommand { 789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my($orig_profile, $symbols, $libs, $total, $command) = @_; 790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = $command; # just to make future m//'s easier 791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($_)) { 792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 795d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*quit/) { 796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 798d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*help/) { 799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans InteractiveHelpMessage(); 800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Clear all the mode options -- mode is controlled by "$command" 803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 0; 804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 0; 805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = 0; 806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = 0; 807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_gv = 0; 808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 0; 809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 810d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*(text|top)(\d*)\s*(.*)/) { 811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_text = 1; 812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line_limit = ($2 ne "") ? int($2) : 10; 814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($routine, $ignore) = ParseInteractiveArgs($3); 818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); 820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintText($symbols, $flat, $cumulative, $total, $line_limit); 827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 829d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*callgrind\s*([^ \n]*)/) { 830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_callgrind = 1; 831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = ExtractCalls($symbols, $orig_profile); 834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = $1; 835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $1 eq '' ) { 836d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $filename = TempName($main::next_tmpfile, "callgrind"); 837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintCallgrind($calls, $filename); 839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $1 eq '' ) { 840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans RunKcachegrind($filename, " & "); 841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile++; 842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 846d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*list\s*(.+)/) { 847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_list = 1; 848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 850a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 851a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($routine, $ignore) = ParseInteractiveArgs($1); 852a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 853a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); 854a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 855a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 857a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintListing($libs, $flat, $cumulative, $routine); 861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 863d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*disasm\s*(.+)/) { 864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_disasm = 1; 865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine; 867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($routine, $ignore) = ParseInteractiveArgs($1); 869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); 872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 877a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 878a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintDisassembly($libs, $flat, $cumulative, $routine, $total); 879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 881d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*(gv|web)\s*(.*)/) { 882d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_gv = 0; 883d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 0; 884d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($1 eq "gv") { 885d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_gv = 1; 886d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($1 eq "web") { 887d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::opt_web = 1; 888d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus; 891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore; 892d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ($focus, $ignore) = ParseInteractiveArgs($2); 893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore); 896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced = ReduceProfile($symbols, $profile); 897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get derived profiles 899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = FlatProfile($reduced); 900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = CumulativeProfile($reduced); 901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { 903d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_gv) { 904d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunGV(TempName($main::next_tmpfile, "ps"), " &"); 905d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web) { 906d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RunWeb(TempName($main::next_tmpfile, "svg")); 907d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::next_tmpfile++; 909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 912d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*$/) { 913d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 1; 914d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 915d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Unknown command: try 'help'.\n"; 916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ProcessProfile { 921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $orig_profile = shift; 922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = shift; 924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = shift; 925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process current profile to account for various settings 927a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = $orig_profile; 928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total_count = TotalProfile($profile); 929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("Total: %s %s\n", Unparse($total_count), Units()); 930a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($focus ne '') { 931a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = FocusProfile($symbols, $profile, $focus); 932a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus_count = TotalProfile($profile); 933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n", 934a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $focus, 935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($focus_count), Units(), 936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total_count), ($focus_count*100.0) / $total_count); 937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ignore ne '') { 939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = IgnoreProfile($symbols, $profile, $ignore); 940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore_count = TotalProfile($profile); 941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("After ignoring '%s': %s %s of %s (%0.1f%%)\n", 942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ignore, 943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($ignore_count), Units(), 944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total_count), 945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($ignore_count*100.0) / $total_count); 946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile; 949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub InteractiveHelpMessage { 952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR <<ENDOFHELP; 953a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansInteractive pprof mode 954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 955a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansCommands: 956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans gv 957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans gv [focus] [-ignore1] [-ignore2] 958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show graphical hierarchical display of current profile. Without 959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans any arguments, shows all samples in the profile. With the optional 960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "focus" argument, restricts the samples shown to just those where 961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans the "focus" regular expression matches a routine name on the stack 962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans trace. 963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 964d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans web 965d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans web [focus] [-ignore1] [-ignore2] 966d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Like GV, but displays profile in your web browser instead of using 967d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans Ghostview. Works best if your web browser is already running. 968d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans To change the browser that gets used: 969d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans On Linux, set the /etc/alternatives/gnome-www-browser symlink. 970d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans On OS X, change the Finder association for SVG files. 971d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans list [routine_regexp] [-ignore1] [-ignore2] 973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show source listing of routines whose names match "routine_regexp" 974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top [--cum] [-ignore1] [-ignore2] 976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top20 [--cum] [-ignore1] [-ignore2] 977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top37 [--cum] [-ignore1] [-ignore2] 978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show top lines ordered by flat profile count, or cumulative count 979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if --cum is specified. If a number is present after 'top', the 980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans top K routines will be shown (defaults to showing the top 10) 981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans disasm [routine_regexp] [-ignore1] [-ignore2] 983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Show disassembly of routines whose names match "routine_regexp", 984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans annotated with sample counts. 985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans callgrind 987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans callgrind [filename] 988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Generates callgrind file. If no filename is given, kcachegrind is called. 989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans help - This listing 991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans quit or ^D - End pprof 992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 993a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansFor commands that accept optional -ignore tags, samples where any routine in 994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansthe stack trace matches the regular expression in any of the -ignore 995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evansparameters will be ignored. 996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 997a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansFurther pprof details are available at this location (or one similar): 998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans /usr/doc/google-perftools-$PPROF_VERSION/cpu_profiler.html 1000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans /usr/doc/google-perftools-$PPROF_VERSION/heap_profiler.html 1001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1002a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansENDOFHELP 1003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseInteractiveArgs { 1005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $args = shift; 1006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = ""; 1007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = ""; 1008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split(/ +/, $args); 1009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach $a (@x) { 1010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a =~ m/^(--|-)lines$/) { 1011a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_lines = 1; 1012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($a =~ m/^(--|-)cum$/) { 1013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::opt_cum = 1; 1014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($a =~ m/^-(.*)/) { 1015a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ignore .= (($ignore ne "") ? "|" : "" ) . $1; 1016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $focus .= (($focus ne "") ? "|" : "" ) . $a; 1018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ignore ne "") { 1021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Ignoring samples in call stacks that match '$ignore'\n"; 1022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ($focus, $ignore); 1024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Output code ##### 1027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1028d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub TempName { 1029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fnum = shift; 1030d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $ext = shift; 1031d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $file = "$main::tmpfile_ps.$fnum.$ext"; 1032d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $main::tempnames{$file} = 1; 1033d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $file; 1034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print profile data in packed binary format (64-bit) to standard out 1037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintProfileData { 1038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 1039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print header (64-bit style) 1041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (zero) (header-size) (version) (sample-period) (zero) 1042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', 0, 0, 3, 0, 0, 0, 1, 0, 0, 0); 1043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 1045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 1046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 1047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 1048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $depth = $#addrs + 1; 1049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # int(foo / 2**32) is the only reliable way to get rid of bottom 1050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 32 bits on both 32- and 64-bit systems. 1051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', $count & 0xFFFFFFFF, int($count / 2**32)); 1052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', $depth & 0xFFFFFFFF, int($depth / 2**32)); 1053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $full_addr (@addrs) { 1055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = $full_addr; 1056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr =~ s/0x0*//; # strip off leading 0x, zeroes 1057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($addr) > 16) { 1058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Invalid address in profile: $full_addr\n"; 1059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 1060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $low_addr = substr($addr, -8); # get last 8 hex chars 1062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $high_addr = substr($addr, -16, 8); # get up to 8 more hex chars 1063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print pack('L*', hex('0x' . $low_addr), hex('0x' . $high_addr)); 1064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print symbols and profile data 1070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSymbolizedProfile { 1071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 1073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 1076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_marker = $&; 1077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '--- ', $symbol_marker, "\n"; 1079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($prog)) { 1080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print 'binary=', $prog, "\n"; 1081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (my ($pc, $name) = each(%{$symbols})) { 1083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sep = ' '; 1084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '0x', $pc; 1085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We have a list of function names, which include the inlined 1086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # calls. They are separated (and terminated) by --, which is 1087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # illegal in function names. 1088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = 2; $j <= $#{$name}; $j += 3) { 1089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print $sep, $name->[$j]; 1090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep = '--'; 1091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print "\n"; 1093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '---', "\n"; 1095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash 1097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_marker = $&; 1098a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print '--- ', $profile_marker, "\n"; 1099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($main::collected_profile)) { 1100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if used with remote fetch, simply dump the collected profile to output. 1101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(SRC, "<$main::collected_profile"); 1102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<SRC>) { 1103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print $_; 1104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SRC); 1106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # dump a cpu-format profile to standard out 1108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintProfileData($profile); 1109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print text output 1113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintText { 1114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = shift; 1118a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line_limit = shift; 1119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1120a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Which profile to sort by? 1121a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $s = $main::opt_cum ? $cumulative : $flat; 1122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $running_sum = 0; 1124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = 0; 1125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b } 1126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$cumulative})) { 1127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = GetEntry($flat, $k); 1128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = GetEntry($cumulative, $k); 1129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running_sum += $f; 1130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $k; 1132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$k})) { 1133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = $symbols->{$k}->[0] . " " . $symbols->{$k}->[1]; 1134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_addresses) { 1135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = $k . " " . $sym; 1136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f != 0 || $c != 0) { 1140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%8s %6s %6s %8s %6s %s\n", 1141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($f), 1142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($f, $total), 1143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($running_sum, $total), 1144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($c), 1145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($c, $total), 1146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym); 1147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lines++; 1149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last if ($line_limit >= 0 && $lines > $line_limit); 1150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print the call graph in a way that's suiteable for callgrind. 1154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintCallgrind { 1155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = shift; 1156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename; 1157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_interactive) { 1158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = shift; 1159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Writing callgrind file to '$filename'.\n" 1160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = "&STDOUT"; 1162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(CG, ">".$filename ); 1164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("events: Hits\n\n"); 1165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $call ( map { $_->[0] } 1166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sort { $a->[1] cmp $b ->[1] || 1167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a->[2] <=> $b->[2] } 1168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [$_, $1, $2] } 1170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys %$calls ) { 1171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = int($calls->{$call}); 1172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/; 1173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ( $caller_file, $caller_line, $caller_function, 1174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $callee_file, $callee_line, $callee_function ) = 1175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ( $1, $2, $3, $5, $6, $7 ); 1176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("fl=$caller_file\nfn=$caller_function\n"); 1179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined $6) { 1180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("cfl=$callee_file\n"); 1181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("cfn=$callee_function\n"); 1182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("calls=$count $callee_line\n"); 1183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf CG ("$caller_line $count\n\n"); 1185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print disassembly for all all routines that match $main::opt_disasm 1189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDisassembly { 1190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 1191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $disasm_opts = shift; 1194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = shift; 1195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $lib (@{$libs}) { 1197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts); 1198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = AddressSub($lib->[1], $lib->[3]); 1199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $routine (sort ByName keys(%{$symbol_table})) { 1200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = $symbol_table->{$routine}->[0]; 1201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = $symbol_table->{$routine}->[1]; 1202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # See if there are any samples in this routine 1203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $length = hex(AddressSub($end_addr, $start_addr)); 1204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = AddressAdd($start_addr, $offset); 1205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $length; $i++) { 1206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($cumulative->{$addr})) { 1207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintDisassembledFunction($lib->[0], $offset, 1208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine, $flat, $cumulative, 1209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start_addr, $end_addr, $total); 1210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = AddressInc($addr); 1213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return reference to array of tuples of the form: 1219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# [start_address, filename, linenumber, instruction, limit_address] 1220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# E.g., 1221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] 1222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Disassemble { 1223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 1227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $objdump = $obj_tool_map{"objdump"}; 1229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmd = sprintf("$objdump -C -d -l --no-show-raw-insn " . 1230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "--start-address=0x$start_addr " . 1231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "--stop-address=0x$end_addr $prog"); 1232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(OBJDUMP, "$cmd |") || error("$objdump: $!\n"); 1233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @result = (); 1234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = ""; 1235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $linenumber = -1; 1236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last = ["", "", "", ""]; 1237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<OBJDUMP>) { 1238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chop; 1240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m|\s*([^:\s]+):(\d+)\s*$|) { 1241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Location line of the form: 1242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # <filename>:<linenumber> 1243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = $1; 1244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $linenumber = $2; 1245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^ +([0-9a-f]+):\s*(.*)/) { 1246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassembly line -- zero-extend address to full length 1247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = HexExtend($1); 1248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = AddressAdd($addr, $offset); 1249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last->[4] = $k; # Store ending address for previous instruction 1250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last = [$k, $filename, $linenumber, $2, $end_addr]; 1251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $last); 1252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OBJDUMP); 1255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return @result; 1256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# The input file should contain lines of the form /proc/maps-like 1259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# output (same format as expected from the profiles) or that looks 1260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# like hex addresses (like "0xDEADBEEF"). We will parse all 1261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /proc/maps output, and for all the hex addresses, we will output 1262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# "short" symbol names, one per line, in the same order as the input. 1263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSymbols { 1264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maps_and_symbols_file = shift; 1265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ParseLibraries expects pcs to be in a set. Fine by us... 1267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pclist = (); # pcs in sorted order 1268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 1269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ""; 1270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $line (<$maps_and_symbols_file>) { 1271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 1272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /\b(0x[0-9a-f]+)\b/i) { 1273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@pclist, HexExtend($1)); 1274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pclist[-1]} = 1; 1275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $line; 1277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = ParseLibraries($main::prog, $map, $pcs); 1281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = ExtractSymbols($libs, $pcs); 1282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@pclist) { 1284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ->[0] is the shortname, ->[2] is the full name 1285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print(($symbols->{$pc}->[0] || "??") . "\n"); 1286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# For sorting functions by name 1291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ByName { 1292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ShortFunctionName($a) cmp ShortFunctionName($b); 1293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print source-listing for all all routines that match $main::opt_list 1296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintListing { 1297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 1298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $list_opts = shift; 1301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $lib (@{$libs}) { 1303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts); 1304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = AddressSub($lib->[1], $lib->[3]); 1305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $routine (sort ByName keys(%{$symbol_table})) { 1306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print if there are any samples in this routine 1307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = $symbol_table->{$routine}->[0]; 1308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = $symbol_table->{$routine}->[1]; 1309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $length = hex(AddressSub($end_addr, $start_addr)); 1310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = AddressAdd($start_addr, $offset); 1311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $length; $i++) { 1312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($cumulative->{$addr})) { 1313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans PrintSource($lib->[0], $offset, 1314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine, $flat, $cumulative, 1315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start_addr, $end_addr); 1316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = AddressInc($addr); 1319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns the indentation of the line, if it has any non-whitespace 1325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# characters. Otherwise, returns -1. 1326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Indentation { 1327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = shift; 1328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^(\s*)\S/) { 1329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return length($1); 1330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; 1332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print source-listing for one routine 1336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintSource { 1337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = shift; 1340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 1344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassemble all instructions (just to get line numbers) 1346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); 1347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 1: assume that the first source file encountered in the 1349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # disassembly contains the routine 1350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filename = undef; 1351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($instructions[$i]->[2] >= 0) { 1353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename = $instructions[$i]->[1]; 1354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($filename)) { 1358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "no filename found in $routine\n"; 1359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 1360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 2: assume that the largest line number from $filename is the 1363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # end of the procedure. This is typically safe since if P1 contains 1364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # an inlined call to P2, then P2 usually occurs earlier in the 1365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # source file. If this does not work, we might have to compute a 1366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # density profile or just print all regions we find. 1367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lastline = 0; 1368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = $instructions[$i]->[1]; 1370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = $instructions[$i]->[2]; 1371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($f eq $filename) && ($l > $lastline)) { 1372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lastline = $l; 1373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 3: assume the first source location from "filename" is the start of 1377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the source code. 1378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $firstline = 1; 1379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; $i++) { 1380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($instructions[$i]->[1] eq $filename) { 1381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $firstline = $instructions[$i]->[2]; 1382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 4: Extend last line forward until its indentation is less than 1387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the indentation we saw on $firstline 1388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $oldlastline = $lastline; 1389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans { 1390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$filename")) { 1391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$filename: $!\n"; 1392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 1393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = 0; 1395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_indentation = -1; 1396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l++; 1399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $indent = Indentation($_); 1400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $firstline) { 1401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($first_indentation < 0 && $indent >= 0) { 1402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $first_indentation = $indent; 1403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last if ($first_indentation == 0); 1404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $lastline && $indent >= 0) { 1407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($indent >= $first_indentation) { 1408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lastline = $l+1; 1409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 1411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 1415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign all samples to the range $firstline,$lastline, 1418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hack 4: If an instruction does not occur in the range, its samples 1419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # are moved to the next instruction that occurs in the range. 1420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $samples1 = {}; 1421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $samples2 = {}; 1422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $running1 = 0; # Unassigned flat counts 1423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $running2 = 0; # Unassigned cumulative counts 1424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total1 = 0; # Total flat counts 1425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total2 = 0; # Total cumulative counts 1426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@instructions) { 1427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add up counts for all address that fall inside this instruction 1428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c1 = 0; 1429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c2 = 0; 1430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { 1431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c1 += GetEntry($flat, $a); 1432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c2 += GetEntry($cumulative, $a); 1433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running1 += $c1; 1435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running2 += $c2; 1436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $total1 += $c1; 1437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $total2 += $c2; 1438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = $e->[1]; 1439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = $e->[2]; 1440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($file eq $filename) && 1441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($line >= $firstline) && 1442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($line <= $lastline)) { 1443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign all accumulated samples to this line 1444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples1, $line, $running1); 1445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples2, $line, $running2); 1446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running1 = 0; 1447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $running2 = 0; 1448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Assign any leftover samples to $lastline 1452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples1, $lastline, $running1); 1453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($samples2, $lastline, $running2); 1454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("ROUTINE ====================== %s in %s\n" . 1456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "%6s %6s Total %s (flat / cumulative)\n", 1457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ShortFunctionName($routine), 1458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filename, 1459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Units(), 1460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total1), 1461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($total2)); 1462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$filename")) { 1463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$filename: $!\n"; 1464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 1465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $l = 0; 1467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 1469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l++; 1470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l >= $firstline - 5 && 1471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (($l <= $oldlastline + 5) || ($l <= $lastline))) { 1472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chop; 1473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = $_; 1474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l == $firstline) { printf("---\n"); } 1475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%6s %6s %4d: %s\n", 1476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt(GetEntry($samples1, $l)), 1477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt(GetEntry($samples2, $l)), 1478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l, 1479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $text); 1480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l == $lastline) { printf("---\n"); } 1481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 1482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 1484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return the source line for the specified file/linenumber. 1487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns undef if not found. 1488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SourceLine { 1489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 1490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = shift; 1491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Look in cache 1493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($main::source_cache{$file})) { 1494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (100 < scalar keys(%main::source_cache)) { 1495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Clear the cache when it gets too big 1496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache = (); 1497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read all lines from the file 1500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!open(FILE, "<$file")) { 1501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "$file: $!\n"; 1502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache{$file} = []; # Cache the negative result 1503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 1504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = []; 1506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$lines}, ""); # So we can use 1-based line numbers as indices 1507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<FILE>) { 1508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$lines}, $_); 1509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(FILE); 1511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Save the lines in the cache 1513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::source_cache{$file} = $lines; 1514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lines = $main::source_cache{$file}; 1517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($line < 0) || ($line > $#{$lines})) { 1518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 1519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $lines->[$line]; 1521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print disassembly for one routine with interspersed source if available 1525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDisassembledFunction { 1526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 1528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = shift; 1529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_addr = shift; 1532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $end_addr = shift; 1533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $total = shift; 1534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Disassemble all instructions 1536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); 1537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make array of counts per instruction 1539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @flat_count = (); 1540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @cum_count = (); 1541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat_total = 0; 1542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cum_total = 0; 1543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@instructions) { 1544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Add up counts for all address that fall inside this instruction 1545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c1 = 0; 1546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c2 = 0; 1547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) { 1548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c1 += GetEntry($flat, $a); 1549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c2 += GetEntry($cumulative, $a); 1550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@flat_count, $c1); 1552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@cum_count, $c2); 1553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_total += $c1; 1554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_total += $c2; 1555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print header with total counts 1558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("ROUTINE ====================== %s\n" . 1559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "%6s %6s %s (flat, cumulative) %.1f%% of total\n", 1560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ShortFunctionName($routine), 1561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($flat_total), 1562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($cum_total), 1563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Units(), 1564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($cum_total * 100.0) / $total); 1565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Process instructions in order 1567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $current_file = ""; 1568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#instructions; ) { 1569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $e = $instructions[$i]; 1570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print the new file name whenever we switch files 1572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($e->[1] ne $current_file) { 1573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $current_file = $e->[1]; 1574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = $current_file; 1575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fname =~ s|^\./||; # Trim leading "./" 1576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Shorten long file names 1578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($fname) >= 58) { 1579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fname = "..." . substr($fname, -55); 1580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("-------------------- %s\n", $fname); 1582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Compute range of lines to print together to deal with 1585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # small reorderings. 1586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_line = $e->[2]; 1587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_line = $first_line; 1588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %flat_sum = (); 1589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %cum_sum = (); 1590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $l = $first_line; $l <= $last_line; $l++) { 1591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_sum{$l} = 0; 1592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_sum{$l} = 0; 1593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find run of instructions for this range of source lines 1596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $first_inst = $i; 1597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($i <= $#instructions) && 1598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($instructions[$i]->[2] >= $first_line) && 1599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ($instructions[$i]->[2] <= $last_line)) { 1600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $e = $instructions[$i]; 1601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flat_sum{$e->[2]} += $flat_count[$i]; 1602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cum_sum{$e->[2]} += $cum_count[$i]; 1603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i++; 1604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_inst = $i - 1; 1606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print source lines 1608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $l = $first_line; $l <= $last_line; $l++) { 1609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = SourceLine($current_file, $l); 1610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($line)) { 1611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line = "?\n"; 1612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 1613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/^\s+//; 1615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%6s %6s %5d: %s", 1617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($flat_sum{$l}), 1618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($cum_sum{$l}), 1619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $l, 1620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line); 1621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print disassembly 1624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $x = $first_inst; $x <= $last_inst; $x++) { 1625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $e = $instructions[$x]; 1626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $address = $e->[0]; 1627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address = AddressSub($address, $offset); # Make relative to section 1628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address =~ s/^0x//; 1629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address =~ s/^0*//; 1630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Trim symbols 1632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $d = $e->[3]; 1633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax) 1634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments 1635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf("%6s %6s %8s: %6s\n", 1637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($flat_count[$x]), 1638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans UnparseAlt($cum_count[$x]), 1639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address, 1640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $d); 1641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Print DOT graph 1646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub PrintDot { 1647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 1648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 1649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $raw = shift; 1650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flat = shift; 1651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cumulative = shift; 1652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $overall_total = shift; 1653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get total 1655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $local_total = TotalProfile($flat); 1656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nodelimit = int($main::opt_nodefraction * $local_total); 1657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edgelimit = int($main::opt_edgefraction * $local_total); 1658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nodecount = $main::opt_nodecount; 1659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find nodes to include 1661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @list = (sort { abs(GetEntry($cumulative, $b)) <=> 1662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans abs(GetEntry($cumulative, $a)) 1663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || $a cmp $b } 1664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$cumulative})); 1665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last = $nodecount - 1; 1666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($last > $#list) { 1667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last = $#list; 1668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($last >= 0) && 1670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (abs(GetEntry($cumulative, $list[$last])) <= $nodelimit)) { 1671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last--; 1672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($last < 0) { 1674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "No nodes to print\n"; 1675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 1676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($nodelimit > 0 || $edgelimit > 0) { 1679a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", 1680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($nodelimit), Units(), 1681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($edgelimit), Units()); 1682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Open DOT output file 1685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $output; 1686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_gv) { 1687d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps"); 1688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_ps) { 1689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $output = "| $DOT -Tps2"; 1690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_pdf) { 1691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $output = "| $DOT -Tps2 | $PS2PDF - -"; 1692d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($main::opt_web || $main::opt_svg) { 1693d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # We need to post-process the SVG, so write to a temporary file always. 1694d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg"); 1695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_gif) { 1696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $output = "| $DOT -Tgif"; 1697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 1698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $output = ">&STDOUT"; 1699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(DOT, $output) || error("$output: $!\n"); 1701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Title 1703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("digraph \"%s; %s %s\" {\n", 1704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $prog, 1705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($overall_total), 1706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Units()); 1707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_pdf) { 1708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The output is more printable if we set the page size for dot. 1709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("size=\"8,11\"\n"); 1710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("node [width=0.375,height=0.25];\n"); 1712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print legend 1714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("Legend [shape=box,fontsize=24,shape=plaintext," . 1715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "label=\"%s\\l%s\\l%s\\l%s\\l%s\\l\"];\n", 1716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $prog, 1717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Total %s: %s", Units(), Unparse($overall_total)), 1718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Focusing on: %s", Unparse($local_total)), 1719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Dropped nodes with <= %s abs(%s)", 1720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($nodelimit), Units()), 1721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sprintf("Dropped edges with <= %s %s", 1722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($edgelimit), Units()) 1723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ); 1724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print nodes 1726a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %node = (); 1727a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nextnode = 1; 1728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@list[0..$last]) { 1729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Pick font size 1730a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = GetEntry($flat, $a); 1731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = GetEntry($cumulative, $a); 1732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fs = 8; 1734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($local_total > 0) { 1735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fs = 8 + (50.0 * sqrt(abs($f * 1.0 / $local_total))); 1736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$a} = $nextnode++; 1739a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $a; 1740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym =~ s/\s+/\\n/g; 1741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym =~ s/::/\\n/g; 1742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Extra cumulative info to print for non-leaves 1744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $extra = ""; 1745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f != $c) { 1746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $extra = sprintf("\\rof %s (%s)", 1747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($c), 1748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($c, $overall_total)); 1749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $style = ""; 1751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_heapcheck) { 1752a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($f > 0) { 1753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # make leak-causing nodes more visible (add a background) 1754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style = ",style=filled,fillcolor=gray" 1755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($f < 0) { 1756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # make anti-leak-causing nodes (which almost never occur) 1757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # stand out as well (triple border) 1758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style = ",peripheries=3" 1759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" . 1763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "\",shape=box,fontsize=%.1f%s];\n", 1764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$a}, 1765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym, 1766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($f), 1767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Percent($f, $overall_total), 1768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $extra, 1769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fs, 1770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style, 1771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ); 1772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get edges and counts per edge 1775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %edge = (); 1776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n; 1777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$raw})) { 1778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: omit low %age edges 1779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n = $raw->{$k}; 1780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @translated = TranslateStack($symbols, $k); 1781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#translated; $i++) { 1782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $src = $translated[$i]; 1783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $dst = $translated[$i-1]; 1784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans #next if ($src eq $dst); # Avoid self-edges? 1785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($node{$src}) && exists($node{$dst})) { 1786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edge_label = "$src\001$dst"; 1787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($edge{$edge_label})) { 1788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edge{$edge_label} = 0; 1789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edge{$edge_label} += $n; 1791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Print edges 1796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (keys(%edge)) { 1797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split(/\001/, $e); 1798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n = $edge{$e}; 1799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (abs($n) > $edgelimit) { 1801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Compute line width based on edge count 1802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0); 1803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fraction > 1) { $fraction = 1; } 1804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $w = $fraction * 2; 1805d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($w < 1 && ($main::opt_web || $main::opt_svg)) { 1806d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # SVG output treats line widths < 1 poorly. 1807d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $w = 1; 1808d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 1809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Dot sometimes segfaults if given edge weights that are too large, so 1811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we cap the weights at a large value 1812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $edgeweight = abs($n) ** 0.7; 1813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($edgeweight > 100000) { $edgeweight = 100000; } 1814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edgeweight = int($edgeweight); 1815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $style = sprintf("setlinewidth(%f)", $w); 1817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($x[1] =~ m/\(inline\)/) { 1818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style .= ",dashed"; 1819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Use a slightly squashed function of the edge count as the weight 1822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf DOT ("N%s -> N%s [label=%s, weight=%d, style=\"%s\"];\n", 1823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$x[0]}, 1824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $node{$x[1]}, 1825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans Unparse($n), 1826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $edgeweight, 1827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $style); 1828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 1830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print DOT ("}\n"); 1832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(DOT); 1833d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1834d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_web || $main::opt_svg) { 1835d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Rewrite SVG to be more usable inside web browser. 1836d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans RewriteSvg(TempName($main::next_tmpfile, "svg")); 1837d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 1838d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 1840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 1841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 1842d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub RewriteSvg { 1843d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svgfile = shift; 1844d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1845d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(SVG, $svgfile) || die "open temp svg: $!"; 1846d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my @svg = <SVG>; 1847d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(SVG); 1848d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink $svgfile; 1849d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svg = join('', @svg); 1850d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1851d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Dot's SVG output is 1852d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 1853d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <svg width="___" height="___" 1854d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # viewBox="___" xmlns=...> 1855d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="graph0" transform="..."> 1856d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # ... 1857d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 1858d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </svg> 1859d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 1860d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Change it to 1861d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 1862d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <svg width="100%" height="100%" 1863d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # xmlns=...> 1864d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # $svg_javascript 1865d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="viewport" transform="translate(0,0)"> 1866d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <g id="graph0" transform="..."> 1867d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # ... 1868d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 1869d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </g> 1870d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # </svg> 1871d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1872d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Fix width, height; drop viewBox. 1873d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/(?s)<svg width="[^"]+" height="[^"]+"(.*?)viewBox="[^"]+"/<svg width="100%" height="100%"$1/; 1874d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1875d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Insert script, viewport <g> above first <g> 1876d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $svg_javascript = SvgJavascript(); 1877d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $viewport = "<g id=\"viewport\" transform=\"translate(0,0)\">\n"; 1878d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/<g id="graph\d"/$svg_javascript$viewport$&/; 1879d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1880d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Insert final </g> above </svg>. 1881d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/(.*)(<\/svg>)/$1<\/g>$2/; 1882d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $svg =~ s/<g id="graph\d"(.*?)/<g id="viewport"$1/; 1883d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1884d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($main::opt_svg) { 1885d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # --svg: write to standard output. 1886d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print $svg; 1887d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 1888d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Write back to temporary file. 1889d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(SVG, ">$svgfile") || die "open $svgfile: $!"; 1890d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print SVG $svg; 1891d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(SVG); 1892d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 1893d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 1894d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1895d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub SvgJavascript { 1896d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return <<'EOF'; 1897d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans<script type="text/ecmascript"><![CDATA[ 1898d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// SVGPan 1899d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// http://www.cyberz.org/blog/2009/12/08/svgpan-a-javascript-svg-panzoomdrag-library/ 1900d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans// Local modification: if(true || ...) below to force panning, never moving. 1901d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1902d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 1903d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * SVGPan library 1.2 1904d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ==================== 1905d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1906d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Given an unique existing element with id "viewport", including the 1907d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * the library into any SVG adds the following capabilities: 1908d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1909d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Mouse panning 1910d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Mouse zooming (using the wheel) 1911d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Object dargging 1912d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1913d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Known issues: 1914d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1915d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * - Zooming (while panning) on Safari has still some issues 1916d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1917d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Releases: 1918d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1919d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.2, Sat Mar 20 08:42:50 GMT 2010, Zeng Xiaohui 1920d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Fixed a bug with browser mouse handler interaction 1921d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1922d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.1, Wed Feb 3 17:39:33 GMT 2010, Zeng Xiaohui 1923d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Updated the zoom code to support the mouse wheel on Safari/Chrome 1924d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1925d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1.0, Andrea Leofreddi 1926d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * First release 1927d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1928d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * This code is licensed under the following BSD license: 1929d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1930d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Copyright 2009-2010 Andrea Leofreddi <a.leofreddi@itcharm.com>. All rights reserved. 1931d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1932d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Redistribution and use in source and binary forms, with or without modification, are 1933d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * permitted provided that the following conditions are met: 1934d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1935d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1. Redistributions of source code must retain the above copyright notice, this list of 1936d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * conditions and the following disclaimer. 1937d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1938d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 2. Redistributions in binary form must reproduce the above copyright notice, this list 1939d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * of conditions and the following disclaimer in the documentation and/or other materials 1940d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * provided with the distribution. 1941d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1942d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * THIS SOFTWARE IS PROVIDED BY Andrea Leofreddi ``AS IS'' AND ANY EXPRESS OR IMPLIED 1943d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 1944d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Andrea Leofreddi OR 1945d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 1946d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 1947d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 1948d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 1949d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 1950d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 1951d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * 1952d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * The views and conclusions contained in the software and documentation are those of the 1953d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * authors and should not be interpreted as representing official policies, either expressed 1954d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * or implied, of Andrea Leofreddi. 1955d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 1956d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1957d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansvar root = document.documentElement; 1958d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1959d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansvar state = 'none', stateTarget, stateOrigin, stateTf; 1960d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1961d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason EvanssetupHandlers(root); 1962d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1963d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 1964d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Register handlers 1965d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 1966d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setupHandlers(root){ 1967d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setAttributes(root, { 1968d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmouseup" : "add(evt)", 1969d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmousedown" : "handleMouseDown(evt)", 1970d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmousemove" : "handleMouseMove(evt)", 1971d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "onmouseup" : "handleMouseUp(evt)", 1972d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans //"onmouseout" : "handleMouseUp(evt)", // Decomment this to stop the pan functionality when dragging out of the SVG element 1973d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans }); 1974d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1975d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(navigator.userAgent.toLowerCase().indexOf('webkit') >= 0) 1976d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans window.addEventListener('mousewheel', handleMouseWheel, false); // Chrome/Safari 1977d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans else 1978d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans window.addEventListener('DOMMouseScroll', handleMouseWheel, false); // Others 1979d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1980d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("svg"); 1981d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans g.width = "100%"; 1982d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans g.height = "100%"; 1983d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 1984d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1985d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 1986d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Instance an SVGPoint object with given event coordinates. 1987d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 1988d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction getEventPoint(evt) { 1989d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = root.createSVGPoint(); 1990d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1991d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p.x = evt.clientX; 1992d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p.y = evt.clientY; 1993d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1994d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return p; 1995d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 1996d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 1997d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 1998d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Sets the current transform matrix of an element. 1999d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2000d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setCTM(element, matrix) { 2001d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var s = "matrix(" + matrix.a + "," + matrix.b + "," + matrix.c + "," + matrix.d + "," + matrix.e + "," + matrix.f + ")"; 2002d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2003d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans element.setAttribute("transform", s); 2004d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2005d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2006d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2007d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Dumps a matrix to a string (useful for debug). 2008d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2009d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction dumpMatrix(matrix) { 2010d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var s = "[ " + matrix.a + ", " + matrix.c + ", " + matrix.e + "\n " + matrix.b + ", " + matrix.d + ", " + matrix.f + "\n 0, 0, 1 ]"; 2011d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2012d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return s; 2013d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2014d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2015d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2016d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Sets attributes of an element. 2017d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2018d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction setAttributes(element, attributes){ 2019d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for (i in attributes) 2020d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans element.setAttributeNS(null, i, attributes[i]); 2021d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2022d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2023d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2024d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse move event. 2025d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2026d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseWheel(evt) { 2027d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2028d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2029d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2030d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2031d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2032d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2033d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2034d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var delta; 2035d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2036d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.wheelDelta) 2037d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delta = evt.wheelDelta / 3600; // Chrome/Safari 2038d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans else 2039d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans delta = evt.detail / -90; // Mozilla 2040d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2041d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var z = 1 + delta; // Zoom factor: 0.9/1.1 2042d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2043d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2044d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2045d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt); 2046d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2047d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans p = p.matrixTransform(g.getCTM().inverse()); 2048d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2049d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Compute new scale matrix in current mouse position 2050d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var k = root.createSVGMatrix().translate(p.x, p.y).scale(z).translate(-p.x, -p.y); 2051d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2052d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(g, g.getCTM().multiply(k)); 2053d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2054d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = stateTf.multiply(k.inverse()); 2055d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2056d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2057d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2058d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse move event. 2059d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2060d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseMove(evt) { 2061d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2062d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2063d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2064d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2065d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2066d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2067d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2068d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2069d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2070d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(state == 'pan') { 2071d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Pan mode 2072d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt).matrixTransform(stateTf); 2073d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2074d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(g, stateTf.inverse().translate(p.x - stateOrigin.x, p.y - stateOrigin.y)); 2075d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else if(state == 'move') { 2076d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Move mode 2077d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var p = getEventPoint(evt).matrixTransform(g.getCTM().inverse()); 2078d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2079d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans setCTM(stateTarget, root.createSVGMatrix().translate(p.x - stateOrigin.x, p.y - stateOrigin.y).multiply(g.getCTM().inverse()).multiply(stateTarget.getCTM())); 2080d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2081d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = p; 2082d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2083d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2084d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2085d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2086d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle click event. 2087d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2088d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseDown(evt) { 2089d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2090d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2091d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2092d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2093d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2094d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2095d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2096d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var g = svgDoc.getElementById("viewport"); 2097d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2098d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(true || evt.target.tagName == "svg") { 2099d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Pan mode 2100d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = 'pan'; 2101d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2102d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = g.getCTM().inverse(); 2103d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2104d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = getEventPoint(evt).matrixTransform(stateTf); 2105d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 2106d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Move mode 2107d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = 'move'; 2108d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2109d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTarget = evt.target; 2110d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2111d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateTf = g.getCTM().inverse(); 2112d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2113d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans stateOrigin = getEventPoint(evt).matrixTransform(stateTf); 2114d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2115d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2116d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2117d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans/** 2118d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans * Handle mouse button release event. 2119d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans */ 2120d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evansfunction handleMouseUp(evt) { 2121d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(evt.preventDefault) 2122d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.preventDefault(); 2123d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2124d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans evt.returnValue = false; 2125d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2126d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans var svgDoc = evt.target.ownerDocument; 2127d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2128d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if(state == 'pan' || state == 'move') { 2129d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans // Quit pan mode 2130d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans state = ''; 2131d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2132d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2133d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2134d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans]]></script> 2135d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason EvansEOF 2136d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2137d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Translate a stack of addresses into a stack of symbols 2139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TranslateStack { 2140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 2142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @result = (); 2145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#addrs; $i++) { 2146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a = $addrs[$i]; 2147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Skip large addresses since they sometimes show up as fake entries on RH9 2149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length($a) > 8 && $a gt "7fffffffffffffff") { 2150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_disasm || $main::opt_list) { 2154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We want just the address for the key 2155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $a); 2156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symlist = $symbols->{$a}; 2160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($symlist)) { 2161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symlist = [$a, "", $a]; 2162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We can have a sequence of symbols for a particular entry 2165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (more than one symbol in the case of inlining). Callers 2166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # come before callees in symlist, so walk backwards since 2167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the translated stack should contain callees before callers. 2168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { 2169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = $symlist->[$j-2]; 2170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fileline = $symlist->[$j-1]; 2171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullfunc = $symlist->[$j]; 2172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($j > 2) { 2173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $func = "$func (inline)"; 2174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_addresses) { 2176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a $func $fileline"); 2177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_lines) { 2178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($func eq '??' && $fileline eq '??:0') { 2179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$func $fileline"); 2182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_functions) { 2184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($func eq '??') { 2185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $func); 2188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_files) { 2190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fileline eq '??:0' || $fileline eq '') { 2191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, "$a"); 2192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $f = $fileline; 2194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $f =~ s/:\d+$//; 2195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $f); 2196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@result, $a); 2199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; # Do not print inlined info 2200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print join(",", @addrs), " => ", join(",", @result), "\n"; 2205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return @result; 2206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate percent string for a number and a total 2209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Percent { 2210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tot = shift; 2212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($tot != 0) { 2213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.1f%%", $num * 100.0 / $tot); 2214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf"); 2216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate pretty-printed form of number 2220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Unparse { 2221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_objects || $main::opt_alloc_objects) { 2224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_show_bytes) { 2227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.1f", $num / 1048576.0); 2230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) { 2233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds 2234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%d", $num); 2236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Alternate pretty-printed form: 0 maps to "." 2240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub UnparseAlt { 2241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $num = shift; 2242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($num == 0) { 2243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "."; 2244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return Unparse($num); 2246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return output units 2250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub Units { 2251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_objects || $main::opt_alloc_objects) { 2253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "objects"; 2254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_show_bytes) { 2256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "B"; 2257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "MB"; 2259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) { 2262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "seconds"; 2263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "samples"; 2265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Profile manipulation code ##### 2269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate flattened profile: 2271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If count is charged to stack [a,b,c,d], in generated profile, 2272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will be charged to [a] 2273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FlatProfile { 2274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 2280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $addrs[0], $count); 2281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Generate cumulative profile: 2287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If count is charged to stack [a,b,c,d], in generated profile, 2288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will be charged to [a], [b], [c], [d] 2289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CumulativeProfile { 2290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $a, $count); 2297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If the second-youngest PC on the stack is always the same, returns 2303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# that pc. Otherwise, returns undef. 2304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IsSecondPcAlwaysTheSame { 2305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $second_pc = undef; 2308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs < 1) { 2311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 2312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (not defined $second_pc) { 2314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $second_pc = $addrs[1]; 2315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($second_pc ne $addrs[1]) { 2317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 2318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $second_pc; 2322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractSymbolLocation { 2325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $address = shift; 2327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 'addr2line' outputs "??:0" for unknown locations; we do the 2328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # same to be consistent. 2329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $location = "??:0:unknown"; 2330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $symbols->{$address}) { 2331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = $symbols->{$address}->[1]; 2332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file eq "?") { 2333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file = "??:0" 2334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $location = $file . ":" . $symbols->{$address}->[0]; 2336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $location; 2338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Extracts a graph of calls. 2341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractCalls { 2342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $calls = {}; 2346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while( my ($stack_trace, $count) = each %$profile ) { 2347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @address = split(/\n/, $stack_trace); 2348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $destination = ExtractSymbolLocation($symbols, $address[0]); 2349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($calls, $destination, $count); 2350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#address; $i++) { 2351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $source = ExtractSymbolLocation($symbols, $address[$i]); 2352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $call = "$source -> $destination"; 2353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($calls, $call, $count); 2354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $destination = $source; 2355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $calls; 2359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RemoveUninterestingFrames { 2362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # List of function names to skip 2366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %skip = (); 2367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $skip_regexp = 'NOMATCH'; 2368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') { 2369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $name ('calloc', 2370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'cfree', 2371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'malloc', 2372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'free', 2373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'memalign', 2374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'posix_memalign', 2375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'pvalloc', 2376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'valloc', 2377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'realloc', 2378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_calloc', 2379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_cfree', 2380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_malloc', 2381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_free', 2382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_memalign', 2383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_posix_memalign', 2384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_pvalloc', 2385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_valloc', 2386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_realloc', 2387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_new', 2388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_delete', 2389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_newarray', 2390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_deletearray', 2391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_new_nothrow', 2392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'tc_newarray_nothrow', 2393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'do_malloc', 2394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '::do_malloc', # new name -- got moved to an unnamed ns 2395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '::do_malloc_or_cpp_alloc', 2396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'DoSampledAllocation', 2397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'simple_alloc::allocate', 2398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__malloc_alloc_template::allocate', 2399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_delete', 2400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_new', 2401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_vec_delete', 2402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__builtin_vec_new', 2403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'operator new', 2404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'operator new[]', 2405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # These mark the beginning/end of our custom sections 2406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__start_google_malloc', 2407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__stop_google_malloc', 2408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__start_malloc_hook', 2409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__stop_malloc_hook') { 2410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$name} = 1; 2411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything 2412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO: Remove TCMalloc once everything has been 2414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # moved into the tcmalloc:: namespace and we have flushed 2415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # old code out of the system. 2416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip_regexp = "TCMalloc|^tcmalloc::"; 2417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'contention') { 2418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $vname ('Mutex::Unlock', 'Mutex::UnlockSlow') { 2419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$vname} = 1; 2420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::profile_type eq 'cpu') { 2422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Drop signal handlers used for CPU profile collection 2423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(dpeng): this should not be necessary; it's taken 2424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # care of by the general 2nd-pc mechanism below. 2425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $name ('ProfileData::Add', # historical 2426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'ProfileData::prof_handler', # historical 2427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 'CpuProfiler::prof_handler', 2428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__FRAME_END__', 2429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__pthread_sighandler', 2430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans '__restore') { 2431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $skip{$name} = 1; 2432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Nothing skipped for unknown types 2435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::profile_type eq 'cpu') { 2438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If all the second-youngest program counters are the same, 2439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # this STRONGLY suggests that it is an artifact of measurement, 2440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # i.e., stack frames pushed by the CPU profiler signal handler. 2441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Hence, we delete them. 2442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (The topmost PC is read from the signal structure, not from 2443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the stack, so it does not get involved.) 2444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (my $second_pc = IsSecondPcAlwaysTheSame($profile)) { 2445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = ''; 2447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$second_pc})) { 2448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $second_pc = $symbols->{$second_pc}->[0]; 2449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Removing $second_pc from all stack traces.\n"; 2451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans splice @addrs, 1, 1; 2455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @addrs); 2456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile = $result; 2459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @path = (); 2467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($symbols->{$a})) { 2469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $func = $symbols->{$a}->[0]; 2470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($skip{$func} || ($func =~ m/$skip_regexp/)) { 2471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 2472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@path, $a); 2475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @path); 2477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Reduce profile to granularity given by user 2483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReduceProfile { 2484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @translated = TranslateStack($symbols, $k); 2490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @path = (); 2491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %seen = (); 2492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen{''} = 1; # So that empty keys are skipped 2493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (@translated) { 2494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # To avoid double-counting due to recursion, skip a stack-trace 2495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # entry if it has already been seen 2496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$seen{$e}) { 2497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen{$e} = 1; 2498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@path, $e); 2499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $reduced_path = join("\n", @path); 2502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $reduced_path, $count); 2503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Does the specified symbol array match the regexp? 2508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SymbolMatches { 2509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = shift; 2510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $re = shift; 2511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sym)) { 2512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $#{$sym}; $i += 3) { 2513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) { 2514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 2515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 2519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Focus only on paths involving specified regexps 2522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FocusProfile { 2523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $focus = shift; 2526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reply if it matches either the address/shortname/fileline 2532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) { 2533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $k, $count); 2534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 2535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Focus only on paths not involving specified regexps 2542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IgnoreProfile { 2543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 2544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ignore = shift; 2546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = {}; 2547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = $profile->{$k}; 2549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(/\n/, $k); 2550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $matched = 0; 2551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $a (@addrs) { 2552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Reply if it matches either the address/shortname/fileline 2553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) { 2554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $matched = 1; 2555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 2556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$matched) { 2559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($result, $k, $count); 2560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Get total count in profile 2566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TotalProfile { 2567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = 0; 2569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$profile})) { 2570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result += $profile->{$k}; 2571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 2573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add A to B 2576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddProfile { 2577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 2578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 2579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 2581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in A 2582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 2583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $A->{$k}; 2584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 2585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in B 2587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 2588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $B->{$k}; 2589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 2590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 2592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Merges symbol maps 2595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MergeSymbols { 2596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 2597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 2598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 2600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 2601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = $A->{$k}; 2602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($B)) { 2604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 2605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = $B->{$k}; 2606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 2609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add A to B 2613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddPcs { 2614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 2615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 2616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 2618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in A 2619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 2620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = 1 2621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # add all keys in B 2623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 2624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $R->{$k} = 1 2625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 2627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract B from A 2630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SubtractProfile { 2631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $A = shift; 2632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $B = shift; 2633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $R = {}; 2635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$A})) { 2636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $v = $A->{$k} - GetEntry($B, $k); 2637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($v < 0 && $main::opt_drop_negative) { 2638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $v = 0; 2639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, $v); 2641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$main::opt_drop_negative) { 2643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Take care of when subtracted profile has more entries 2644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $k (keys(%{$B})) { 2645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($A->{$k})) { 2646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($R, $k, 0 - $B->{$k}); 2647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $R; 2651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Get entry from profile; zero if not present 2654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetEntry { 2655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 2657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists($profile->{$k})) { 2658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile->{$k}; 2659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 2661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add entry to specified profile 2665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddEntry { 2666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $k = shift; 2668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n = shift; 2669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!exists($profile->{$k})) { 2670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile->{$k} = 0; 2671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $profile->{$k} += $n; 2673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add a stack of entries to specified profile, and add them to the $pcs 2676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# list. 2677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddEntries { 2678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = shift; 2679a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = shift; 2680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = shift; 2681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = shift; 2682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @k = (); 2683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $e (split(/\s+/, $stack)) { 2685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pc = HexExtend($e); 2686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pc} = 1; 2687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push @k, $pc; 2688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($profile, (join "\n", @k), $count); 2690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Code to profile a server dynamically ##### 2693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CheckSymbolPage { 2695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = SymbolPageURL(); 2696d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(SYMBOL, "$URL_FETCHER '$url' |"); 2697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line = <SYMBOL>; 2698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 2699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOL); 2700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unless (defined($line)) { 2701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$url doesn't exist\n"); 2702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /^num_symbols:\s+(\d+)$/) { 2705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($1 == 0) { 2706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Stripped binary. No symbols available.\n"); 2707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Failed to get the number of symbols from $url\n"); 2710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub IsProfileURL { 2714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 2715d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (-f $profile_name) { 2716d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans printf STDERR "Using local file $profile_name.\n"; 2717d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 2718d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2719d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 1; 2720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseProfileURL { 2723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 2724d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2725d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!defined($profile_name) || $profile_name eq "") { 2726d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return (); 2727d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2728d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2729d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Split profile URL - matches all non-empty strings, so no test. 2730d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,; 2731d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2732d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $proto = $1 || "http://"; 2733d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $hostport = $2; 2734d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $prefix = $3; 2735d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $profile = $4 || "/"; 2736d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2737d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $host = $hostport; 2738d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $host =~ s/:.*//; 2739d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2740d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $baseurl = "$proto$hostport$prefix"; 2741d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return ($host, $baseurl, $profile); 2742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# We fetch symbols from the first profile argument. 2745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub SymbolPageURL { 2746d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 2747d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return "$baseURL$SYMBOL_PAGE"; 2748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchProgramName() { 2751d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); 2752d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $url = "$baseURL$PROGRAM_NAME_PAGE"; 2753d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $command_line = "$URL_FETCHER '$url'"; 2754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(CMDLINE, "$command_line |") or error($command_line); 2755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmdline = <CMDLINE>; 2756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines 2757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(CMDLINE); 2758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("Failed to get program name from $url\n") unless defined($cmdline); 2759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. 2760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmdline =~ s!\n!!g; # Remove LFs. 2761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $cmdline; 2762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Gee, curl's -L (--location) option isn't reliable at least 2765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# with its 7.12.3 version. Curl will forget to post data if 2766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# there is a redirection. This function is a workaround for 2767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# curl. Redirection happens on borg hosts. 2768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ResolveRedirectionForCurl { 2769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = shift; 2770d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $command_line = "$URL_FETCHER --head '$url'"; 2771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(CMDLINE, "$command_line |") or error($command_line); 2772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<CMDLINE>) { 2773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 2774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^Location: (.*)/) { 2775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $url = $1; 2776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(CMDLINE); 2779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $url; 2780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2782d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# Add a timeout flat to URL_FETCHER 2783d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub AddFetchTimeout { 2784d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fetcher = shift; 2785d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $timeout = shift; 2786d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (defined($timeout)) { 2787d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($fetcher =~ m/\bcurl -s/) { 2788d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $fetcher .= sprintf(" --max-time %d", $timeout); 2789d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($fetcher =~ m/\brpcget\b/) { 2790d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $fetcher .= sprintf(" --deadline=%d", $timeout); 2791d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2792d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2793d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $fetcher; 2794d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 2795d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Reads a symbol map from the file handle name given as $1, returning 2797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# the resulting symbol map. Also processes variables relating to symbols. 2798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Currently, the only variable processed is 'binary=<value>' which updates 2799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $main::prog to have the correct program name. 2800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadSymbols { 2801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $in = shift; 2802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = {}; 2803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<$in>) { 2804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 2805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Removes all the leading zeroes from the symbols, see comment below. 2806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^0x0*([0-9a-f]+)\s+(.+)/) { 2807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map->{$1} = $2; 2808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^---/) { 2809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 2810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^([a-z][^=]*)=(.*)$/ ) { 2811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($variable, $value) = ($1, $2); 2812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for ($variable, $value) { 2813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s+//; 2814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s+$//; 2815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($variable eq "binary") { 2817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::prog ne $UNKNOWN_BINARY && $main::prog ne $value) { 2818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Warning: Mismatched binary name '%s', using '%s'.\n", 2819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog, $value); 2820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::prog = $value; 2822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Ignoring unknown variable in symbols list: " . 2824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "'%s' = '%s'\n", $variable, $value); 2825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $map; 2829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Fetches and processes symbols to prepare them for use in the profile output 2832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# code. If the optional 'symbol_map' arg is not given, fetches symbols from 2833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $SYMBOL_PAGE for all PC values found in profile. Otherwise, the raw symbols 2834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# are assumed to have already been fetched into 'symbol_map' and are simply 2835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# extracted and processed. 2836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchSymbols { 2837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcset = shift; 2838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_map = shift; 2839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my %seen = (); 2841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pcs = grep { !$seen{$_}++ } keys(%$pcset); # uniq 2842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($symbol_map)) { 2844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $post_data = join("+", sort((map {"0x" . "$_"} @pcs))); 2845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(POSTFILE, ">$main::tmpfile_sym"); 2847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print POSTFILE $post_data; 2848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(POSTFILE); 2849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2850a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $url = SymbolPageURL(); 2851d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 2852d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $command_line; 2853d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($URL_FETCHER =~ m/\bcurl -s/) { 2854d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url = ResolveRedirectionForCurl($url); 2855d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $command_line = "$URL_FETCHER -d '\@$main::tmpfile_sym' '$url'"; 2856d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } else { 2857d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $command_line = "$URL_FETCHER --post '$url' < '$main::tmpfile_sym'"; 2858d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 2859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols. 2860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cppfilt = $obj_tool_map{"c++filt"}; 2861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(SYMBOL, "$command_line | $cppfilt |") or error($command_line); 2862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_map = ReadSymbols(*SYMBOL{IO}); 2863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOL); 2864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2866a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = {}; 2867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@pcs) { 2868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullname; 2869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For 64 bits binaries, symbols are extracted with 8 leading zeroes. 2870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Then /symbol reads the long symbols in as uint64, and outputs 2871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the result with a "0x%08llx" format which get rid of the zeroes. 2872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # By removing all the leading zeroes in both $pc and the symbols from 2873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # /symbol, the symbols match and are retrievable from the map. 2874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $shortpc = $pc; 2875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $shortpc =~ s/^0*//; 2876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Each line may have a list of names, which includes the function 2877a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and also other functions it has inlined. They are separated 2878a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (in PrintSymbolizedFile), by --, which is illegal in function names. 2879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullnames; 2880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbol_map->{$shortpc})) { 2881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullnames = $symbol_map->{$shortpc}; 2882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2883a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullnames = "0x" . $pc; # Just use addresses 2884a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2885a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = []; 2886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = $sym; 2887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $fullname (split("--", $fullnames)) { 2888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $name = ShortFunctionName($fullname); 2889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$sym}, $name, "?", $fullname); 2890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbols; 2893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub BaseName { 2896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_name = shift; 2897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_name =~ s!^.*/!!; # Remove directory name 2898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $file_name; 2899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MakeProfileBaseName { 2902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($binary_name, $profile_name) = @_; 2903d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($profile_name); 2904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $binary_shortname = BaseName($binary_name); 2905d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return sprintf("%s.%s.%s", 2906d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $binary_shortname, $main::op_time, $host); 2907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfile { 2910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $binary_name = shift; 2911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_name = shift; 2912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fetch_name_only = shift; 2913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $encourage_patience = shift; 2914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!IsProfileURL($profile_name)) { 2916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $profile_name; 2917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2918d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($host, $baseURL, $path) = ParseProfileURL($profile_name); 2919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($path eq "" || $path eq "/") { 2920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Missing type specifier defaults to cpu-profile 2921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = $PROFILE_PAGE; 2922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_file = MakeProfileBaseName($binary_name, $profile_name); 2925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2926d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $url = "$baseURL$path"; 2927d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fetch_timeout = undef; 2928d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) { 2929d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($path =~ m/[?]/) { 2930d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= "&"; 2931a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2932d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= "?"; 2933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2934d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $url .= sprintf("seconds=%d", $main::opt_seconds); 2935d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $fetch_timeout = $main::opt_seconds * 1.01 + 60; 2936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For non-CPU profiles, we add a type-extension to 2938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the target profile file name. 2939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $suffix = $path; 2940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $suffix =~ s,/,.,g; 2941d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $profile_file .= $suffix; 2942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof"); 2945d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (! -d $profile_dir) { 2946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans mkdir($profile_dir) 2947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || die("Unable to create profile directory $profile_dir: $!\n"); 2948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tmp_profile = "$profile_dir/.tmp.$profile_file"; 2950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $real_profile = "$profile_dir/$profile_file"; 2951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fetch_name_only > 0) { 2953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $real_profile; 2954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2956d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout); 2957d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $cmd = "$fetcher '$url' > '$tmp_profile'"; 2958d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/){ 2959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n ${real_profile}\n"; 2960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($encourage_patience) { 2961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Be patient...\n"; 2962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2964d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; 2965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); 2968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename profile\n"); 2969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Wrote profile to $real_profile\n"; 2970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = $real_profile; 2971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $main::collected_profile; 2972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Collect profiles in parallel 2976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfiles { 2977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $items = scalar(@main::pfile_args); 2978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $levels = log($items) / log(2); 2979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($items == 1) { 2981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_files[0] = FetchDynamicProfile($main::prog, $main::pfile_args[0], 0, 1); 2982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 2983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # math rounding issues 2984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ((2 ** $levels) < $items) { 2985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $levels++; 2986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = scalar(@main::pfile_args); 2988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $count; $i++) { 2989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_files[$i] = FetchDynamicProfile($main::prog, $main::pfile_args[$i], 1, 0); 2990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Fetching $count profiles, Be patient...\n"; 2992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfilesRecurse($levels, 0, 0); 2993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::collected_profile = join(" \\\n ", @main::profile_files); 2994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 2995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 2996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 2997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Recursively fork a process to get enough processes 2998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# collecting profiles 2999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FetchDynamicProfilesRecurse { 3000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maxlevel = shift; 3001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $level = shift; 3002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $position = shift; 3003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (my $pid = fork()) { 3005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $position = 0 | ($position << 1); 3006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans TryCollectProfile($maxlevel, $level, $position); 3007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans wait; 3008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $position = 1 | ($position << 1); 3010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans TryCollectProfile($maxlevel, $level, $position); 3011d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans cleanup(); 3012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(0); 3013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3015a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Collect a single profile 3017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub TryCollectProfile { 3018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $maxlevel = shift; 3019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $level = shift; 3020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $position = shift; 3021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($level >= ($maxlevel - 1)) { 3023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($position < scalar(@main::pfile_args)) { 3024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfile($main::prog, $main::pfile_args[$position], 0, 0); 3025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans FetchDynamicProfilesRecurse($maxlevel, $level+1, $position); 3028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Parsing code ##### 3032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Provide a small streaming-read module to handle very large 3034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# cpu-profile files. Stream in chunks along a sliding window. 3035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Provides an interface to get one 'slot', correctly handling 3036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# endian-ness differences. A slot is one 32-bit or 64-bit word 3037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# (depending on the input profile). We tell endianness and bit-size 3038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# for the profile by looking at the first 8 bytes: in cpu profiles, 3039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# the second slot is always 3 (we'll accept anything that's not 0). 3040a91f2109292f4f4522f75d0636fdba30bda26e76Jason EvansBEGIN { 3041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans package CpuProfileStream; 3042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub new { 3044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($class, $file, $fname) = @_; 3045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $self = { file => $file, 3046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans base => 0, 3047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans stride => 512 * 1024, # must be a multiple of bitsize/8 3048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans slots => [], 3049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unpack_code => "", # N for big-endian, V for little 3050d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans perl_is_64bit => 1, # matters if profile is 64-bit 3051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 3052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans bless $self, $class; 3053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Let unittests adjust the stride 3054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_test_stride > 0) { 3055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{stride} = $main::opt_test_stride; 3056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read the first two slots to figure out bitsize and endianness. 3058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $str; 3060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, 8); 3061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Set the global $address_length based on what we see here. 3062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars). 3063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = ($str eq (chr(0)x8)) ? 16 : 8; 3064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 3065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (substr($str, 6, 2) eq chr(0)x2) { 3066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'V'; # Little-endian. 3067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (substr($str, 4, 2) eq chr(0)x2) { 3068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'N'; # Big-endian 3069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ::error("$fname: header size >= 2**16\n"); 3071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = unpack($self->{unpack_code} . "*", $str); 3073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3074d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # If we're a 64-bit profile, check if we're a 64-bit-capable 3075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # perl. Otherwise, each slot will be represented as a float 3076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # instead of an int64, losing precision and making all the 3077d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 64-bit addresses wrong. We won't complain yet, but will 3078d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # later if we ever see a value that doesn't fit in 32 bits. 3079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $has_q = 0; 3080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans eval { $has_q = pack("Q", "1") ? 1 : 1; }; 3081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$has_q) { 3082d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $self->{perl_is_64bit} = 0; 3083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, 8); 3085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (substr($str, 4, 4) eq chr(0)x4) { 3086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. 3087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'V'; # Little-endian. 3088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (substr($str, 0, 4) eq chr(0)x4) { 3089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{unpack_code} = 'N'; # Big-endian 3090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ::error("$fname: header size >= 2**32\n"); 3092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @pair = unpack($self->{unpack_code} . "*", $str); 3094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Since we know one of the pair is 0, it's fine to just add them. 3095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = (0, $pair[0] + $pair[1]); 3096a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3097a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $self; 3098a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3099a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3100a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Load more data when we access slots->get(X) which is not yet in memory. 3101a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub overflow { 3102a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($self) = @_; 3103a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->{base} += $#$slots + 1; # skip over data we're replacing 3105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $str; 3106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read($self->{file}, $str, $self->{stride}); 3107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { # the 32-bit case 3108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is the easy case: unpack provides 32-bit unpacking primitives. 3109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = unpack($self->{unpack_code} . "*", $str); 3110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3111a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We need to unpack 32 bits at a time and combine. 3112a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @b32_values = unpack($self->{unpack_code} . "*", $str); 3113a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @b64_values = (); 3114a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i < $#b32_values; $i += 2) { 3115a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(csilvers): if this is a 32-bit perl, the math below 3116a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # could end up in a too-large int, which perl will promote 3117a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to a double, losing necessary precision. Deal with that. 3118d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Right now, we just die. 3119d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); 3120d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($self->{unpack_code} eq 'N') { # big-endian 3121d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ($lo, $hi) = ($hi, $lo); 3122d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3123d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $value = $lo + $hi * (2**32); 3124d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!$self->{perl_is_64bit} && # check value is exactly represented 3125d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { 3126d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ::error("Need a 64-bit perl to process this 64-bit profile.\n"); 3127d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3128d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans push(@b64_values, $value); 3129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans @$slots = @b64_values; 3131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Access the i-th long in the file (logically), or -1 at EOF. 3135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans sub get { 3136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($self, $idx) = @_; 3137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = $self->{slots}; 3138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($#$slots >= 0) { 3139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($idx < $self->{base}) { 3140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The only time we expect a reference to $slots[$i - something] 3141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # after referencing $slots[$i] is reading the very first header. 3142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Since $stride > |header|, that shouldn't cause any lookback 3143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # errors. And everything after the header is sequential. 3144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Unexpected look-back reading CPU profile"; 3145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; # shrug, don't know what better to return 3146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($idx > $self->{base} + $#$slots) { 3147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $self->overflow(); 3148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $slots->[$idx - $self->{base}]; 3150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3151a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If we get here, $slots is [], which means we've reached EOF 3153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return -1; # unique since slots is supposed to hold unsigned numbers 3154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3157d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# Return the next line from the profile file, assuming it's a text 3158d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# line (which in this case means, doesn't start with a NUL byte). If 3159d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# it's not a text line, return "". At EOF, return undef, like perl does. 3160d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans# Input file should be in binmode. 3161d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub ReadProfileLine { 3162d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans local *PROFILE = shift; 3163d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $firstchar = ""; 3164d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $line = ""; 3165d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans read(PROFILE, $firstchar, 1); 3166d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans seek(PROFILE, -1, 1); # unread the firstchar 3167d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($firstchar eq "\0") { 3168d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return ""; 3169d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3170d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $line = <PROFILE>; 3171d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (defined($line)) { 3172d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3173d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3174d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $line; 3175d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 3176d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3177d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evanssub IsSymbolizedProfileFile { 3178d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $file_name = shift; 3179d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!(-e $file_name) || !(-r $file_name)) { 3180d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 3181d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3182d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Check if the file contains a symbol-section marker. 3183d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans open(TFILE, "<$file_name"); 3184d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans binmode TFILE; 3185d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $firstline = ReadProfileLine(*TFILE); 3186d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans close(TFILE); 3187d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!$firstline) { 3188d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return 0; 3189d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3190d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3191d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $symbol_marker = $&; 3192d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans return $firstline =~ /^--- *$symbol_marker/; 3193d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans} 3194d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 3195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse profile generated by common/profiler.cc and return a reference 3196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# to a map: 3197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{version} Version number of profile file 3198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{period} Sampling period (in microseconds) 3199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{profile} Profile object 3200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{map} Memory map info from profile 3201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# $result->{pcs} Hash of all PC values seen, key is hex address 3202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadProfile { 3203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 3204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 3205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (IsSymbolizedProfileFile($fname) && !$main::use_symbolized_profile) { 3207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we have both a binary and symbolized profiles, abort 3208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans usage("Symbolized profile '$fname' cannot be used with a binary arg. " . 3209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "Try again without passing '$prog'."); 3210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = ''; 3213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $CONTENTION_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $contention_marker = $&; 3216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $GROWTH_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $growth_marker = $&; 3218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_marker = $&; 3220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash 3221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile_marker = $&; 3222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Look at first line to see if it is a heap or a CPU profile. 3224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # CPU profile may start with no header at all, and just binary data 3225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (starting with \0\0\0\0) -- in that case, don't try to read the 3226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # whole firstline, since it may be gigabytes(!) of data. 3227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(PROFILE, "<$fname") || error("$fname: $!\n"); 3228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans binmode PROFILE; # New perls do UTF-8 processing 3229d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $header = ReadProfileLine(*PROFILE); 3230d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!defined($header)) { # means "at EOF" 3231d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans error("Profile is empty.\n"); 3232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols; 3235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m/^--- *$symbol_marker/o) { 3236d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Read the symbol section of the symbolized profile file. 3237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols = ReadSymbols(*PROFILE{IO}); 3238d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Read the next line to get the header for the remaining profile. 3239d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $header = ReadProfileLine(*PROFILE) || ""; 3240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result; 3243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m/^heap profile:.*$growth_marker/o) { 3245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'growth'; 3246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadHeapProfile($prog, $fname, $header); 3247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^heap profile:/) { 3248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'heap'; 3249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadHeapProfile($prog, $fname, $header); 3250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *$contention_marker/o) { 3251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'contention'; 3252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadSynchProfile($prog, $fname); 3253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *Stacks:/) { 3254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR 3255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "Old format contention profile: mistakenly reports " . 3256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "condition variable signals as lock contentions.\n"; 3257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'contention'; 3258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadSynchProfile($prog, $fname); 3259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($header =~ m/^--- *$profile_marker/) { 3260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the binary cpu profile data starts immediately after this line 3261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'cpu'; 3262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadCPUProfile($prog, $fname); 3263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbols)) { 3265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # a symbolized profile contains a format we don't recognize, bail out 3266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: Cannot recognize profile section after symbols.\n"); 3267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # no ascii header present -- must be a CPU profile 3269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $main::profile_type = 'cpu'; 3270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result = ReadCPUProfile($prog, $fname); 3271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if we got symbols along with the profile, return those as well 3274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($symbols)) { 3275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $result->{symbols} = $symbols; 3276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract one from caller pc so we map back to call instr. 3282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# However, don't do this if we're reading a symbolized profile 3283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# file, in which case the subtract-one was done when the file 3284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# was written. 3285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 3286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# We apply the same logic to all readers, though ReadCPUProfile uses an 3287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# independent implementation. 3288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FixCallerAddresses { 3289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = shift; 3290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::use_symbolized_profile) { 3291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $stack; 3292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $stack =~ /(\s)/; 3294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $delimiter = $1; 3295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @addrs = split(' ', $stack); 3296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @fixedaddrs; 3297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $#fixedaddrs = $#addrs; 3298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#addrs >= 0) { 3299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fixedaddrs[0] = $addrs[0]; 3300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 1; $i <= $#addrs; $i++) { 3302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1"); 3303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return join $delimiter, @fixedaddrs; 3305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# CPU profile reader 3309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadCPUProfile { 3310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 3311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 3312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $version; 3313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $period; 3314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $i; 3315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 3316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 3317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse string into array of slots. 3319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $slots = CpuProfileStream->new(*PROFILE, $fname); 3320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read header. The current header version is a 5-element structure 3322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # containing: 3323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 0: header count (always 0) 3324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 1: header "words" (after this one: 3) 3325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 2: format version (0) 3326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 3: sampling period (usec) 3327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 4: unused padding (always 0) 3328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($slots->get(0) != 0 ) { 3329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: not a profile file, or old format profile file\n"); 3330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i = 2 + $slots->get(1); 3332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $version = $slots->get(2); 3333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $period = $slots->get(3); 3334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do some sanity checking on these header values. 3335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) { 3336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: not a profile file, or corrupted profile file\n"); 3337a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3338a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse profile 3340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($slots->get($i) != -1) { 3341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $n = $slots->get($i++); 3342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $d = $slots->get($i++); 3343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($d > (2**16)) { # TODO(csilvers): what's a reasonable max-stack-depth? 3344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = sprintf("0%o", $i * ($address_length == 8 ? 4 : 8)); 3345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "At index $i (address $addr):\n"; 3346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans error("$fname: stack trace depth >= 2**32\n"); 3347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($slots->get($i) == 0) { 3349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # End of profile data marker 3350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i += $d; 3351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make key out of the stack entries 3355a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @k = (); 3356a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $j = 0; $j < $d; $j++) { 3357a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pc = $slots->get($i+$j); 3358a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Subtract one from caller pc so we map back to call instr. 3359a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # However, don't do this if we're reading a symbolized profile 3360a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # file, in which case the subtract-one was done when the file 3361a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # was written. 3362a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($j > 0 && !$main::use_symbolized_profile) { 3363a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pc--; 3364a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3365a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pc = sprintf("%0*x", $address_length, $pc); 3366a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pcs->{$pc} = 1; 3367a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push @k, $pc; 3368a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3369a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3370a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntry($profile, (join "\n", @k), $n); 3371a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $i += $d; 3372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3373a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3374a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse map 3375a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ''; 3376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans seek(PROFILE, $i * 4, 0); 3377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans read(PROFILE, $map, (stat PROFILE)[7]); 3378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(PROFILE); 3379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = $version; 3382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = $period; 3383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 3384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 3385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 3386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadHeapProfile { 3391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 3392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fname = shift; 3393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $header = shift; 3394a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3395a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 1; 3396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_inuse_space) { 3397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 1; 3398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_inuse_objects) { 3399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 0; 3400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_alloc_space) { 3401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 3; 3402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_alloc_objects) { 3403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 2; 3404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Find the type of this profile. The header line looks like: 3407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap profile: 1246: 8800744 [ 1246: 8800744] @ <heap-url>/266053 3408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # There are two pairs <count: size>, the first inuse objects/space, and the 3409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # second allocated objects/space. This is followed optionally by a profile 3410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # type, and if that is present, optionally by a sampling frequency. 3411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote heap profiles (v1): 3412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The interpretation of the sampling frequency is that the profiler, for 3413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # each sample, calculates a uniformly distributed random integer less than 3414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the given value, and records the next sample after that many bytes have 3415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # been allocated. Therefore, the expected sample interval is half of the 3416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # given frequency. By default, if not specified, the expected sample 3417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # interval is 128KB. Only remote-heap-page profiles are adjusted for 3418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # sample size. 3419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote heap profiles (v2): 3420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The sampling frequency is the rate of a Poisson process. This means that 3421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the probability of sampling an allocation of size X with sampling rate Y 3422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # is 1 - exp(-X/Y) 3423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For version 2, a typical header line might look like this: 3424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap profile: 1922: 127792360 [ 1922: 127792360] @ <heap-url>_v2/524288 3425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the trailing number (524288) is the sampling rate. (Version 1 showed 3426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # double the 'rate' here) 3427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sampling_algorithm = 0; 3428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sample_adjustment = 0; 3429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans chomp($header); 3430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $type = "unknown"; 3431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($header =~ m"^heap profile:\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\](\s*@\s*([^/]*)(/(\d+))?)?") { 3432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($6) && ($6 ne '')) { 3433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $type = $6; 3434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sample_period = $8; 3435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # $type is "heapprofile" for profiles generated by the 3436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # heap-profiler, and either "heap" or "heap_v2" for profiles 3437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # generated by sampling directly within tcmalloc. It can also 3438a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # be "growth" for heap-growth profiles. The first is typically 3439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # found for profiles generated locally, and the others for 3440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # remote profiles. 3441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($type eq "heapprofile") || ($type !~ /heap/) ) { 3442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # No need to adjust for the sampling rate with heap-profiler-derived data 3443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 0; 3444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($type =~ /_v2/) { 3445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 2; # version 2 sampling 3446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sample_period) && ($sample_period ne '')) { 3447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = int($sample_period); 3448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 1; # version 1 sampling 3451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sample_period) && ($sample_period ne '')) { 3452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = int($sample_period)/2; 3453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We detect whether or not this is a remote-heap profile by checking 3457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that the total-allocated stats ($n2,$s2) are exactly the 3458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # same as the in-use stats ($n1,$s1). It is remotely conceivable 3459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that a non-remote-heap profile may pass this check, but it is hard 3460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to imagine how that could happen. 3461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this case it's so old it's guaranteed to be remote-heap version 1. 3462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); 3463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($n1 == $n2) && ($s1 == $s2)) { 3464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is likely to be a remote-heap based sample profile 3465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_algorithm = 1; 3466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm > 0) { 3471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For remote-heap generated profiles, adjust the counts and sizes to 3472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # account for the sample rate (we sample once every 128KB by default). 3473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sample_adjustment == 0) { 3474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Turn on profile adjustment. 3475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment = 128*1024; 3476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Adjusting heap profiles for 1-in-128KB sampling rate\n"; 3477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Adjusting heap profiles for 1-in-%d sampling rate\n", 3479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sample_adjustment); 3480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm > 1) { 3482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We don't bother printing anything for the original version (version 1) 3483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "Heap version $sampling_algorithm\n"; 3484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 3488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 3489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ""; 3490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^MAPPED_LIBRARIES:/) { 3494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read the /proc/self/maps data 3495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $_; 3498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (/^--- Memory map:/) { 3503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read /proc/self/maps data as formatted by DumpAddressMap() 3504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $buildvar = ""; 3505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<PROFILE>) { 3506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Parse "build=<dir>" specification if supplied 3508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^\s*build=(.*)\n/) { 3509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $buildvar = $1; 3510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Expand "$build" variable if available 3513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ =~ s/\$build\b/$buildvar/g; 3514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $_; 3516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read entry of the form: 3521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # <count1>: <bytes1> [<count2>: <bytes2>] @ a1 a2 a3 ... an 3522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s*//; 3523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s*$//; 3524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { 3525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $stack = $5; 3526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); 3527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sample_adjustment) { 3529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sampling_algorithm == 2) { 3530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote-heap version 2 3531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The sampling frequency is the rate of a Poisson process. 3532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This means that the probability of sampling an allocation of 3533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # size X with sampling rate Y is 1 - exp(-X/Y) 3534d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($n1 != 0) { 3535d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 3536d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $scale_factor = 1/(1 - exp(-$ratio)); 3537d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $n1 *= $scale_factor; 3538d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $s1 *= $scale_factor; 3539d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3540d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($n2 != 0) { 3541d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 3542d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $scale_factor = 1/(1 - exp(-$ratio)); 35435fe764f83f03d30e0bc3582c2967e3b7cb92cf3cJason Evans $n2 *= $scale_factor; 35445fe764f83f03d30e0bc3582c2967e3b7cb92cf3cJason Evans $s2 *= $scale_factor; 3545d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 3546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3547a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Remote-heap version 1 3548a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $ratio; 3549a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ratio = (($s1*1.0)/$n1)/($sample_adjustment); 3550a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ratio < 1) { 3551a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n1 /= $ratio; 3552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $s1 /= $ratio; 3553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $ratio = (($s2*1.0)/$n2)/($sample_adjustment); 3555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($ratio < 1) { 3556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $n2 /= $ratio; 3557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $s2 /= $ratio; 3558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @counts = ($n1, $s1, $n2, $s2); 3563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]); 3564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = "heap"; 3569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = 1; 3570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 3571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 3572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 3573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ReadSynchProfile { 3577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($prog, $fname, $header) = @_; 3578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = ''; 3580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $profile = {}; 3581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = {}; 3582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sampling_period = 1; 3583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cyclespernanosec = 2.8; # Default assumption for old binaries 3584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $seen_clockrate = 0; 3585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $line; 3586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 0; 3588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_total_delay) { 3589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 0; 3590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_contentions) { 3591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 1; 3592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($main::opt_mean_delay) { 3593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index = 2; 3594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ( $line = <PROFILE> ) { 3597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ( $line =~ /^\s*(\d+)\s+(\d+) \@\s*(.*?)\s*$/ ) { 3599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($cycles, $count, $stack) = ($1, $2, $3); 3600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Convert cycles to nanoseconds 3602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles /= $cyclespernanosec; 3603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for sampling done by application 3605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles *= $sampling_period; 3606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count *= $sampling_period; 3607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @values = ($cycles, $count, $cycles / $count); 3609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]); 3610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ( $line =~ /^(slow release).*thread \d+ \@\s*(.*?)\s*$/ || 3612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) { 3613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($cycles, $stack) = ($1, $2); 3614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($cycles !~ /^\d+$/) { 3615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 3616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Convert cycles to nanoseconds 3619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles /= $cyclespernanosec; 3620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for sampling done by application 3622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cycles *= $sampling_period; 3623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles); 3625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) { 3627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my ($variable, $value) = ($1,$2); 3628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for ($variable, $value) { 3629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/^\s+//; 3630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\s+$//; 3631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($variable eq "cycles/second") { 3633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cyclespernanosec = $value / 1e9; 3634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $seen_clockrate = 1; 3635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "sampling period") { 3636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sampling_period = $value; 3637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "ms since reset") { 3638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Currently nothing is done with this value in pprof 3639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # So we just silently ignore it for now 3640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($variable eq "discarded samples") { 3641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Currently nothing is done with this value in pprof 3642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # So we just silently ignore it for now 3643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("Ignoring unnknown variable in /contention output: " . 3645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "'%s' = '%s'\n",$variable,$value); 3646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Memory map entry 3649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $map .= $line; 3650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close PROFILE; 3653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!$seen_clockrate) { 3655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n", 3656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cyclespernanosec); 3657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{version} = 0; 3661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{period} = $sampling_period; 3662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{profile} = $profile; 3663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{libs} = ParseLibraries($prog, $map, $pcs); 3664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{pcs} = $pcs; 3665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Given a hex value in the form "0x1abcd" return "0001abcd" or 3669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# "000000000001abcd", depending on the current address length. 3670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# There's probably a more idiomatic (or faster) way to do this... 3671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub HexExtend { 3672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = shift; 3673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr =~ s/^0x//; 3675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (length $addr > $address_length) { 3677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "Warning: address $addr is longer than address length $address_length\n"; 3678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3679a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return substr("000000000000000".$addr, -$address_length); 3681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Symbol extraction ##### 3684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Aggressively search the lib_prefix values for the given library 3686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If all else fails, just return the name of the library unmodified. 3687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so" 3688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# it will search the following locations in this order, until it finds a file: 3689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/lib/dir/mylib.so 3690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/lib/dir/mylib.so 3691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/dir/mylib.so 3692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/dir/mylib.so 3693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /my/path/mylib.so 3694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /other/path/mylib.so 3695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# /lib/dir/mylib.so (returned as last resort) 3696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub FindLibrary { 3697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 3698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $suffix = $file; 3699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Search for the library as described above 3701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans do { 3702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $prefix (@prefix_list) { 3703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullpath = $prefix . $suffix; 3704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-e $fullpath) { 3705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $fullpath; 3706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } while ($suffix =~ s|^/[^/]+/|/|); 3709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $file; 3710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Return path to library with debugging symbols. 3713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# For libc libraries, the copy in /usr/lib/debug contains debugging symbols 3714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub DebuggingLibrary { 3715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file = shift; 3716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file =~ m|^/| && -f "/usr/lib/debug$file") { 3717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return "/usr/lib/debug$file"; 3718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 3720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse text section header of a library using objdump 3723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeaderFromObjdump { 3724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib = shift; 3725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3726a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $size = undef; 3727a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma; 3728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_offset; 3729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get objdump output from the library file to figure out how to 3730a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # map between mapped addresses and addresses in the library. 3731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $objdump = $obj_tool_map{"objdump"}; 3732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(OBJDUMP, "$objdump -h $lib |") 3733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || error("$objdump $lib: $!\n"); 3734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<OBJDUMP>) { 3735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 3736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Idx Name Size VMA LMA File off Algn 3737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4 3738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file 3739a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # offset may still be 8. But AddressSub below will still handle that. 3740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @x = split; 3741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (($#x >= 6) && ($x[1] eq '.text')) { 3742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $size = $x[2]; 3743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $vma = $x[3]; 3744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_offset = $x[5]; 3745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OBJDUMP); 3749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($size)) { 3751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 3752a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{size} = $size; 3756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{vma} = $vma; 3757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{file_offset} = $file_offset; 3758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Parse text section header of a library using otool (on OS X) 3763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeaderFromOtool { 3764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib = shift; 3765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $size = undef; 3767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma = undef; 3768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_offset = undef; 3769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get otool output from the library file to figure out how to 3770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # map between mapped addresses and addresses in the library. 3771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $otool = $obj_tool_map{"otool"}; 3772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(OTOOL, "$otool -l $lib |") 3773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans || error("$otool $lib: $!\n"); 3774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmd = ""; 3775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sectname = ""; 3776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $segname = ""; 3777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $line (<OTOOL>) { 3778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 3779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Load command <#> 3780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # cmd LC_SEGMENT 3781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # [...] 3782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Section 3783a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # sectname __text 3784a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # segname __TEXT 3785a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr 0x000009f8 3786a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # size 0x00018b9e 3787a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # offset 2552 3788a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # align 2^2 (4) 3789a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We will need to strip off the leading 0x from the hex addresses, 3790a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and convert the offset into hex. 3791a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($line =~ /Load command/) { 3792a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd = ""; 3793a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = ""; 3794a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = ""; 3795a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /Section/) { 3796a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = ""; 3797a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = ""; 3798a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /cmd (\w+)/) { 3799a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd = $1; 3800a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /sectname (\w+)/) { 3801a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname = $1; 3802a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /segname (\w+)/) { 3803a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname = $1; 3804a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (!(($cmd eq "LC_SEGMENT" || $cmd eq "LC_SEGMENT_64") && 3805a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sectname eq "__text" && 3806a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $segname eq "__TEXT")) { 3807a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 3808a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\baddr 0x([0-9a-fA-F]+)/) { 3809a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $vma = $1; 3810a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\bsize 0x([0-9a-fA-F]+)/) { 3811a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $size = $1; 3812a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($line =~ /\boffset ([0-9]+)/) { 3813a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $file_offset = sprintf("%016x", $1); 3814a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3815a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($vma) && defined($size) && defined($file_offset)) { 3816a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans last; 3817a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3818a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3819a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(OTOOL); 3820a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3821a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($vma) || !defined($size) || !defined($file_offset)) { 3822a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return undef; 3823a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3824a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3825a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = {}; 3826a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{size} = $size; 3827a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{vma} = $vma; 3828a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r->{file_offset} = $file_offset; 3829a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3830a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3831a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3832a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3833a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseTextSectionHeader { 3834a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # obj_tool_map("otool") is only defined if we're in a Mach-O environment 3835a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($obj_tool_map{"otool"})) { 3836a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = ParseTextSectionHeaderFromOtool(@_); 3837a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($r)){ 3838a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3839a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3840a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3841a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If otool doesn't work, or we don't have it, fall back to objdump 3842a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return ParseTextSectionHeaderFromObjdump(@_); 3843a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3844a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3845a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Split /proc/pid/maps dump into a list of libraries 3846a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ParseLibraries { 3847a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return if $main::use_symbol_page; # We don't need libraries info. 3848a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog = shift; 3849a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $map = shift; 3850a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcs = shift; 3851a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3852a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $result = []; 3853a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $h = "[a-f0-9]+"; 3854a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $zero_offset = HexExtend("0"); 3855a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3856a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $buildvar = ""; 3857a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $l (split("\n", $map)) { 3858a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($l =~ m/^\s*build=(.*)$/) { 3859a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $buildvar = $1; 3860a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3861a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3862a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start; 3863a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish; 3864a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset; 3865a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $lib; 3866a91f2109292f4f4522f75d0636fdba30bda26e76Jason 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) { 3867a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Full line from /proc/self/maps. Example: 3868a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so 3869a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start = HexExtend($1); 3870a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $finish = HexExtend($2); 3871a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = HexExtend($3); 3872a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = $4; 3873a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths 3874a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) { 3875a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Cooked line from DumpAddressMap. Example: 3876a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 40000000-40015000: /lib/ld-2.3.2.so 3877a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $start = HexExtend($1); 3878a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $finish = HexExtend($2); 3879a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = $zero_offset; 3880a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = $3; 3881a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3882a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 3883a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3884a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3885a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Expand "$build" variable if available 3886a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib =~ s/\$build\b/$buildvar/g; 3887a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3888a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $lib = FindLibrary($lib); 3889a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3890a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check for pre-relocated libraries, which use pre-relocated symbol tables 3891a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and thus require adjusting the offset that we'll use to translate 3892a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # VM addresses into symbol table addresses. 3893a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Only do this if we're not going to fetch the symbol table from a 3894a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # debugging copy of the library. 3895a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!DebuggingLibrary($lib)) { 3896a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = ParseTextSectionHeader($lib); 3897a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($text)) { 3898a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $vma_offset = AddressSub($text->{vma}, $text->{file_offset}); 3899a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $offset = AddressAdd($offset, $vma_offset); 3900a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3901a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3902a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3903a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$lib, $start, $finish, $offset]); 3904a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3905a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3906a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Append special entry for additional library (not relocated) 3907a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_lib ne "") { 3908a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $text = ParseTextSectionHeader($main::opt_lib); 3909a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($text)) { 3910a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start = $text->{vma}; 3911a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish = AddressAdd($start, $text->{size}); 3912a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3913a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$main::opt_lib, $start, $finish, $start]); 3914a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3915a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3916a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3917a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Append special entry for the main program. This covers 3918a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # 0..max_pc_value_seen, so that we assume pc values not found in one 3919a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # of the library ranges will be treated as coming from the main 3920a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # program binary. 3921a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $min_pc = HexExtend("0"); 3922a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $max_pc = $min_pc; # find the maximal PC value in any sample 3923a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (keys(%{$pcs})) { 3924a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (HexExtend($pc) gt $max_pc) { $max_pc = HexExtend($pc); } 3925a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3926a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@{$result}, [$prog, $min_pc, $max_pc, $zero_offset]); 3927a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3928a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $result; 3929a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3930a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3931a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Add two hex addresses of length $address_length. 3932a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 3933a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressAdd { 3934a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr1 = shift; 3935a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2 = shift; 3936a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum; 3937a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3938a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 3939a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 3940a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = (hex($addr1)+hex($addr2)) % (0x10000000 * 16); 3941a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $sum); 3942a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3943a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3944a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize carry handling. 3945a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3946a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { 3947a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "AddressAdd $addr1 + $addr2 = "; 3948a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3949a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3950a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = substr($addr1,-7); 3951a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 3952a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a2 = substr($addr2,-7); 3953a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 3954a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + hex($a2); 3955a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $c = 0; 3956a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xfffffff) { 3957a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 1; 3958a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum -= 0x10000000; 3959a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3960a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $sum); 3961a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3962a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = substr($addr1,-7); 3963a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 3964a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = substr($addr2,-7); 3965a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 3966a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + hex($a2) + $c; 3967a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 0; 3968a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xfffffff) { 3969a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $c = 1; 3970a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum -= 0x10000000; 3971a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3972a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $sum) . $r; 3973a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3974a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($addr1) + hex($addr2) + $c; 3975a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xff) { $sum -= 0x100; } 3976a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $sum) . $r; 3977a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3978a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "$r\n"; } 3979a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3980a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 3981a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 3982a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 3983a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3984a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3985a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Subtract two hex addresses of length $address_length. 3986a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 3987a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressSub { 3988a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr1 = shift; 3989a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2 = shift; 3990a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $diff; 3991a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3992a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 3993a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 3994a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = (hex($addr1)-hex($addr2)) % (0x10000000 * 16); 3995a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $diff); 3996a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 3997a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 3998a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize borrow handling. 3999a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "AddressSub $addr1 - $addr2 = "; } 4000a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4001a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = hex(substr($addr1,-7)); 4002a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4003a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a2 = hex(substr($addr2,-7)); 4004a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4005a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $b = 0; 4006a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { 4007a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 1; 4008a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 += 0x10000000; 4009a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4010a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4011a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $diff); 4012a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4013a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = hex(substr($addr1,-7)); 4014a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr1 = substr($addr1,0,-7); 4015a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = hex(substr($addr2,-7)) + $b; 4016a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2 = substr($addr2,0,-7); 4017a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 0; 4018a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { 4019a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $b = 1; 4020a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 += 0x10000000; 4021a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4022a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4023a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $diff) . $r; 4024a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4025a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = hex($addr1); 4026a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a2 = hex($addr2) + $b; 4027a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($a2 > $a1) { $a1 += 0x100; } 4028a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $diff = $a1 - $a2; 4029a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $diff) . $r; 4030a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4031a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4032a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4033a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4034a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4035a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4036a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4037a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Increment a hex addresses of length $address_length. 4038a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run pprof --test for unit test if this is changed. 4039a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressInc { 4040a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr = shift; 4041a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum; 4042a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4043a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($address_length == 8) { 4044a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Perl doesn't cope with wraparound arithmetic, so do it explicitly: 4045a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = (hex($addr)+1) % (0x10000000 * 16); 4046a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return sprintf("%08x", $sum); 4047a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4048a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4049a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Do the addition in 7-nibble chunks to trivialize carry handling. 4050a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We are always doing this to step through the addresses in a function, 4051a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # and will almost never overflow the first chunk, so we check for this 4052a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # case and exit early. 4053a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4054a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "AddressInc $addr1 = "; } 4055a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4056a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $a1 = substr($addr,-7); 4057a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = substr($addr,0,-7); 4058a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + 1; 4059a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $r = sprintf("%07x", $sum); 4060a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum <= 0xfffffff) { 4061a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = $addr . $r; 4062a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4063a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return HexExtend($r); 4064a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4065a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = "0000000"; 4066a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4067a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4068a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $a1 = substr($addr,-7); 4069a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr = substr($addr,0,-7); 4070a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($a1) + 1; 4071a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%07x", $sum) . $r; 4072a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum <= 0xfffffff) { 4073a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = $addr . $r; 4074a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4075a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return HexExtend($r); 4076a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4077a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = "00000000000000"; 4078a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4079a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4080a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sum = hex($addr) + 1; 4081a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum > 0xff) { $sum -= 0x100; } 4082a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $r = sprintf("%02x", $sum) . $r; 4083a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4084a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # if ($main::opt_debug) { print STDERR "$r\n"; } 4085a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $r; 4086a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4087a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4088a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4089a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Extract symbols for all PC values found in profile 4090a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ExtractSymbols { 4091a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libs = shift; 4092a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcset = shift; 4093a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4094a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = {}; 4095a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4096d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # Map each PC value to the containing library. To make this faster, 4097d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # we sort libraries by their starting pc value (highest first), and 4098d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # advance through the libraries as we advance the pc. Sometimes the 4099d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # addresses of libraries may overlap with the addresses of the main 4100d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # binary, so to make sure the libraries 'win', we iterate over the 4101d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # libraries in reverse order (binary will have the lowest start addr). 4102ec5344eba282b2bc2f854bdb174e3c97abff83c9Jason Evans my @pcs = (sort { $a cmp $b } keys(%{$pcset})); 4103d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $lib (sort {$b->[1] cmp $a->[1]} @{$libs}) { 4104a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $libname = $lib->[0]; 4105a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start = $lib->[1]; 4106a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $finish = $lib->[2]; 4107a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = $lib->[3]; 4108a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4109a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get list of pcs that belong in this library. 4110a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $contained = []; 4111d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my ($start_pc_index, $finish_pc_index); 4112d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; 4113d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $finish_pc_index--) { 4114d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last if $pcs[$finish_pc_index - 1] le $finish; 41155fe764f83f03d30e0bc3582c2967e3b7cb92cf3cJason Evans } 4116d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; 4117d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $start_pc_index--) { 4118d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last if $pcs[$start_pc_index - 1] lt $start; 4119a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4120d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans @{$contained} = splice(@pcs, $start_pc_index, 4121d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $finish_pc_index - $start_pc_index); 4122a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Map to symbols 4123a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); 4124a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4125a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4126a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbols; 4127a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4128a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4129a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Map list of PC values to symbols for a given image 4130a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MapToSymbols { 4131a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 4132a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 4133a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pclist = shift; 4134a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 4135a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4136a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $debug = 0; 4137a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4138a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Ignore empty binaries 4139a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#{$pclist} < 0) { return; } 4140a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4141a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Figure out the addr2line command to use 4142a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $addr2line = $obj_tool_map{"addr2line"}; 4143a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cmd = "$addr2line -f -C -e $image"; 4144a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $obj_tool_map{"addr2line_pdb"}) { 4145a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $addr2line = $obj_tool_map{"addr2line_pdb"}; 4146a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd = "$addr2line --demangle -f -C -e $image"; 4147a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4148a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4149a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If "addr2line" isn't installed on the system at all, just use 4150a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # nm to get what info we can (function names, but not line numbers). 4151d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (system("$addr2line --help >/dev/null 2>&1") != 0) { 4152a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapSymbolsWithNM($image, $offset, $pclist, $symbols); 4153a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return; 4154a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4155a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4156a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # "addr2line -i" can produce a variable number of lines per input 4157a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # address, with no separator that allows us to tell when data for 4158a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the next address starts. So we find the address for a special 4159a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # symbol (_fini) and interleave this address between all real 4160a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addresses passed to addr2line. The name of this special symbol 4161a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # can then be used as a separator. 4162a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = undef; # May be filled in by MapSymbolsWithNM() 4163a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm_symbols = {}; 4164a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); 4165a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(csilvers): only add '-i' if addr2line supports it. 4166a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address)) { 4167a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Only add " -i" to addr2line if the binary supports it. 4168a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr2line --help returns 0, but not if it sees an unknown flag first. 4169a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (system("$cmd -i --help >/dev/null 2>&1") == 0) { 4170a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cmd .= " -i"; 4171a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4172a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = undef; # no need for sep_address if we don't support -i 4173a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4174a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4175a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4176a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Make file with all PC values with intervening 'sep_address' so 4177a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that we can reliably detect the end of inlined function list 4178a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); 4179a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { print("---- $image ---\n"); } 4180a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans for (my $i = 0; $i <= $#{$pclist}; $i++) { 4181a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # addr2line always reads hex addresses, and does not need '0x' prefix. 4182a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); } 4183a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset)); 4184a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address)) { 4185a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf ADDRESSES ("%s\n", $sep_address); 4186a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4187a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4188a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(ADDRESSES); 4189a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { 4190a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 4191a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans system("cat $main::tmpfile_sym"); 4192a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 4193a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans system("$cmd <$main::tmpfile_sym"); 4194a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print("----\n"); 4195a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4196a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4197a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(SYMBOLS, "$cmd <$main::tmpfile_sym |") || error("$cmd: $!\n"); 4198a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $count = 0; # Index in pclist 4199a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<SYMBOLS>) { 4200a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Read fullfunction and filelineinfo from next pair of lines 4201a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r?\n$//g; 4202a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullfunction = $_; 4203a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $_ = <SYMBOLS>; 4204a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r?\n$//g; 4205a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $filelinenum = $_; 4206a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4207a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($sep_address) && $fullfunction eq $sep_symbol) { 4208a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Terminating marker for data for this address 4209a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count++; 4210a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4211a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4212a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4213a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths 4214a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4215a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = $pclist->[$count]; 4216a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $function = ShortFunctionName($fullfunction); 4217a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($fullfunction eq '??') { 4218a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # See if nm found a symbol 4219a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nms = $nm_symbols->{$pcstr}; 4220a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($nms)) { 4221a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $function = $nms->[0]; 4222a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullfunction = $nms->[2]; 4223a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4224a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4225a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4226a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Prepend to accumulated symbols for pcstr 4227a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # (so that caller comes before callee) 4228a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sym = $symbols->{$pcstr}; 4229a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($sym)) { 4230a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sym = []; 4231a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pcstr} = $sym; 4232a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4233a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unshift(@{$sym}, $function, $filelinenum, $fullfunction); 4234a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } 4235a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!defined($sep_address)) { 4236a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Inlining is off, se this entry ends immediately 4237a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $count++; 4238a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4239a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4240a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(SYMBOLS); 4241a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4242a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4243a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Use nm to map the list of referenced PCs to symbols. Return true iff we 4244a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# are able to read procedure information via nm. 4245a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub MapSymbolsWithNM { 4246a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 4247a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $offset = shift; 4248a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pclist = shift; 4249a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbols = shift; 4250a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4251a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Get nm output sorted by increasing address 4252a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundaries($image, "."); 4253a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (!%{$symbol_table}) { 4254a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 4255a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4256a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Start addresses are already the right length (8 or 16 hex digits). 4257a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @names = sort { $symbol_table->{$a}->[0] cmp $symbol_table->{$b}->[0] } 4258a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans keys(%{$symbol_table}); 4259a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4260a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($#names < 0) { 4261a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # No symbols: just use addresses 4262a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (@{$pclist}) { 4263a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = "0x" . $pc; 4264a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$pcstr, "?", $pcstr]; 4265a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4266a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 0; 4267a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4268a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4269a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Sort addresses so we can do a join against nm output 4270a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $index = 0; 4271a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fullname = $names[0]; 4272a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $name = ShortFunctionName($fullname); 4273a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $pc (sort { $a cmp $b } @{$pclist}) { 4274a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Adjust for mapped offset 4275a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $mpc = AddressSub($pc, $offset); 4276a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (($index < $#names) && ($mpc ge $symbol_table->{$fullname}->[1])){ 4277a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $index++; 4278a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fullname = $names[$index]; 4279a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $name = ShortFunctionName($fullname); 4280a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4281a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($mpc lt $symbol_table->{$fullname}->[1]) { 4282a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$name, "?", $fullname]; 4283a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4284a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pcstr = "0x" . $pc; 4285a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbols->{$pc} = [$pcstr, "?", $pcstr]; 4286a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4287a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4288a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return 1; 4289a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4290a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4291a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ShortFunctionName { 4292a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $function = shift; 4293a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types 4294a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments 4295a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type 4296a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $function; 4297a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4298a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4299a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans##### Miscellaneous ##### 4300a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4301a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Find the right versions of the above object tools to use. The 4302a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# argument is the program file being analyzed, and should be an ELF 4303a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 32-bit or ELF 64-bit executable file. The location of the tools 4304a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# is determined by considering the following options in this order: 4305a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 1) --tools option, if set 4306a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 2) PPROF_TOOLS environment variable, if set 4307a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# 3) the environment 4308a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ConfigureObjTools { 4309a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $prog_file = shift; 4310a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4311a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Check for the existence of $prog_file because /usr/bin/file does not 4312a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # predictably return error status in prod. 4313a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans (-e $prog_file) || error("$prog_file does not exist.\n"); 4314a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4315a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Follow symlinks (at least for systems where "file" supports that) 4316a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $file_type = `/usr/bin/file -L $prog_file 2>/dev/null || /usr/bin/file $prog_file`; 4317a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /64-bit/) { 4318a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Change $address_length to 16 if the program file is ELF 64-bit. 4319a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We can't detect this from many (most?) heap or lock contention 4320a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # profiles, since the actual addresses referenced are generally in low 4321a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # memory even for 64-bit programs. 4322a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 4323a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4324a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4325a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /MS Windows/) { 4326a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For windows, we provide a version of nm and addr2line as part of 4327a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # the opensource release, which is capable of parsing 4328a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Windows-style PDB executables. It should live in the path, or 4329a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # in the same directory as pprof. 4330a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"nm_pdb"} = "nm-pdb"; 4331a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"addr2line_pdb"} = "addr2line-pdb"; 4332a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4333a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4334a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($file_type =~ /Mach-O/) { 4335a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # OS X uses otool to examine Mach-O files, rather than objdump. 4336a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{"otool"} = "otool"; 4337d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $obj_tool_map{"addr2line"} = "false"; # no addr2line 4338d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $obj_tool_map{"objdump"} = "false"; # no objdump 4339a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4340a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4341a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Go fill in %obj_tool_map with the pathnames to use: 4342a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $tool (keys %obj_tool_map) { 4343a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $obj_tool_map{$tool} = ConfigureTool($obj_tool_map{$tool}); 4344a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4345a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4346a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4347a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Returns the path of a caller-specified object tool. If --tools or 4348a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# PPROF_TOOLS are specified, then returns the full path to the tool 4349a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# with that prefix. Otherwise, returns the path unmodified (which 4350a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# means we will look for it on PATH). 4351a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub ConfigureTool { 4352a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $tool = shift; 4353a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $path; 4354a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4355d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # --tools (or $PPROF_TOOLS) is a comma separated list, where each 4356d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # item is either a) a pathname prefix, or b) a map of the form 4357d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # <tool>:<path>. First we look for an entry of type (b) for our 4358d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # tool. If one is found, we use it. Otherwise, we consider all the 4359d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # pathname prefixes in turn, until one yields an existing file. If 4360d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # none does, we use a default path. 4361d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans my $tools = $main::opt_tools || $ENV{"PPROF_TOOLS"} || ""; 4362d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if ($tools =~ m/(,|^)\Q$tool\E:([^,]*)/) { 4363d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $path = $2; 4364d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # TODO(csilvers): sanity-check that $path exists? Hard if it's relative. 4365d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } elsif ($tools ne '') { 4366d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans foreach my $prefix (split(',', $tools)) { 4367d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans next if ($prefix =~ /:/); # ignore "tool:fullpath" entries in the list 4368d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (-x $prefix . $tool) { 4369d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans $path = $prefix . $tool; 4370d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans last; 4371d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans } 4372a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4373d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (!$path) { 4374d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans error("No '$tool' found with prefix specified by " . 4375d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "--tools (or \$PPROF_TOOLS) '$tools'\n"); 4376a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4377a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4378a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # ... otherwise use the version that exists in the same directory as 4379a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # pprof. If there's nothing there, use $PATH. 4380a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $0 =~ m,[^/]*$,; # this is everything after the last slash 4381a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $dirname = $`; # this is everything up to and including the last slash 4382a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (-x "$dirname$tool") { 4383a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = "$dirname$tool"; 4384a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4385a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $path = $tool; 4386a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4387a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4388a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; } 4389a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $path; 4390a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4391a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4392a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub cleanup { 4393a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans unlink($main::tmpfile_sym); 4394d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans unlink(keys %main::tempnames); 4395d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 4396a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We leave any collected profiles in $HOME/pprof in case the user wants 4397a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to look at them later. We print a message informing them of this. 4398a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ((scalar(@main::profile_files) > 0) && 4399a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans defined($main::collected_profile)) { 4400a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (scalar(@main::profile_files) == 1) { 4401a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "Dynamically gathered profile is in $main::collected_profile\n"; 4402a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4403a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "If you want to investigate this profile further, you can do:\n"; 4404a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 4405a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " pprof \\\n"; 4406a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " $main::prog \\\n"; 4407a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR " $main::collected_profile\n"; 4408a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "\n"; 4409a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4410a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4411a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4412a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub sighandler { 4413a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 4414a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 4415a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4416a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4417a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub error { 4418a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $msg = shift; 4419a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR $msg; 4420a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans cleanup(); 4421a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit(1); 4422a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4423a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4424a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4425a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Run $nm_command and get all the resulting procedure boundaries whose 4426a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# names match "$regexp" and returns them in a hashtable mapping from 4427a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# procedure name to a two-element vector of [start address, end address] 4428a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetProcedureBoundariesViaNm { 4429a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm_command = shift; 4430a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $regexp = shift; 4431a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4432a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = {}; 4433a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans open(NM, "$nm_command |") || error("$nm_command: $!\n"); 4434a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $last_start = "0"; 4435a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $routine = ""; 4436a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans while (<NM>) { 4437a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans s/\r//g; # turn windows-looking lines into unix-looking lines 4438d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans if (m/^\s*([0-9a-f]+) (.) (..*)/) { 4439a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $start_val = $1; 4440a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $type = $2; 4441a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $this_routine = $3; 4442a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4443a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # It's possible for two symbols to share the same address, if 4444a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one is a zero-length variable (like __start_google_malloc) or 4445a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one symbol is a weak alias to another (like __libc_malloc). 4446a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In such cases, we want to ignore all values except for the 4447a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # actual symbol, which in nm-speak has type "T". The logic 4448a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # below does this, though it's a bit tricky: what happens when 4449a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we have a series of lines with the same address, is the first 4450a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # one gets queued up to be processed. However, it won't 4451a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # *actually* be processed until later, when we read a line with 4452a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # a different address. That means that as long as we're reading 4453a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # lines with the same address, we have a chance to replace that 4454a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # item in the queue, which we do whenever we see a 'T' entry -- 4455a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that is, a line with type 'T'. If we never see a 'T' entry, 4456a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we'll just go ahead and process the first entry (which never 4457a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # got touched in the queue), and ignore the others. 4458a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($start_val eq $last_start && $type =~ /t/i) { 4459a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We are the 'T' symbol at this address, replace previous symbol. 4460a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine = $this_routine; 4461a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4462a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif ($start_val eq $last_start) { 4463a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # We're not the 'T' symbol at this address, so ignore us. 4464a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans next; 4465a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4466a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4467a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($this_routine eq $sep_symbol) { 4468a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $sep_address = HexExtend($start_val); 4469a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4470a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4471a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Tag this routine with the starting address in case the image 4472a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # has multiple occurrences of this routine. We use a syntax 4473a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # that resembles template paramters that are automatically 4474a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # stripped out by ShortFunctionName() 4475a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $this_routine .= "<$start_val>"; 4476a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4477a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($routine) && $routine =~ m/$regexp/) { 4478a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_table->{$routine} = [HexExtend($last_start), 4479a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans HexExtend($start_val)]; 4480a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4481a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $last_start = $start_val; 4482a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $routine = $this_routine; 4483a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^Loaded image name: (.+)/) { 4484a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The win32 nm workalike emits information about the binary it is using. 4485a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using Image $1\n"; } 4486a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (m/^PDB file name: (.+)/) { 4487a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The win32 nm workalike emits information about the pdb it is using. 4488a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug) { print STDERR "Using PDB $1\n"; } 4489a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4490a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4491a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans close(NM); 4492a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Handle the last line in the nm output. Unfortunately, we don't know 4493a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # how big this last symbol is, because we don't know how big the file 4494a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # is. For now, we just give it a size of 0. 4495a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # TODO(csilvers): do better here. 4496a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (defined($routine) && $routine =~ m/$regexp/) { 4497a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $symbol_table->{$routine} = [HexExtend($last_start), 4498a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans HexExtend($last_start)]; 4499a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4500a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table; 4501a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4502a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4503a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Gets the procedure boundaries for all routines in "$image" whose names 4504a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# match "$regexp" and returns them in a hashtable mapping from procedure 4505a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# name to a two-element vector of [start address, end address]. 4506a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Will return an empty map if nm is not installed or not working properly. 4507a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub GetProcedureBoundaries { 4508a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $image = shift; 4509a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $regexp = shift; 4510a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4511a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # For libc libraries, the copy in /usr/lib/debug contains debugging symbols 4512a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $debugging = DebuggingLibrary($image); 4513a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($debugging) { 4514a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $image = $debugging; 4515a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4516a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4517a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm = $obj_tool_map{"nm"}; 4518a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cppfilt = $obj_tool_map{"c++filt"}; 4519a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4520a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm 4521a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # binary doesn't support --demangle. In addition, for OS X we need 4522a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # to use the -f flag to get 'flat' nm output (otherwise we don't sort 4523a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # properly and get incorrect results). Unfortunately, GNU nm uses -f 4524a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # in an incompatible way. So first we test whether our nm supports 4525a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # --demangle and -f. 4526a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $demangle_flag = ""; 4527a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $cppfilt_flag = ""; 4528a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (system("$nm --demangle $image >/dev/null 2>&1") == 0) { 4529a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this mode, we do "nm --demangle <foo>" 4530a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $demangle_flag = "--demangle"; 4531a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cppfilt_flag = ""; 4532a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } elsif (system("$cppfilt $image >/dev/null 2>&1") == 0) { 4533a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # In this mode, we do "nm <foo> | c++filt" 4534a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $cppfilt_flag = " | $cppfilt"; 4535a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans }; 4536a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $flatten_flag = ""; 4537a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (system("$nm -f $image >/dev/null 2>&1") == 0) { 4538a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $flatten_flag = "-f"; 4539a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4540a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4541a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Finally, in the case $imagie isn't a debug library, we try again with 4542a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # -D to at least get *exported* symbols. If we can't use --demangle, 4543a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # we use c++filt instead, if it exists on this system. 4544a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" . 4545a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans " $image 2>/dev/null $cppfilt_flag", 4546a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans "$nm -D -n $flatten_flag $demangle_flag" . 4547d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans " $image 2>/dev/null $cppfilt_flag", 4548d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans # 6nm is for Go binaries 4549d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans "6nm $image 2>/dev/null | sort", 4550d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans ); 4551d65cdfe23310253f065bea02ba8e0016dc9b6aeeJason Evans 4552a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # If the executable is an MS Windows PDB-format executable, we'll 4553a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # have set up obj_tool_map("nm_pdb"). In this case, we actually 4554a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # want to use both unix nm and windows-specific nm_pdb, since 4555a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # PDB-format executables can apparently include dwarf .o files. 4556a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if (exists $obj_tool_map{"nm_pdb"}) { 4557a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $nm_pdb = $obj_tool_map{"nm_pdb"}; 4558a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans push(@nm_commands, "$nm_pdb --demangle $image 2>/dev/null"); 4559a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4560a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4561a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $nm_command (@nm_commands) { 4562a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); 4563a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table if (%{$symbol_table}); 4564a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4565a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $symbol_table = {}; 4566a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $symbol_table; 4567a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4568a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4569a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4570a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# The test vectors for AddressAdd/Sub/Inc are 8-16-nibble hex strings. 4571a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# To make them more readable, we add underscores at interesting places. 4572a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# This routine removes the underscores, producing the canonical representation 4573a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# used by pprof to represent addresses, particularly in the tested routines. 4574a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub CanonicalHex { 4575a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $arg = shift; 4576a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return join '', (split '_',$arg); 4577a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4578a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4579a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4580a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressAdd: 4581a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressAddUnitTest { 4582a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 4583a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 4584a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 4585a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 4586a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 4587a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressAddUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 4588a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4589a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 4590a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 4591a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 4592a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 4593a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 4594a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4595a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressAdd ($row->[0], $row->[1]); 4596a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[2]) { 4597a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + %s = %s\n", $sum, 4598a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[2]; 4599a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4600a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4601a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4602a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4603a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4604a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressAdd 32-bit tests: %d passes, %d failures\n", 4605a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4606a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 4607a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 4608a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 4609a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4610a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 4611a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 4612a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 4613a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4614a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressAdd (CanonicalHex($row->[0]), CanonicalHex($row->[1])); 4615a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $expected = join '', (split '_',$row->[2]); 4616a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[2])) { 4617a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + %s = %s\n", $sum, 4618a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[2]; 4619a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4620a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4621a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4622a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4623a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4624a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressAdd 64-bit tests: %d passes, %d failures\n", 4625a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4626a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 4627a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4628a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 4629a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4630a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4631a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4632a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressSub: 4633a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressSubUnitTest { 4634a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 4635a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 4636a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 4637a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 4638a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 4639a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressSubUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 4640a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4641a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 4642a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 4643a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 4644a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 4645a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 4646a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4647a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressSub ($row->[0], $row->[1]); 4648a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[3]) { 4649a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s - %s = %s\n", $sum, 4650a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[3]; 4651a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4652a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4653a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4654a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4655a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4656a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressSub 32-bit tests: %d passes, %d failures\n", 4657a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4658a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 4659a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 4660a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 4661a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4662a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 4663a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 4664a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 4665a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4666a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressSub (CanonicalHex($row->[0]), CanonicalHex($row->[1])); 4667a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[3])) { 4668a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s - %s = %s\n", $sum, 4669a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[1], $row->[3]; 4670a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4671a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4672a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4673a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4674a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4675a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressSub 64-bit tests: %d passes, %d failures\n", 4676a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4677a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 4678a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4679a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 4680a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4681a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4682a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4683a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Unit test for AddressInc: 4684a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub AddressIncUnitTest { 4685a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_8 = shift; 4686a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $test_data_16 = shift; 4687a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 4688a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $fail_count = 0; 4689a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $pass_count = 0; 4690a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # print STDERR "AddressIncUnitTest: ", 1+$#{$test_data_8}, " tests\n"; 4691a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4692a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # First a few 8-nibble addresses. Note that this implementation uses 4693a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # plain old arithmetic, so a quick sanity check along with verifying what 4694a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # happens to overflow (we want it to wrap): 4695a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 8; 4696a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_8}) { 4697a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4698a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressInc ($row->[0]); 4699a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne $row->[4]) { 4700a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum, 4701a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[4]; 4702a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4703a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4704a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4705a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4706a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4707a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressInc 32-bit tests: %d passes, %d failures\n", 4708a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4709a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count = $fail_count; 4710a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $fail_count = 0; 4711a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count = 0; 4712a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4713a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # Now 16-nibble addresses. 4714a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $address_length = 16; 4715a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans foreach my $row (@{$test_data_16}) { 4716a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; } 4717a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $sum = AddressInc (CanonicalHex($row->[0])); 4718a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($sum ne CanonicalHex($row->[4])) { 4719a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum, 4720a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $row->[0], $row->[4]; 4721a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$fail_count; 4722a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4723a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ++$pass_count; 4724a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4725a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4726a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans printf STDERR "AddressInc 64-bit tests: %d passes, %d failures\n", 4727a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $pass_count, $fail_count; 4728a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += $fail_count; 4729a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4730a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans return $error_count; 4731a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4732a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4733a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4734a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Driver for unit tests. 4735a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans# Currently just the address add/subtract/increment routines for 64-bit. 4736a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evanssub RunUnitTests { 4737a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $error_count = 0; 4738a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4739a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # This is a list of tuples [a, b, a+b, a-b, a+1] 4740a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $unit_test_data_8 = [ 4741a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(aaaaaaaa 50505050 fafafafa 5a5a5a5a aaaaaaab)], 4742a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(50505050 aaaaaaaa fafafafa a5a5a5a6 50505051)], 4743a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(ffffffff aaaaaaaa aaaaaaa9 55555555 00000000)], 4744a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 ffffffff 00000000 00000002 00000002)], 4745a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 fffffff0 fffffff1 00000011 00000002)], 4746a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ]; 4747a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans my $unit_test_data_16 = [ 4748a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # The implementation handles data in 7-nibble chunks, so those are the 4749a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans # interesting boundaries. 4750a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(aaaaaaaa 50505050 4751a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_afafafa 00_0000005_a5a5a5a 00_000000a_aaaaaab)], 4752a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(50505050 aaaaaaaa 4753a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_afafafa ff_ffffffa_5a5a5a6 00_0000005_0505051)], 4754a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(ffffffff aaaaaaaa 4755a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000001a_aaaaaa9 00_0000005_5555555 00_0000010_0000000)], 4756a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 ffffffff 4757a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_0000010_0000000 ff_ffffff0_0000002 00_0000000_0000002)], 4758a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00000001 fffffff0 4759a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_000000f_ffffff1 ff_ffffff0_0000011 00_0000000_0000002)], 4760a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4761a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_a00000a_aaaaaaa 50505050 4762a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_a00000f_afafafa 00_a000005_a5a5a5a 00_a00000a_aaaaaab)], 4763a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(0f_fff0005_0505050 aaaaaaaa 4764a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 0f_fff000f_afafafa 0f_ffefffa_5a5a5a6 0f_fff0005_0505051)], 4765a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_000000f_fffffff 01_800000a_aaaaaaa 4766a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 01_800001a_aaaaaa9 fe_8000005_5555555 00_0000010_0000000)], 4767a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_0000000_0000001 ff_fffffff_fffffff 4768a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 00_0000000_0000000 00_0000000_0000002 00_0000000_0000002)], 4769a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans [qw(00_0000000_0000001 ff_fffffff_ffffff0 4770a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ff_fffffff_ffffff1 00_0000000_0000011 00_0000000_0000002)], 4771a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans ]; 4772a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans 4773a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); 4774a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); 4775a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); 4776a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans if ($error_count > 0) { 4777a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR $error_count, " errors: FAILED\n"; 4778a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } else { 4779a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans print STDERR "PASS\n"; 4780a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans } 4781a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans exit ($error_count); 4782a91f2109292f4f4522f75d0636fdba30bda26e76Jason Evans} 4783