OLD | NEW |
1 #! /usr/bin/env perl | 1 #! /usr/bin/env perl |
2 | 2 |
3 # Copyright (c) 1998-2007, Google Inc. | 3 # Copyright (c) 1998-2007, Google Inc. |
4 # All rights reserved. | 4 # All rights reserved. |
5 # | 5 # |
6 # Redistribution and use in source and binary forms, with or without | 6 # Redistribution and use in source and binary forms, with or without |
7 # modification, are permitted provided that the following conditions are | 7 # modification, are permitted provided that the following conditions are |
8 # met: | 8 # met: |
9 # | 9 # |
10 # * Redistributions of source code must retain the above copyright | 10 # * Redistributions of source code must retain the above copyright |
(...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
65 # Generates disassembly listing of all routines with at least one | 65 # Generates disassembly listing of all routines with at least one |
66 # sample that match the --disasm=<regexp> pattern. The listing is | 66 # sample that match the --disasm=<regexp> pattern. The listing is |
67 # annotated with the flat and cumulative sample counts at each PC value. | 67 # annotated with the flat and cumulative sample counts at each PC value. |
68 # | 68 # |
69 # TODO: Use color to indicate files? | 69 # TODO: Use color to indicate files? |
70 | 70 |
71 use strict; | 71 use strict; |
72 use warnings; | 72 use warnings; |
73 use Getopt::Long; | 73 use Getopt::Long; |
74 | 74 |
75 my $PPROF_VERSION = "1.5"; | 75 my $PPROF_VERSION = "1.7"; |
76 | 76 |
77 # These are the object tools we use which can come from a | 77 # These are the object tools we use which can come from a |
78 # user-specified location using --tools, from the PPROF_TOOLS | 78 # user-specified location using --tools, from the PPROF_TOOLS |
79 # environment variable, or from the environment. | 79 # environment variable, or from the environment. |
80 my %obj_tool_map = ( | 80 my %obj_tool_map = ( |
81 "objdump" => "objdump", | 81 "objdump" => "objdump", |
82 "nm" => "nm", | 82 "nm" => "nm", |
83 "addr2line" => "addr2line", | 83 "addr2line" => "addr2line", |
84 "c++filt" => "c++filt", | 84 "c++filt" => "c++filt", |
85 ## ConfigureObjTools may add architecture-specific entries: | 85 ## ConfigureObjTools may add architecture-specific entries: |
86 #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables | 86 #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables |
87 #"addr2line_pdb" => "addr2line-pdb", # ditto | 87 #"addr2line_pdb" => "addr2line-pdb", # ditto |
88 #"otool" => "otool", # equivalent of objdump on OS X | 88 #"otool" => "otool", # equivalent of objdump on OS X |
89 ); | 89 ); |
90 my $DOT = "dot"; # leave non-absolute, since it may be in /usr/local | 90 my $DOT = "dot"; # leave non-absolute, since it may be in /usr/local |
91 my $GV = "gv"; | 91 my $GV = "gv"; |
| 92 my $EVINCE = "evince"; # could also be xpdf or perhaps acroread |
92 my $KCACHEGRIND = "kcachegrind"; | 93 my $KCACHEGRIND = "kcachegrind"; |
93 my $PS2PDF = "ps2pdf"; | 94 my $PS2PDF = "ps2pdf"; |
94 # These are used for dynamic profiles | 95 # These are used for dynamic profiles |
95 my $URL_FETCHER = "curl -s"; | 96 my $URL_FETCHER = "curl -s"; |
96 | 97 |
97 # These are the web pages that servers need to support for dynamic profiles | 98 # These are the web pages that servers need to support for dynamic profiles |
98 my $HEAP_PAGE = "/pprof/heap"; | 99 my $HEAP_PAGE = "/pprof/heap"; |
99 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" | 100 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" |
100 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param | 101 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param |
101 # ?seconds=#&event=x&period=n | 102 # ?seconds=#&event=x&period=n |
102 my $GROWTH_PAGE = "/pprof/growth"; | 103 my $GROWTH_PAGE = "/pprof/growth"; |
103 my $CONTENTION_PAGE = "/pprof/contention"; | 104 my $CONTENTION_PAGE = "/pprof/contention"; |
104 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter | 105 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter |
105 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; | 106 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; |
| 107 my $CENSUSPROFILE_PAGE = "/pprof/censusprofile"; # must support "?seconds=#" |
106 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST | 108 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST |
107 my $PROGRAM_NAME_PAGE = "/pprof/cmdline"; | 109 my $PROGRAM_NAME_PAGE = "/pprof/cmdline"; |
108 | 110 |
| 111 # These are the web pages that can be named on the command line. |
| 112 # All the alternatives must begin with /. |
| 113 my $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" . |
| 114 "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" . |
| 115 "$FILTEREDPROFILE_PAGE|$CENSUSPROFILE_PAGE)"; |
| 116 |
109 # default binary name | 117 # default binary name |
110 my $UNKNOWN_BINARY = "(unknown)"; | 118 my $UNKNOWN_BINARY = "(unknown)"; |
111 | 119 |
112 # There is a pervasive dependency on the length (in hex characters, | 120 # There is a pervasive dependency on the length (in hex characters, |
113 # i.e., nibbles) of an address, distinguishing between 32-bit and | 121 # i.e., nibbles) of an address, distinguishing between 32-bit and |
114 # 64-bit profiles. To err on the safe size, default to 64-bit here: | 122 # 64-bit profiles. To err on the safe size, default to 64-bit here: |
115 my $address_length = 16; | 123 my $address_length = 16; |
116 | 124 |
| 125 my $dev_null = "/dev/null"; |
| 126 if (! -e $dev_null && $^O =~ /MSWin/) { # $^O is the OS perl was built for |
| 127 $dev_null = "nul"; |
| 128 } |
| 129 |
117 # A list of paths to search for shared object files | 130 # A list of paths to search for shared object files |
118 my @prefix_list = (); | 131 my @prefix_list = (); |
119 | 132 |
120 # Special routine name that should not have any symbols. | 133 # Special routine name that should not have any symbols. |
121 # Used as separator to parse "addr2line -i" output. | 134 # Used as separator to parse "addr2line -i" output. |
122 my $sep_symbol = '_fini'; | 135 my $sep_symbol = '_fini'; |
123 my $sep_address = undef; | 136 my $sep_address = undef; |
124 | 137 |
125 ##### Argument parsing ##### | 138 ##### Argument parsing ##### |
126 | 139 |
127 sub usage_string { | 140 sub usage_string { |
128 return <<EOF; | 141 return <<EOF; |
129 Usage: | 142 Usage: |
130 pprof [options] <program> <profiles> | 143 pprof [options] <program> <profiles> |
131 <profiles> is a space separated list of profile names. | 144 <profiles> is a space separated list of profile names. |
132 pprof [options] <symbolized-profiles> | 145 pprof [options] <symbolized-profiles> |
133 <symbolized-profiles> is a list of profile files where each file contains | 146 <symbolized-profiles> is a list of profile files where each file contains |
134 the necessary symbol mappings as well as profile data (likely generated | 147 the necessary symbol mappings as well as profile data (likely generated |
135 with --raw). | 148 with --raw). |
136 pprof [options] <profile> | 149 pprof [options] <profile> |
137 <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE | 150 <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE |
138 | 151 |
139 Each name can be: | 152 Each name can be: |
140 /path/to/profile - a path to a profile file | 153 /path/to/profile - a path to a profile file |
141 host:port[/<service>] - a location of a service to get profile from | 154 host:port[/<service>] - a location of a service to get profile from |
142 | 155 |
143 The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, | 156 The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile, |
144 $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, | 157 $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall, |
145 or /pprof/filteredprofile. | 158 $CENSUSPROFILE_PAGE, or /pprof/filteredprofile. |
146 For instance: "pprof http://myserver.com:80$HEAP_PAGE". | 159 For instance: "pprof http://myserver.com:80$HEAP_PAGE". |
147 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin
g). | 160 If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profilin
g). |
148 pprof --symbols <program> | 161 pprof --symbols <program> |
149 Maps addresses to symbol names. In this mode, stdin should be a | 162 Maps addresses to symbol names. In this mode, stdin should be a |
150 list of library mappings, in the same format as is found in the heap- | 163 list of library mappings, in the same format as is found in the heap- |
151 and cpu-profile files (this loosely matches that of /proc/self/maps | 164 and cpu-profile files (this loosely matches that of /proc/self/maps |
152 on linux), followed by a list of hex addresses to map, one per line. | 165 on linux), followed by a list of hex addresses to map, one per line. |
153 | 166 |
154 For more help with querying remote servers, including how to add the | 167 For more help with querying remote servers, including how to add the |
155 necessary server-side support code, see this filename (or one like it): | 168 necessary server-side support code, see this filename (or one like it): |
(...skipping 11 matching lines...) Expand all Loading... |
167 Reporting Granularity: | 180 Reporting Granularity: |
168 --addresses Report at address level | 181 --addresses Report at address level |
169 --lines Report at source line level | 182 --lines Report at source line level |
170 --functions Report at function level [default] | 183 --functions Report at function level [default] |
171 --files Report at source file level | 184 --files Report at source file level |
172 | 185 |
173 Output type: | 186 Output type: |
174 --text Generate text report | 187 --text Generate text report |
175 --callgrind Generate callgrind format to stdout | 188 --callgrind Generate callgrind format to stdout |
176 --gv Generate Postscript and display | 189 --gv Generate Postscript and display |
| 190 --evince Generate PDF and display |
177 --web Generate SVG and display | 191 --web Generate SVG and display |
178 --list=<regexp> Generate source listing of matching routines | 192 --list=<regexp> Generate source listing of matching routines |
179 --disasm=<regexp> Generate disassembly of matching routines | 193 --disasm=<regexp> Generate disassembly of matching routines |
180 --symbols Print demangled symbol names found at given addresses | 194 --symbols Print demangled symbol names found at given addresses |
181 --dot Generate DOT file to stdout | 195 --dot Generate DOT file to stdout |
182 --ps Generate Postcript to stdout | 196 --ps Generate Postcript to stdout |
183 --pdf Generate PDF to stdout | 197 --pdf Generate PDF to stdout |
184 --svg Generate SVG to stdout | 198 --svg Generate SVG to stdout |
185 --gif Generate GIF to stdout | 199 --gif Generate GIF to stdout |
186 --raw Generate symbolized pprof data (useful with remote fetch) | 200 --raw Generate symbolized pprof data (useful with remote fetch) |
187 | 201 |
188 Heap-Profile Options: | 202 Heap-Profile Options: |
189 --inuse_space Display in-use (mega)bytes [default] | 203 --inuse_space Display in-use (mega)bytes [default] |
190 --inuse_objects Display in-use objects | 204 --inuse_objects Display in-use objects |
191 --alloc_space Display allocated (mega)bytes | 205 --alloc_space Display allocated (mega)bytes |
192 --alloc_objects Display allocated objects | 206 --alloc_objects Display allocated objects |
193 --show_bytes Display space in bytes | 207 --show_bytes Display space in bytes |
194 --drop_negative Ignore negative differences | 208 --drop_negative Ignore negative differences |
195 | 209 |
196 Contention-profile options: | 210 Contention-profile options: |
197 --total_delay Display total delay at each region [default] | 211 --total_delay Display total delay at each region [default] |
198 --contentions Display number of delays at each region | 212 --contentions Display number of delays at each region |
199 --mean_delay Display mean delay at each region | 213 --mean_delay Display mean delay at each region |
200 | 214 |
201 Call-graph Options: | 215 Call-graph Options: |
202 --nodecount=<n> Show at most so many nodes [default=80] | 216 --nodecount=<n> Show at most so many nodes [default=80] |
203 --nodefraction=<f> Hide nodes below <f>*total [default=.005] | 217 --nodefraction=<f> Hide nodes below <f>*total [default=.005] |
204 --edgefraction=<f> Hide edges below <f>*total [default=.001] | 218 --edgefraction=<f> Hide edges below <f>*total [default=.001] |
| 219 --maxdegree=<n> Max incoming/outgoing edges per node [default=8] |
205 --focus=<regexp> Focus on nodes matching <regexp> | 220 --focus=<regexp> Focus on nodes matching <regexp> |
206 --ignore=<regexp> Ignore nodes matching <regexp> | 221 --ignore=<regexp> Ignore nodes matching <regexp> |
207 --scale=<n> Set GV scaling [default=0] | 222 --scale=<n> Set GV scaling [default=0] |
208 --heapcheck Make nodes with non-0 object counts | 223 --heapcheck Make nodes with non-0 object counts |
209 (i.e. direct leak generators) more visible | 224 (i.e. direct leak generators) more visible |
210 | 225 |
211 Miscellaneous: | 226 Miscellaneous: |
212 --tools=<prefix> Prefix for object tool pathnames | 227 --tools=<prefix or binary:fullpath>[,...] \$PATH for object tool pathnames |
213 --test Run unit tests | 228 --test Run unit tests |
214 --help This message | 229 --help This message |
215 --version Version information | 230 --version Version information |
216 | 231 |
217 Environment Variables: | 232 Environment Variables: |
218 PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof | 233 PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof |
219 PPROF_TOOLS Prefix for object tools pathnames | 234 PPROF_TOOLS Prefix for object tools pathnames |
220 | 235 |
221 Examples: | 236 Examples: |
222 | 237 |
(...skipping 68 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
291 $main::opt_functions = 0; | 306 $main::opt_functions = 0; |
292 $main::opt_files = 0; | 307 $main::opt_files = 0; |
293 $main::opt_lib_prefix = ""; | 308 $main::opt_lib_prefix = ""; |
294 | 309 |
295 $main::opt_text = 0; | 310 $main::opt_text = 0; |
296 $main::opt_callgrind = 0; | 311 $main::opt_callgrind = 0; |
297 $main::opt_list = ""; | 312 $main::opt_list = ""; |
298 $main::opt_disasm = ""; | 313 $main::opt_disasm = ""; |
299 $main::opt_symbols = 0; | 314 $main::opt_symbols = 0; |
300 $main::opt_gv = 0; | 315 $main::opt_gv = 0; |
| 316 $main::opt_evince = 0; |
301 $main::opt_web = 0; | 317 $main::opt_web = 0; |
302 $main::opt_dot = 0; | 318 $main::opt_dot = 0; |
303 $main::opt_ps = 0; | 319 $main::opt_ps = 0; |
304 $main::opt_pdf = 0; | 320 $main::opt_pdf = 0; |
305 $main::opt_gif = 0; | 321 $main::opt_gif = 0; |
306 $main::opt_svg = 0; | 322 $main::opt_svg = 0; |
307 $main::opt_raw = 0; | 323 $main::opt_raw = 0; |
308 | 324 |
309 $main::opt_nodecount = 80; | 325 $main::opt_nodecount = 80; |
310 $main::opt_nodefraction = 0.005; | 326 $main::opt_nodefraction = 0.005; |
311 $main::opt_edgefraction = 0.001; | 327 $main::opt_edgefraction = 0.001; |
| 328 $main::opt_maxdegree = 8; |
312 $main::opt_focus = ''; | 329 $main::opt_focus = ''; |
313 $main::opt_ignore = ''; | 330 $main::opt_ignore = ''; |
314 $main::opt_scale = 0; | 331 $main::opt_scale = 0; |
315 $main::opt_heapcheck = 0; | 332 $main::opt_heapcheck = 0; |
316 $main::opt_seconds = 30; | 333 $main::opt_seconds = 30; |
317 $main::opt_lib = ""; | 334 $main::opt_lib = ""; |
318 | 335 |
319 $main::opt_inuse_space = 0; | 336 $main::opt_inuse_space = 0; |
320 $main::opt_inuse_objects = 0; | 337 $main::opt_inuse_objects = 0; |
321 $main::opt_alloc_space = 0; | 338 $main::opt_alloc_space = 0; |
(...skipping 37 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
359 "functions!" => \$main::opt_functions, | 376 "functions!" => \$main::opt_functions, |
360 "lines!" => \$main::opt_lines, | 377 "lines!" => \$main::opt_lines, |
361 "addresses!" => \$main::opt_addresses, | 378 "addresses!" => \$main::opt_addresses, |
362 "files!" => \$main::opt_files, | 379 "files!" => \$main::opt_files, |
363 "text!" => \$main::opt_text, | 380 "text!" => \$main::opt_text, |
364 "callgrind!" => \$main::opt_callgrind, | 381 "callgrind!" => \$main::opt_callgrind, |
365 "list=s" => \$main::opt_list, | 382 "list=s" => \$main::opt_list, |
366 "disasm=s" => \$main::opt_disasm, | 383 "disasm=s" => \$main::opt_disasm, |
367 "symbols!" => \$main::opt_symbols, | 384 "symbols!" => \$main::opt_symbols, |
368 "gv!" => \$main::opt_gv, | 385 "gv!" => \$main::opt_gv, |
| 386 "evince!" => \$main::opt_evince, |
369 "web!" => \$main::opt_web, | 387 "web!" => \$main::opt_web, |
370 "dot!" => \$main::opt_dot, | 388 "dot!" => \$main::opt_dot, |
371 "ps!" => \$main::opt_ps, | 389 "ps!" => \$main::opt_ps, |
372 "pdf!" => \$main::opt_pdf, | 390 "pdf!" => \$main::opt_pdf, |
373 "svg!" => \$main::opt_svg, | 391 "svg!" => \$main::opt_svg, |
374 "gif!" => \$main::opt_gif, | 392 "gif!" => \$main::opt_gif, |
375 "raw!" => \$main::opt_raw, | 393 "raw!" => \$main::opt_raw, |
376 "interactive!" => \$main::opt_interactive, | 394 "interactive!" => \$main::opt_interactive, |
377 "nodecount=i" => \$main::opt_nodecount, | 395 "nodecount=i" => \$main::opt_nodecount, |
378 "nodefraction=f" => \$main::opt_nodefraction, | 396 "nodefraction=f" => \$main::opt_nodefraction, |
379 "edgefraction=f" => \$main::opt_edgefraction, | 397 "edgefraction=f" => \$main::opt_edgefraction, |
| 398 "maxdegree=i" => \$main::opt_maxdegree, |
380 "focus=s" => \$main::opt_focus, | 399 "focus=s" => \$main::opt_focus, |
381 "ignore=s" => \$main::opt_ignore, | 400 "ignore=s" => \$main::opt_ignore, |
382 "scale=i" => \$main::opt_scale, | 401 "scale=i" => \$main::opt_scale, |
383 "heapcheck" => \$main::opt_heapcheck, | 402 "heapcheck" => \$main::opt_heapcheck, |
384 "inuse_space!" => \$main::opt_inuse_space, | 403 "inuse_space!" => \$main::opt_inuse_space, |
385 "inuse_objects!" => \$main::opt_inuse_objects, | 404 "inuse_objects!" => \$main::opt_inuse_objects, |
386 "alloc_space!" => \$main::opt_alloc_space, | 405 "alloc_space!" => \$main::opt_alloc_space, |
387 "alloc_objects!" => \$main::opt_alloc_objects, | 406 "alloc_objects!" => \$main::opt_alloc_objects, |
388 "show_bytes!" => \$main::opt_show_bytes, | 407 "show_bytes!" => \$main::opt_show_bytes, |
389 "drop_negative!" => \$main::opt_drop_negative, | 408 "drop_negative!" => \$main::opt_drop_negative, |
(...skipping 49 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
439 } | 458 } |
440 | 459 |
441 # Check output modes | 460 # Check output modes |
442 my $modes = | 461 my $modes = |
443 $main::opt_text + | 462 $main::opt_text + |
444 $main::opt_callgrind + | 463 $main::opt_callgrind + |
445 ($main::opt_list eq '' ? 0 : 1) + | 464 ($main::opt_list eq '' ? 0 : 1) + |
446 ($main::opt_disasm eq '' ? 0 : 1) + | 465 ($main::opt_disasm eq '' ? 0 : 1) + |
447 ($main::opt_symbols == 0 ? 0 : 1) + | 466 ($main::opt_symbols == 0 ? 0 : 1) + |
448 $main::opt_gv + | 467 $main::opt_gv + |
| 468 $main::opt_evince + |
449 $main::opt_web + | 469 $main::opt_web + |
450 $main::opt_dot + | 470 $main::opt_dot + |
451 $main::opt_ps + | 471 $main::opt_ps + |
452 $main::opt_pdf + | 472 $main::opt_pdf + |
453 $main::opt_svg + | 473 $main::opt_svg + |
454 $main::opt_gif + | 474 $main::opt_gif + |
455 $main::opt_raw + | 475 $main::opt_raw + |
456 $main::opt_interactive + | 476 $main::opt_interactive + |
457 0; | 477 0; |
458 if ($modes > 1) { | 478 if ($modes > 1) { |
(...skipping 122 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
581 # Get total data in profile | 601 # Get total data in profile |
582 my $total = TotalProfile($profile); | 602 my $total = TotalProfile($profile); |
583 | 603 |
584 # Collect symbols | 604 # Collect symbols |
585 my $symbols; | 605 my $symbols; |
586 if ($main::use_symbolized_profile) { | 606 if ($main::use_symbolized_profile) { |
587 $symbols = FetchSymbols($pcs, $symbol_map); | 607 $symbols = FetchSymbols($pcs, $symbol_map); |
588 } elsif ($main::use_symbol_page) { | 608 } elsif ($main::use_symbol_page) { |
589 $symbols = FetchSymbols($pcs); | 609 $symbols = FetchSymbols($pcs); |
590 } else { | 610 } else { |
| 611 # TODO(csilvers): $libs uses the /proc/self/maps data from profile1, |
| 612 # which may differ from the data from subsequent profiles, especially |
| 613 # if they were run on different machines. Use appropriate libs for |
| 614 # each pc somehow. |
591 $symbols = ExtractSymbols($libs, $pcs); | 615 $symbols = ExtractSymbols($libs, $pcs); |
592 } | 616 } |
593 | 617 |
594 # Remove uniniteresting stack items | 618 # Remove uniniteresting stack items |
595 $profile = RemoveUninterestingFrames($symbols, $profile); | 619 $profile = RemoveUninterestingFrames($symbols, $profile); |
596 | 620 |
597 # Focus? | 621 # Focus? |
598 if ($main::opt_focus ne '') { | 622 if ($main::opt_focus ne '') { |
599 $profile = FocusProfile($symbols, $profile, $main::opt_focus); | 623 $profile = FocusProfile($symbols, $profile, $main::opt_focus); |
600 } | 624 } |
601 | 625 |
602 # Ignore? | 626 # Ignore? |
603 if ($main::opt_ignore ne '') { | 627 if ($main::opt_ignore ne '') { |
604 $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore); | 628 $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore); |
605 } | 629 } |
606 | 630 |
607 my $calls = ExtractCalls($symbols, $profile); | 631 my $calls = ExtractCalls($symbols, $profile); |
608 | 632 |
609 # Reduce profiles to required output granularity, and also clean | 633 # Reduce profiles to required output granularity, and also clean |
610 # each stack trace so a given entry exists at most once. | 634 # each stack trace so a given entry exists at most once. |
611 my $reduced = ReduceProfile($symbols, $profile); | 635 my $reduced = ReduceProfile($symbols, $profile); |
612 | 636 |
613 # Get derived profiles | 637 # Get derived profiles |
614 my $flat = FlatProfile($reduced); | 638 my $flat = FlatProfile($reduced); |
615 my $cumulative = CumulativeProfile($reduced); | 639 my $cumulative = CumulativeProfile($reduced); |
616 | 640 |
617 # Print | 641 # Print |
618 if (!$main::opt_interactive) { | 642 if (!$main::opt_interactive) { |
619 if ($main::opt_disasm) { | 643 if ($main::opt_disasm) { |
620 PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm, $total); | 644 PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm); |
621 } elsif ($main::opt_list) { | 645 } elsif ($main::opt_list) { |
622 PrintListing($libs, $flat, $cumulative, $main::opt_list); | 646 PrintListing($libs, $flat, $cumulative, $main::opt_list); |
623 } elsif ($main::opt_text) { | 647 } elsif ($main::opt_text) { |
624 # Make sure the output is empty when have nothing to report | 648 # Make sure the output is empty when have nothing to report |
625 # (only matters when --heapcheck is given but we must be | 649 # (only matters when --heapcheck is given but we must be |
626 # compatible with old branches that did not pass --heapcheck always): | 650 # compatible with old branches that did not pass --heapcheck always): |
627 if ($total != 0) { | 651 if ($total != 0) { |
628 printf("Total: %s %s\n", Unparse($total), Units()); | 652 printf("Total: %s %s\n", Unparse($total), Units()); |
629 } | 653 } |
630 PrintText($symbols, $flat, $cumulative, $total, -1); | 654 PrintText($symbols, $flat, $cumulative, -1); |
631 } elsif ($main::opt_raw) { | 655 } elsif ($main::opt_raw) { |
632 PrintSymbolizedProfile($symbols, $profile, $main::prog); | 656 PrintSymbolizedProfile($symbols, $profile, $main::prog); |
633 } elsif ($main::opt_callgrind) { | 657 } elsif ($main::opt_callgrind) { |
634 PrintCallgrind($calls); | 658 PrintCallgrind($calls); |
635 } else { | 659 } else { |
636 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total))
{ | 660 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total))
{ |
637 if ($main::opt_gv) { | 661 if ($main::opt_gv) { |
638 RunGV(TempName($main::next_tmpfile, "ps"), ""); | 662 RunGV(TempName($main::next_tmpfile, "ps"), ""); |
| 663 } elsif ($main::opt_evince) { |
| 664 RunEvince(TempName($main::next_tmpfile, "pdf"), ""); |
639 } elsif ($main::opt_web) { | 665 } elsif ($main::opt_web) { |
640 my $tmp = TempName($main::next_tmpfile, "svg"); | 666 my $tmp = TempName($main::next_tmpfile, "svg"); |
641 RunWeb($tmp); | 667 RunWeb($tmp); |
642 # The command we run might hand the file name off | 668 # The command we run might hand the file name off |
643 # to an already running browser instance and then exit. | 669 # to an already running browser instance and then exit. |
644 # Normally, we'd remove $tmp on exit (right now), | 670 # Normally, we'd remove $tmp on exit (right now), |
645 # but fork a child to remove $tmp a little later, so that the | 671 # but fork a child to remove $tmp a little later, so that the |
646 # browser has time to load it first. | 672 # browser has time to load it first. |
647 delete $main::tempnames{$tmp}; | 673 delete $main::tempnames{$tmp}; |
648 if (fork() == 0) { | 674 if (fork() == 0) { |
(...skipping 28 matching lines...) Expand all Loading... |
677 if (-e '/lib/libtermcap.so.2') { | 703 if (-e '/lib/libtermcap.so.2') { |
678 return 0; # libtermcap exists, so readline should be okay | 704 return 0; # libtermcap exists, so readline should be okay |
679 } else { | 705 } else { |
680 return 1; | 706 return 1; |
681 } | 707 } |
682 } | 708 } |
683 | 709 |
684 sub RunGV { | 710 sub RunGV { |
685 my $fname = shift; | 711 my $fname = shift; |
686 my $bg = shift; # "" or " &" if we should run in background | 712 my $bg = shift; # "" or " &" if we should run in background |
687 if (!system("$GV --version >/dev/null 2>&1")) { | 713 if (!system("$GV --version >$dev_null 2>&1")) { |
688 # Options using double dash are supported by this gv version. | 714 # Options using double dash are supported by this gv version. |
689 # Also, turn on noantialias to better handle bug in gv for | 715 # Also, turn on noantialias to better handle bug in gv for |
690 # postscript files with large dimensions. | 716 # postscript files with large dimensions. |
691 # TODO: Maybe we should not pass the --noantialias flag | 717 # TODO: Maybe we should not pass the --noantialias flag |
692 # if the gv version is known to work properly without the flag. | 718 # if the gv version is known to work properly without the flag. |
693 system("$GV --scale=$main::opt_scale --noantialias " . $fname . $bg); | 719 system("$GV --scale=$main::opt_scale --noantialias " . $fname . $bg); |
694 } else { | 720 } else { |
695 # Old gv version - only supports options that use single dash. | 721 # Old gv version - only supports options that use single dash. |
696 print STDERR "$GV -scale $main::opt_scale\n"; | 722 print STDERR "$GV -scale $main::opt_scale\n"; |
697 system("$GV -scale $main::opt_scale " . $fname . $bg); | 723 system("$GV -scale $main::opt_scale " . $fname . $bg); |
698 } | 724 } |
699 } | 725 } |
700 | 726 |
| 727 sub RunEvince { |
| 728 my $fname = shift; |
| 729 my $bg = shift; # "" or " &" if we should run in background |
| 730 system("$EVINCE " . $fname . $bg); |
| 731 } |
| 732 |
701 sub RunWeb { | 733 sub RunWeb { |
702 my $fname = shift; | 734 my $fname = shift; |
703 print STDERR "Loading web page file:///$fname\n"; | 735 print STDERR "Loading web page file:///$fname\n"; |
704 | 736 |
705 if (`uname` =~ /Darwin/) { | 737 if (`uname` =~ /Darwin/) { |
706 # OS X: open will use standard preference for SVG files. | 738 # OS X: open will use standard preference for SVG files. |
707 system("/usr/bin/open", $fname); | 739 system("/usr/bin/open", $fname); |
708 return; | 740 return; |
709 } | 741 } |
710 | 742 |
711 # Some kind of Unix; try generic symlinks, then specific browsers. | 743 # Some kind of Unix; try generic symlinks, then specific browsers. |
712 # (Stop once we find one.) | 744 # (Stop once we find one.) |
713 # Works best if the browser is already running. | 745 # Works best if the browser is already running. |
714 my @alt = ( | 746 my @alt = ( |
715 "/etc/alternatives/gnome-www-browser", | 747 "/etc/alternatives/gnome-www-browser", |
716 "/etc/alternatives/x-www-browser", | 748 "/etc/alternatives/x-www-browser", |
717 "google-chrome", | 749 "google-chrome", |
718 "firefox", | 750 "firefox", |
719 ); | 751 ); |
720 foreach my $b (@alt) { | 752 foreach my $b (@alt) { |
721 if (-f $b) { | 753 if (system($b, $fname) == 0) { |
722 if (system($b, $fname) == 0) { | 754 return; |
723 return; | |
724 } | |
725 } | 755 } |
726 } | 756 } |
727 | 757 |
728 print STDERR "Could not load web browser.\n"; | 758 print STDERR "Could not load web browser.\n"; |
729 } | 759 } |
730 | 760 |
731 sub RunKcachegrind { | 761 sub RunKcachegrind { |
732 my $fname = shift; | 762 my $fname = shift; |
733 my $bg = shift; # "" or " &" if we should run in background | 763 my $bg = shift; # "" or " &" if we should run in background |
734 print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n"; | 764 print STDERR "Starting '$KCACHEGRIND " . $fname . $bg . "'\n"; |
(...skipping 55 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
790 if (m/^\s*help/) { | 820 if (m/^\s*help/) { |
791 InteractiveHelpMessage(); | 821 InteractiveHelpMessage(); |
792 return 1; | 822 return 1; |
793 } | 823 } |
794 # Clear all the mode options -- mode is controlled by "$command" | 824 # Clear all the mode options -- mode is controlled by "$command" |
795 $main::opt_text = 0; | 825 $main::opt_text = 0; |
796 $main::opt_callgrind = 0; | 826 $main::opt_callgrind = 0; |
797 $main::opt_disasm = 0; | 827 $main::opt_disasm = 0; |
798 $main::opt_list = 0; | 828 $main::opt_list = 0; |
799 $main::opt_gv = 0; | 829 $main::opt_gv = 0; |
| 830 $main::opt_evince = 0; |
800 $main::opt_cum = 0; | 831 $main::opt_cum = 0; |
801 | 832 |
802 if (m/^\s*(text|top)(\d*)\s*(.*)/) { | 833 if (m/^\s*(text|top)(\d*)\s*(.*)/) { |
803 $main::opt_text = 1; | 834 $main::opt_text = 1; |
804 | 835 |
805 my $line_limit = ($2 ne "") ? int($2) : 10; | 836 my $line_limit = ($2 ne "") ? int($2) : 10; |
806 | 837 |
807 my $routine; | 838 my $routine; |
808 my $ignore; | 839 my $ignore; |
809 ($routine, $ignore) = ParseInteractiveArgs($3); | 840 ($routine, $ignore) = ParseInteractiveArgs($3); |
810 | 841 |
811 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); | 842 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); |
812 my $reduced = ReduceProfile($symbols, $profile); | 843 my $reduced = ReduceProfile($symbols, $profile); |
813 | 844 |
814 # Get derived profiles | 845 # Get derived profiles |
815 my $flat = FlatProfile($reduced); | 846 my $flat = FlatProfile($reduced); |
816 my $cumulative = CumulativeProfile($reduced); | 847 my $cumulative = CumulativeProfile($reduced); |
817 | 848 |
818 PrintText($symbols, $flat, $cumulative, $total, $line_limit); | 849 PrintText($symbols, $flat, $cumulative, $line_limit); |
819 return 1; | 850 return 1; |
820 } | 851 } |
821 if (m/^\s*callgrind\s*([^ \n]*)/) { | 852 if (m/^\s*callgrind\s*([^ \n]*)/) { |
822 $main::opt_callgrind = 1; | 853 $main::opt_callgrind = 1; |
823 | 854 |
824 # Get derived profiles | 855 # Get derived profiles |
825 my $calls = ExtractCalls($symbols, $orig_profile); | 856 my $calls = ExtractCalls($symbols, $orig_profile); |
826 my $filename = $1; | 857 my $filename = $1; |
827 if ( $1 eq '' ) { | 858 if ( $1 eq '' ) { |
828 $filename = TempName($main::next_tmpfile, "callgrind"); | 859 $filename = TempName($main::next_tmpfile, "callgrind"); |
(...skipping 31 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
860 ($routine, $ignore) = ParseInteractiveArgs($1); | 891 ($routine, $ignore) = ParseInteractiveArgs($1); |
861 | 892 |
862 # Process current profile to account for various settings | 893 # Process current profile to account for various settings |
863 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); | 894 my $profile = ProcessProfile($orig_profile, $symbols, "", $ignore); |
864 my $reduced = ReduceProfile($symbols, $profile); | 895 my $reduced = ReduceProfile($symbols, $profile); |
865 | 896 |
866 # Get derived profiles | 897 # Get derived profiles |
867 my $flat = FlatProfile($reduced); | 898 my $flat = FlatProfile($reduced); |
868 my $cumulative = CumulativeProfile($reduced); | 899 my $cumulative = CumulativeProfile($reduced); |
869 | 900 |
870 PrintDisassembly($libs, $flat, $cumulative, $routine, $total); | 901 PrintDisassembly($libs, $flat, $cumulative, $routine); |
871 return 1; | 902 return 1; |
872 } | 903 } |
873 if (m/^\s*(gv|web)\s*(.*)/) { | 904 if (m/^\s*(gv|web|evince)\s*(.*)/) { |
874 $main::opt_gv = 0; | 905 $main::opt_gv = 0; |
| 906 $main::opt_evince = 0; |
875 $main::opt_web = 0; | 907 $main::opt_web = 0; |
876 if ($1 eq "gv") { | 908 if ($1 eq "gv") { |
877 $main::opt_gv = 1; | 909 $main::opt_gv = 1; |
| 910 } elsif ($1 eq "evince") { |
| 911 $main::opt_evince = 1; |
878 } elsif ($1 eq "web") { | 912 } elsif ($1 eq "web") { |
879 $main::opt_web = 1; | 913 $main::opt_web = 1; |
880 } | 914 } |
881 | 915 |
882 my $focus; | 916 my $focus; |
883 my $ignore; | 917 my $ignore; |
884 ($focus, $ignore) = ParseInteractiveArgs($2); | 918 ($focus, $ignore) = ParseInteractiveArgs($2); |
885 | 919 |
886 # Process current profile to account for various settings | 920 # Process current profile to account for various settings |
887 my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore); | 921 my $profile = ProcessProfile($orig_profile, $symbols, $focus, $ignore); |
888 my $reduced = ReduceProfile($symbols, $profile); | 922 my $reduced = ReduceProfile($symbols, $profile); |
889 | 923 |
890 # Get derived profiles | 924 # Get derived profiles |
891 my $flat = FlatProfile($reduced); | 925 my $flat = FlatProfile($reduced); |
892 my $cumulative = CumulativeProfile($reduced); | 926 my $cumulative = CumulativeProfile($reduced); |
893 | 927 |
894 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { | 928 if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) { |
895 if ($main::opt_gv) { | 929 if ($main::opt_gv) { |
896 RunGV(TempName($main::next_tmpfile, "ps"), " &"); | 930 RunGV(TempName($main::next_tmpfile, "ps"), " &"); |
| 931 } elsif ($main::opt_evince) { |
| 932 RunEvince(TempName($main::next_tmpfile, "pdf"), " &"); |
897 } elsif ($main::opt_web) { | 933 } elsif ($main::opt_web) { |
898 RunWeb(TempName($main::next_tmpfile, "svg")); | 934 RunWeb(TempName($main::next_tmpfile, "svg")); |
899 } | 935 } |
900 $main::next_tmpfile++; | 936 $main::next_tmpfile++; |
901 } | 937 } |
902 return 1; | 938 return 1; |
903 } | 939 } |
904 if (m/^\s*$/) { | 940 if (m/^\s*$/) { |
905 return 1; | 941 return 1; |
906 } | 942 } |
(...skipping 192 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1099 # dump a cpu-format profile to standard out | 1135 # dump a cpu-format profile to standard out |
1100 PrintProfileData($profile); | 1136 PrintProfileData($profile); |
1101 } | 1137 } |
1102 } | 1138 } |
1103 | 1139 |
1104 # Print text output | 1140 # Print text output |
1105 sub PrintText { | 1141 sub PrintText { |
1106 my $symbols = shift; | 1142 my $symbols = shift; |
1107 my $flat = shift; | 1143 my $flat = shift; |
1108 my $cumulative = shift; | 1144 my $cumulative = shift; |
1109 my $total = shift; | |
1110 my $line_limit = shift; | 1145 my $line_limit = shift; |
1111 | 1146 |
| 1147 my $total = TotalProfile($flat); |
| 1148 |
1112 # Which profile to sort by? | 1149 # Which profile to sort by? |
1113 my $s = $main::opt_cum ? $cumulative : $flat; | 1150 my $s = $main::opt_cum ? $cumulative : $flat; |
1114 | 1151 |
1115 my $running_sum = 0; | 1152 my $running_sum = 0; |
1116 my $lines = 0; | 1153 my $lines = 0; |
1117 foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b } | 1154 foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b } |
1118 keys(%{$cumulative})) { | 1155 keys(%{$cumulative})) { |
1119 my $f = GetEntry($flat, $k); | 1156 my $f = GetEntry($flat, $k); |
1120 my $c = GetEntry($cumulative, $k); | 1157 my $c = GetEntry($cumulative, $k); |
1121 $running_sum += $f; | 1158 $running_sum += $f; |
(...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1176 printf CG ("$caller_line $count\n\n"); | 1213 printf CG ("$caller_line $count\n\n"); |
1177 } | 1214 } |
1178 } | 1215 } |
1179 | 1216 |
1180 # Print disassembly for all all routines that match $main::opt_disasm | 1217 # Print disassembly for all all routines that match $main::opt_disasm |
1181 sub PrintDisassembly { | 1218 sub PrintDisassembly { |
1182 my $libs = shift; | 1219 my $libs = shift; |
1183 my $flat = shift; | 1220 my $flat = shift; |
1184 my $cumulative = shift; | 1221 my $cumulative = shift; |
1185 my $disasm_opts = shift; | 1222 my $disasm_opts = shift; |
1186 my $total = shift; | 1223 |
| 1224 my $total = TotalProfile($flat); |
1187 | 1225 |
1188 foreach my $lib (@{$libs}) { | 1226 foreach my $lib (@{$libs}) { |
1189 my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts); | 1227 my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts); |
1190 my $offset = AddressSub($lib->[1], $lib->[3]); | 1228 my $offset = AddressSub($lib->[1], $lib->[3]); |
1191 foreach my $routine (sort ByName keys(%{$symbol_table})) { | 1229 foreach my $routine (sort ByName keys(%{$symbol_table})) { |
1192 my $start_addr = $symbol_table->{$routine}->[0]; | 1230 my $start_addr = $symbol_table->{$routine}->[0]; |
1193 my $end_addr = $symbol_table->{$routine}->[1]; | 1231 my $end_addr = $symbol_table->{$routine}->[1]; |
1194 # See if there are any samples in this routine | 1232 # See if there are any samples in this routine |
1195 my $length = hex(AddressSub($end_addr, $start_addr)); | 1233 my $length = hex(AddressSub($end_addr, $start_addr)); |
1196 my $addr = AddressAdd($start_addr, $offset); | 1234 my $addr = AddressAdd($start_addr, $offset); |
(...skipping 473 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1670 if ($nodelimit > 0 || $edgelimit > 0) { | 1708 if ($nodelimit > 0 || $edgelimit > 0) { |
1671 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", | 1709 printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n", |
1672 Unparse($nodelimit), Units(), | 1710 Unparse($nodelimit), Units(), |
1673 Unparse($edgelimit), Units()); | 1711 Unparse($edgelimit), Units()); |
1674 } | 1712 } |
1675 | 1713 |
1676 # Open DOT output file | 1714 # Open DOT output file |
1677 my $output; | 1715 my $output; |
1678 if ($main::opt_gv) { | 1716 if ($main::opt_gv) { |
1679 $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps"); | 1717 $output = "| $DOT -Tps2 >" . TempName($main::next_tmpfile, "ps"); |
| 1718 } elsif ($main::opt_evince) { |
| 1719 $output = "| $DOT -Tps2 | $PS2PDF - " . TempName($main::next_tmpfile, "pdf")
; |
1680 } elsif ($main::opt_ps) { | 1720 } elsif ($main::opt_ps) { |
1681 $output = "| $DOT -Tps2"; | 1721 $output = "| $DOT -Tps2"; |
1682 } elsif ($main::opt_pdf) { | 1722 } elsif ($main::opt_pdf) { |
1683 $output = "| $DOT -Tps2 | $PS2PDF - -"; | 1723 $output = "| $DOT -Tps2 | $PS2PDF - -"; |
1684 } elsif ($main::opt_web || $main::opt_svg) { | 1724 } elsif ($main::opt_web || $main::opt_svg) { |
1685 # We need to post-process the SVG, so write to a temporary file always. | 1725 # We need to post-process the SVG, so write to a temporary file always. |
1686 $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg"); | 1726 $output = "| $DOT -Tsvg >" . TempName($main::next_tmpfile, "svg"); |
1687 } elsif ($main::opt_gif) { | 1727 } elsif ($main::opt_gif) { |
1688 $output = "| $DOT -Tgif"; | 1728 $output = "| $DOT -Tgif"; |
1689 } else { | 1729 } else { |
(...skipping 40 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1730 $node{$a} = $nextnode++; | 1770 $node{$a} = $nextnode++; |
1731 my $sym = $a; | 1771 my $sym = $a; |
1732 $sym =~ s/\s+/\\n/g; | 1772 $sym =~ s/\s+/\\n/g; |
1733 $sym =~ s/::/\\n/g; | 1773 $sym =~ s/::/\\n/g; |
1734 | 1774 |
1735 # Extra cumulative info to print for non-leaves | 1775 # Extra cumulative info to print for non-leaves |
1736 my $extra = ""; | 1776 my $extra = ""; |
1737 if ($f != $c) { | 1777 if ($f != $c) { |
1738 $extra = sprintf("\\rof %s (%s)", | 1778 $extra = sprintf("\\rof %s (%s)", |
1739 Unparse($c), | 1779 Unparse($c), |
1740 Percent($c, $overall_total)); | 1780 Percent($c, $local_total)); |
1741 } | 1781 } |
1742 my $style = ""; | 1782 my $style = ""; |
1743 if ($main::opt_heapcheck) { | 1783 if ($main::opt_heapcheck) { |
1744 if ($f > 0) { | 1784 if ($f > 0) { |
1745 # make leak-causing nodes more visible (add a background) | 1785 # make leak-causing nodes more visible (add a background) |
1746 $style = ",style=filled,fillcolor=gray" | 1786 $style = ",style=filled,fillcolor=gray" |
1747 } elsif ($f < 0) { | 1787 } elsif ($f < 0) { |
1748 # make anti-leak-causing nodes (which almost never occur) | 1788 # make anti-leak-causing nodes (which almost never occur) |
1749 # stand out as well (triple border) | 1789 # stand out as well (triple border) |
1750 $style = ",peripheries=3" | 1790 $style = ",peripheries=3" |
1751 } | 1791 } |
1752 } | 1792 } |
1753 | 1793 |
1754 printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" . | 1794 printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" . |
1755 "\",shape=box,fontsize=%.1f%s];\n", | 1795 "\",shape=box,fontsize=%.1f%s];\n", |
1756 $node{$a}, | 1796 $node{$a}, |
1757 $sym, | 1797 $sym, |
1758 Unparse($f), | 1798 Unparse($f), |
1759 Percent($f, $overall_total), | 1799 Percent($f, $local_total), |
1760 $extra, | 1800 $extra, |
1761 $fs, | 1801 $fs, |
1762 $style, | 1802 $style, |
1763 ); | 1803 ); |
1764 } | 1804 } |
1765 | 1805 |
1766 # Get edges and counts per edge | 1806 # Get edges and counts per edge |
1767 my %edge = (); | 1807 my %edge = (); |
1768 my $n; | 1808 my $n; |
1769 foreach my $k (keys(%{$raw})) { | 1809 foreach my $k (keys(%{$raw})) { |
1770 # TODO: omit low %age edges | 1810 # TODO: omit low %age edges |
1771 $n = $raw->{$k}; | 1811 $n = $raw->{$k}; |
1772 my @translated = TranslateStack($symbols, $k); | 1812 my @translated = TranslateStack($symbols, $k); |
1773 for (my $i = 1; $i <= $#translated; $i++) { | 1813 for (my $i = 1; $i <= $#translated; $i++) { |
1774 my $src = $translated[$i]; | 1814 my $src = $translated[$i]; |
1775 my $dst = $translated[$i-1]; | 1815 my $dst = $translated[$i-1]; |
1776 #next if ($src eq $dst); # Avoid self-edges? | 1816 #next if ($src eq $dst); # Avoid self-edges? |
1777 if (exists($node{$src}) && exists($node{$dst})) { | 1817 if (exists($node{$src}) && exists($node{$dst})) { |
1778 my $edge_label = "$src\001$dst"; | 1818 my $edge_label = "$src\001$dst"; |
1779 if (!exists($edge{$edge_label})) { | 1819 if (!exists($edge{$edge_label})) { |
1780 $edge{$edge_label} = 0; | 1820 $edge{$edge_label} = 0; |
1781 } | 1821 } |
1782 $edge{$edge_label} += $n; | 1822 $edge{$edge_label} += $n; |
1783 } | 1823 } |
1784 } | 1824 } |
1785 } | 1825 } |
1786 | 1826 |
1787 # Print edges | 1827 # Print edges (process in order of decreasing counts) |
1788 foreach my $e (keys(%edge)) { | 1828 my %indegree = (); # Number of incoming edges added per node so far |
| 1829 my %outdegree = (); # Number of outgoing edges added per node so far |
| 1830 foreach my $e (sort { $edge{$b} <=> $edge{$a} } keys(%edge)) { |
1789 my @x = split(/\001/, $e); | 1831 my @x = split(/\001/, $e); |
1790 $n = $edge{$e}; | 1832 $n = $edge{$e}; |
1791 | 1833 |
1792 if (abs($n) > $edgelimit) { | 1834 # Initialize degree of kept incoming and outgoing edges if necessary |
| 1835 my $src = $x[0]; |
| 1836 my $dst = $x[1]; |
| 1837 if (!exists($outdegree{$src})) { $outdegree{$src} = 0; } |
| 1838 if (!exists($indegree{$dst})) { $indegree{$dst} = 0; } |
| 1839 |
| 1840 my $keep; |
| 1841 if ($indegree{$dst} == 0) { |
| 1842 # Keep edge if needed for reachability |
| 1843 $keep = 1; |
| 1844 } elsif (abs($n) <= $edgelimit) { |
| 1845 # Drop if we are below --edgefraction |
| 1846 $keep = 0; |
| 1847 } elsif ($outdegree{$src} >= $main::opt_maxdegree || |
| 1848 $indegree{$dst} >= $main::opt_maxdegree) { |
| 1849 # Keep limited number of in/out edges per node |
| 1850 $keep = 0; |
| 1851 } else { |
| 1852 $keep = 1; |
| 1853 } |
| 1854 |
| 1855 if ($keep) { |
| 1856 $outdegree{$src}++; |
| 1857 $indegree{$dst}++; |
| 1858 |
1793 # Compute line width based on edge count | 1859 # Compute line width based on edge count |
1794 my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0); | 1860 my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0); |
1795 if ($fraction > 1) { $fraction = 1; } | 1861 if ($fraction > 1) { $fraction = 1; } |
1796 my $w = $fraction * 2; | 1862 my $w = $fraction * 2; |
1797 if ($w < 1 && ($main::opt_web || $main::opt_svg)) { | 1863 if ($w < 1 && ($main::opt_web || $main::opt_svg)) { |
1798 # SVG output treats line widths < 1 poorly. | 1864 # SVG output treats line widths < 1 poorly. |
1799 $w = 1; | 1865 $w = 1; |
1800 } | 1866 } |
1801 | 1867 |
1802 # Dot sometimes segfaults if given edge weights that are too large, so | 1868 # Dot sometimes segfaults if given edge weights that are too large, so |
(...skipping 317 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
2120 if(state == 'pan' || state == 'move') { | 2186 if(state == 'pan' || state == 'move') { |
2121 // Quit pan mode | 2187 // Quit pan mode |
2122 state = ''; | 2188 state = ''; |
2123 } | 2189 } |
2124 } | 2190 } |
2125 | 2191 |
2126 ]]></script> | 2192 ]]></script> |
2127 EOF | 2193 EOF |
2128 } | 2194 } |
2129 | 2195 |
| 2196 # Return a small number that identifies the argument. |
| 2197 # Multiple calls with the same argument will return the same number. |
| 2198 # Calls with different arguments will return different numbers. |
| 2199 sub ShortIdFor { |
| 2200 my $key = shift; |
| 2201 my $id = $main::uniqueid{$key}; |
| 2202 if (!defined($id)) { |
| 2203 $id = keys(%main::uniqueid) + 1; |
| 2204 $main::uniqueid{$key} = $id; |
| 2205 } |
| 2206 return $id; |
| 2207 } |
| 2208 |
2130 # Translate a stack of addresses into a stack of symbols | 2209 # Translate a stack of addresses into a stack of symbols |
2131 sub TranslateStack { | 2210 sub TranslateStack { |
2132 my $symbols = shift; | 2211 my $symbols = shift; |
2133 my $k = shift; | 2212 my $k = shift; |
2134 | 2213 |
2135 my @addrs = split(/\n/, $k); | 2214 my @addrs = split(/\n/, $k); |
2136 my @result = (); | 2215 my @result = (); |
2137 for (my $i = 0; $i <= $#addrs; $i++) { | 2216 for (my $i = 0; $i <= $#addrs; $i++) { |
2138 my $a = $addrs[$i]; | 2217 my $a = $addrs[$i]; |
2139 | 2218 |
(...skipping 17 matching lines...) Expand all Loading... |
2157 # (more than one symbol in the case of inlining). Callers | 2236 # (more than one symbol in the case of inlining). Callers |
2158 # come before callees in symlist, so walk backwards since | 2237 # come before callees in symlist, so walk backwards since |
2159 # the translated stack should contain callees before callers. | 2238 # the translated stack should contain callees before callers. |
2160 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { | 2239 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) { |
2161 my $func = $symlist->[$j-2]; | 2240 my $func = $symlist->[$j-2]; |
2162 my $fileline = $symlist->[$j-1]; | 2241 my $fileline = $symlist->[$j-1]; |
2163 my $fullfunc = $symlist->[$j]; | 2242 my $fullfunc = $symlist->[$j]; |
2164 if ($j > 2) { | 2243 if ($j > 2) { |
2165 $func = "$func (inline)"; | 2244 $func = "$func (inline)"; |
2166 } | 2245 } |
| 2246 |
| 2247 # Do not merge nodes corresponding to Callback::Run since that |
| 2248 # causes confusing cycles in dot display. Instead, we synthesize |
| 2249 # a unique name for this frame per caller. |
| 2250 if ($func =~ m/Callback.*::Run$/) { |
| 2251 my $caller = ($i > 0) ? $addrs[$i-1] : 0; |
| 2252 $func = "Run#" . ShortIdFor($caller); |
| 2253 } |
| 2254 |
2167 if ($main::opt_addresses) { | 2255 if ($main::opt_addresses) { |
2168 push(@result, "$a $func $fileline"); | 2256 push(@result, "$a $func $fileline"); |
2169 } elsif ($main::opt_lines) { | 2257 } elsif ($main::opt_lines) { |
2170 if ($func eq '??' && $fileline eq '??:0') { | 2258 if ($func eq '??' && $fileline eq '??:0') { |
2171 push(@result, "$a"); | 2259 push(@result, "$a"); |
2172 } else { | 2260 } else { |
2173 push(@result, "$func $fileline"); | 2261 push(@result, "$func $fileline"); |
2174 } | 2262 } |
2175 } elsif ($main::opt_functions) { | 2263 } elsif ($main::opt_functions) { |
2176 if ($func eq '??') { | 2264 if ($func eq '??') { |
(...skipping 223 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
2400 '__start_malloc_hook', | 2488 '__start_malloc_hook', |
2401 '__stop_malloc_hook') { | 2489 '__stop_malloc_hook') { |
2402 $skip{$name} = 1; | 2490 $skip{$name} = 1; |
2403 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything | 2491 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything |
2404 } | 2492 } |
2405 # TODO: Remove TCMalloc once everything has been | 2493 # TODO: Remove TCMalloc once everything has been |
2406 # moved into the tcmalloc:: namespace and we have flushed | 2494 # moved into the tcmalloc:: namespace and we have flushed |
2407 # old code out of the system. | 2495 # old code out of the system. |
2408 $skip_regexp = "TCMalloc|^tcmalloc::"; | 2496 $skip_regexp = "TCMalloc|^tcmalloc::"; |
2409 } elsif ($main::profile_type eq 'contention') { | 2497 } elsif ($main::profile_type eq 'contention') { |
2410 foreach my $vname ('Mutex::Unlock', 'Mutex::UnlockSlow') { | 2498 foreach my $vname ('base::RecordLockProfileData', |
| 2499 'base::SubmitMutexProfileData', |
| 2500 'base::SubmitSpinLockProfileData', |
| 2501 'Mutex::Unlock', |
| 2502 'Mutex::UnlockSlow', |
| 2503 'Mutex::ReaderUnlock', |
| 2504 'MutexLock::~MutexLock', |
| 2505 'SpinLock::Unlock', |
| 2506 'SpinLock::SlowUnlock', |
| 2507 'SpinLockHolder::~SpinLockHolder') { |
2411 $skip{$vname} = 1; | 2508 $skip{$vname} = 1; |
2412 } | 2509 } |
2413 } elsif ($main::profile_type eq 'cpu') { | 2510 } elsif ($main::profile_type eq 'cpu') { |
2414 # Drop signal handlers used for CPU profile collection | 2511 # Drop signal handlers used for CPU profile collection |
2415 # TODO(dpeng): this should not be necessary; it's taken | 2512 # TODO(dpeng): this should not be necessary; it's taken |
2416 # care of by the general 2nd-pc mechanism below. | 2513 # care of by the general 2nd-pc mechanism below. |
2417 foreach my $name ('ProfileData::Add', # historical | 2514 foreach my $name ('ProfileData::Add', # historical |
2418 'ProfileData::prof_handler', # historical | 2515 'ProfileData::prof_handler', # historical |
2419 'CpuProfiler::prof_handler', | 2516 'CpuProfiler::prof_handler', |
2420 '__FRAME_END__', | 2517 '__FRAME_END__', |
(...skipping 276 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
2697 if ($1 == 0) { | 2794 if ($1 == 0) { |
2698 error("Stripped binary. No symbols available.\n"); | 2795 error("Stripped binary. No symbols available.\n"); |
2699 } | 2796 } |
2700 } else { | 2797 } else { |
2701 error("Failed to get the number of symbols from $url\n"); | 2798 error("Failed to get the number of symbols from $url\n"); |
2702 } | 2799 } |
2703 } | 2800 } |
2704 | 2801 |
2705 sub IsProfileURL { | 2802 sub IsProfileURL { |
2706 my $profile_name = shift; | 2803 my $profile_name = shift; |
2707 my ($host, $port, $prefix, $path) = ParseProfileURL($profile_name); | 2804 if (-f $profile_name) { |
2708 return defined($host) and defined($port) and defined($path); | 2805 printf STDERR "Using local file $profile_name.\n"; |
| 2806 return 0; |
| 2807 } |
| 2808 return 1; |
2709 } | 2809 } |
2710 | 2810 |
2711 sub ParseProfileURL { | 2811 sub ParseProfileURL { |
2712 my $profile_name = shift; | 2812 my $profile_name = shift; |
2713 if (defined($profile_name) && | 2813 |
2714 $profile_name =~ m,^(http://|)([^/:]+):(\d+)(|\@\d+)(|/|(.*?)($PROFILE_PAG
E|$PMUPROFILE_PAGE|$HEAP_PAGE|$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|$FILTERED
PROFILE_PAGE))$,o) { | 2814 if (!defined($profile_name) || $profile_name eq "") { |
2715 # $7 is $PROFILE_PAGE/$HEAP_PAGE/etc. $5 is *everything* after | 2815 return (); |
2716 # the hostname, as long as that everything is the empty string, | |
2717 # a slash, or something ending in $PROFILE_PAGE/$HEAP_PAGE/etc. | |
2718 # So "$7 || $5" is $PROFILE_PAGE/etc if there, or else it's "/" or "". | |
2719 return ($2, $3, $6, $7 || $5); | |
2720 } | 2816 } |
2721 return (); | 2817 |
| 2818 # Split profile URL - matches all non-empty strings, so no test. |
| 2819 $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,; |
| 2820 |
| 2821 my $proto = $1 || "http://"; |
| 2822 my $hostport = $2; |
| 2823 my $prefix = $3; |
| 2824 my $profile = $4 || "/"; |
| 2825 |
| 2826 my $host = $hostport; |
| 2827 $host =~ s/:.*//; |
| 2828 |
| 2829 my $baseurl = "$proto$hostport$prefix"; |
| 2830 return ($host, $baseurl, $profile); |
2722 } | 2831 } |
2723 | 2832 |
2724 # We fetch symbols from the first profile argument. | 2833 # We fetch symbols from the first profile argument. |
2725 sub SymbolPageURL { | 2834 sub SymbolPageURL { |
2726 my ($host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]); | 2835 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); |
2727 return "http://$host:$port$prefix$SYMBOL_PAGE"; | 2836 return "$baseURL$SYMBOL_PAGE"; |
2728 } | 2837 } |
2729 | 2838 |
2730 sub FetchProgramName() { | 2839 sub FetchProgramName() { |
2731 my ($host, $port, $prefix, $path) = ParseProfileURL($main::pfile_args[0]); | 2840 my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]); |
2732 my $url = "http://$host:$port$prefix$PROGRAM_NAME_PAGE"; | 2841 my $url = "$baseURL$PROGRAM_NAME_PAGE"; |
2733 my $command_line = "$URL_FETCHER '$url'"; | 2842 my $command_line = "$URL_FETCHER '$url'"; |
2734 open(CMDLINE, "$command_line |") or error($command_line); | 2843 open(CMDLINE, "$command_line |") or error($command_line); |
2735 my $cmdline = <CMDLINE>; | 2844 my $cmdline = <CMDLINE>; |
2736 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines | 2845 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines |
2737 close(CMDLINE); | 2846 close(CMDLINE); |
2738 error("Failed to get program name from $url\n") unless defined($cmdline); | 2847 error("Failed to get program name from $url\n") unless defined($cmdline); |
2739 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. | 2848 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. |
2740 $cmdline =~ s!\n!!g; # Remove LFs. | 2849 $cmdline =~ s!\n!!g; # Remove LFs. |
2741 return $cmdline; | 2850 return $cmdline; |
2742 } | 2851 } |
(...skipping 130 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
2873 } | 2982 } |
2874 | 2983 |
2875 sub BaseName { | 2984 sub BaseName { |
2876 my $file_name = shift; | 2985 my $file_name = shift; |
2877 $file_name =~ s!^.*/!!; # Remove directory name | 2986 $file_name =~ s!^.*/!!; # Remove directory name |
2878 return $file_name; | 2987 return $file_name; |
2879 } | 2988 } |
2880 | 2989 |
2881 sub MakeProfileBaseName { | 2990 sub MakeProfileBaseName { |
2882 my ($binary_name, $profile_name) = @_; | 2991 my ($binary_name, $profile_name) = @_; |
2883 my ($host, $port, $prefix, $path) = ParseProfileURL($profile_name); | 2992 my ($host, $baseURL, $path) = ParseProfileURL($profile_name); |
2884 my $binary_shortname = BaseName($binary_name); | 2993 my $binary_shortname = BaseName($binary_name); |
2885 return sprintf("%s.%s.%s-port%s", | 2994 return sprintf("%s.%s.%s", |
2886 $binary_shortname, $main::op_time, $host, $port); | 2995 $binary_shortname, $main::op_time, $host); |
2887 } | 2996 } |
2888 | 2997 |
2889 sub FetchDynamicProfile { | 2998 sub FetchDynamicProfile { |
2890 my $binary_name = shift; | 2999 my $binary_name = shift; |
2891 my $profile_name = shift; | 3000 my $profile_name = shift; |
2892 my $fetch_name_only = shift; | 3001 my $fetch_name_only = shift; |
2893 my $encourage_patience = shift; | 3002 my $encourage_patience = shift; |
2894 | 3003 |
2895 if (!IsProfileURL($profile_name)) { | 3004 if (!IsProfileURL($profile_name)) { |
2896 return $profile_name; | 3005 return $profile_name; |
2897 } else { | 3006 } else { |
2898 my ($host, $port, $prefix, $path) = ParseProfileURL($profile_name); | 3007 my ($host, $baseURL, $path) = ParseProfileURL($profile_name); |
2899 if ($path eq "" || $path eq "/") { | 3008 if ($path eq "" || $path eq "/") { |
2900 # Missing type specifier defaults to cpu-profile | 3009 # Missing type specifier defaults to cpu-profile |
2901 $path = $PROFILE_PAGE; | 3010 $path = $PROFILE_PAGE; |
2902 } | 3011 } |
2903 | 3012 |
2904 my $profile_file = MakeProfileBaseName($binary_name, $profile_name); | 3013 my $profile_file = MakeProfileBaseName($binary_name, $profile_name); |
2905 | 3014 |
2906 my $url; | 3015 my $url = "$baseURL$path"; |
2907 my $fetch_timeout = undef; | 3016 my $fetch_timeout = undef; |
2908 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) { | 3017 if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) { |
2909 if ($path =~ m/$PROFILE_PAGE/) { | 3018 if ($path =~ m/[?]/) { |
2910 $url = sprintf("http://$host:$port$prefix$path?seconds=%d", | 3019 $url .= "&"; |
2911 $main::opt_seconds); | |
2912 } else { | 3020 } else { |
2913 if ($profile_name =~ m/[?]/) { | 3021 $url .= "?"; |
2914 $profile_name .= "&" | |
2915 } else { | |
2916 $profile_name .= "?" | |
2917 } | |
2918 $url = sprintf("http://$profile_name" . "seconds=%d", | |
2919 $main::opt_seconds); | |
2920 } | 3022 } |
| 3023 $url .= sprintf("seconds=%d", $main::opt_seconds); |
2921 $fetch_timeout = $main::opt_seconds * 1.01 + 60; | 3024 $fetch_timeout = $main::opt_seconds * 1.01 + 60; |
2922 } else { | 3025 } else { |
2923 # For non-CPU profiles, we add a type-extension to | 3026 # For non-CPU profiles, we add a type-extension to |
2924 # the target profile file name. | 3027 # the target profile file name. |
2925 my $suffix = $path; | 3028 my $suffix = $path; |
2926 $suffix =~ s,/,.,g; | 3029 $suffix =~ s,/,.,g; |
2927 $profile_file .= "$suffix"; | 3030 $profile_file .= $suffix; |
2928 $url = "http://$host:$port$prefix$path"; | |
2929 } | 3031 } |
2930 | 3032 |
2931 my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof"); | 3033 my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof"); |
2932 if (!(-d $profile_dir)) { | 3034 if (! -d $profile_dir) { |
2933 mkdir($profile_dir) | 3035 mkdir($profile_dir) |
2934 || die("Unable to create profile directory $profile_dir: $!\n"); | 3036 || die("Unable to create profile directory $profile_dir: $!\n"); |
2935 } | 3037 } |
2936 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; | 3038 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; |
2937 my $real_profile = "$profile_dir/$profile_file"; | 3039 my $real_profile = "$profile_dir/$profile_file"; |
2938 | 3040 |
2939 if ($fetch_name_only > 0) { | 3041 if ($fetch_name_only > 0) { |
2940 return $real_profile; | 3042 return $real_profile; |
2941 } | 3043 } |
2942 | 3044 |
2943 my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout); | 3045 my $fetcher = AddFetchTimeout($URL_FETCHER, $fetch_timeout); |
2944 my $cmd = "$fetcher '$url' > '$tmp_profile'"; | 3046 my $cmd = "$fetcher '$url' > '$tmp_profile'"; |
2945 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){ | 3047 if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){ |
2946 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon
ds to\n ${real_profile}\n"; | 3048 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon
ds to\n ${real_profile}\n"; |
2947 if ($encourage_patience) { | 3049 if ($encourage_patience) { |
2948 print STDERR "Be patient...\n"; | 3050 print STDERR "Be patient...\n"; |
2949 } | 3051 } |
2950 } else { | 3052 } else { |
2951 print STDERR "Fetching $path profile from $host:$port to\n ${real_profile
}\n"; | 3053 print STDERR "Fetching $path profile from $url to\n ${real_profile}\n"; |
2952 } | 3054 } |
2953 | 3055 |
2954 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); | 3056 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); |
2955 (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename pr
ofile\n"); | 3057 (system("mv $tmp_profile $real_profile") == 0) || error("Unable to rename pr
ofile\n"); |
2956 print STDERR "Wrote profile to $real_profile\n"; | 3058 print STDERR "Wrote profile to $real_profile\n"; |
2957 $main::collected_profile = $real_profile; | 3059 $main::collected_profile = $real_profile; |
2958 return $main::collected_profile; | 3060 return $main::collected_profile; |
2959 } | 3061 } |
2960 } | 3062 } |
2961 | 3063 |
(...skipping 65 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
3027 BEGIN { | 3129 BEGIN { |
3028 package CpuProfileStream; | 3130 package CpuProfileStream; |
3029 | 3131 |
3030 sub new { | 3132 sub new { |
3031 my ($class, $file, $fname) = @_; | 3133 my ($class, $file, $fname) = @_; |
3032 my $self = { file => $file, | 3134 my $self = { file => $file, |
3033 base => 0, | 3135 base => 0, |
3034 stride => 512 * 1024, # must be a multiple of bitsize/8 | 3136 stride => 512 * 1024, # must be a multiple of bitsize/8 |
3035 slots => [], | 3137 slots => [], |
3036 unpack_code => "", # N for big-endian, V for little | 3138 unpack_code => "", # N for big-endian, V for little |
| 3139 perl_is_64bit => 1, # matters if profile is 64-bit |
3037 }; | 3140 }; |
3038 bless $self, $class; | 3141 bless $self, $class; |
3039 # Let unittests adjust the stride | 3142 # Let unittests adjust the stride |
3040 if ($main::opt_test_stride > 0) { | 3143 if ($main::opt_test_stride > 0) { |
3041 $self->{stride} = $main::opt_test_stride; | 3144 $self->{stride} = $main::opt_test_stride; |
3042 } | 3145 } |
3043 # Read the first two slots to figure out bitsize and endianness. | 3146 # Read the first two slots to figure out bitsize and endianness. |
3044 my $slots = $self->{slots}; | 3147 my $slots = $self->{slots}; |
3045 my $str; | 3148 my $str; |
3046 read($self->{file}, $str, 8); | 3149 read($self->{file}, $str, 8); |
3047 # Set the global $address_length based on what we see here. | 3150 # Set the global $address_length based on what we see here. |
3048 # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars). | 3151 # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars). |
3049 $address_length = ($str eq (chr(0)x8)) ? 16 : 8; | 3152 $address_length = ($str eq (chr(0)x8)) ? 16 : 8; |
3050 if ($address_length == 8) { | 3153 if ($address_length == 8) { |
3051 if (substr($str, 6, 2) eq chr(0)x2) { | 3154 if (substr($str, 6, 2) eq chr(0)x2) { |
3052 $self->{unpack_code} = 'V'; # Little-endian. | 3155 $self->{unpack_code} = 'V'; # Little-endian. |
3053 } elsif (substr($str, 4, 2) eq chr(0)x2) { | 3156 } elsif (substr($str, 4, 2) eq chr(0)x2) { |
3054 $self->{unpack_code} = 'N'; # Big-endian | 3157 $self->{unpack_code} = 'N'; # Big-endian |
3055 } else { | 3158 } else { |
3056 ::error("$fname: header size >= 2**16\n"); | 3159 ::error("$fname: header size >= 2**16\n"); |
3057 } | 3160 } |
3058 @$slots = unpack($self->{unpack_code} . "*", $str); | 3161 @$slots = unpack($self->{unpack_code} . "*", $str); |
3059 } else { | 3162 } else { |
3060 # If we're a 64-bit profile, make sure we're a 64-bit-capable | 3163 # If we're a 64-bit profile, check if we're a 64-bit-capable |
3061 # perl. Otherwise, each slot will be represented as a float | 3164 # perl. Otherwise, each slot will be represented as a float |
3062 # instead of an int64, losing precision and making all the | 3165 # instead of an int64, losing precision and making all the |
3063 # 64-bit addresses right. We *could* try to handle this with | 3166 # 64-bit addresses wrong. We won't complain yet, but will |
3064 # software emulation of 64-bit ints, but that's added complexity | 3167 # later if we ever see a value that doesn't fit in 32 bits. |
3065 # for no clear benefit (yet). We use 'Q' to test for 64-bit-ness; | |
3066 # perl docs say it's only available on 64-bit perl systems. | |
3067 my $has_q = 0; | 3168 my $has_q = 0; |
3068 eval { $has_q = pack("Q", "1") ? 1 : 1; }; | 3169 eval { $has_q = pack("Q", "1") ? 1 : 1; }; |
3069 if (!$has_q) { | 3170 if (!$has_q) { |
3070 ::error("$fname: need a 64-bit perl to process this 64-bit profile.\n"); | 3171 » $self->{perl_is_64bit} = 0; |
3071 } | 3172 } |
3072 read($self->{file}, $str, 8); | 3173 read($self->{file}, $str, 8); |
3073 if (substr($str, 4, 4) eq chr(0)x4) { | 3174 if (substr($str, 4, 4) eq chr(0)x4) { |
3074 # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. | 3175 # We'd love to use 'Q', but it's a) not universal, b) not endian-proof. |
3075 $self->{unpack_code} = 'V'; # Little-endian. | 3176 $self->{unpack_code} = 'V'; # Little-endian. |
3076 } elsif (substr($str, 0, 4) eq chr(0)x4) { | 3177 } elsif (substr($str, 0, 4) eq chr(0)x4) { |
3077 $self->{unpack_code} = 'N'; # Big-endian | 3178 $self->{unpack_code} = 'N'; # Big-endian |
3078 } else { | 3179 } else { |
3079 ::error("$fname: header size >= 2**32\n"); | 3180 ::error("$fname: header size >= 2**32\n"); |
3080 } | 3181 } |
(...skipping 15 matching lines...) Expand all Loading... |
3096 # This is the easy case: unpack provides 32-bit unpacking primitives. | 3197 # This is the easy case: unpack provides 32-bit unpacking primitives. |
3097 @$slots = unpack($self->{unpack_code} . "*", $str); | 3198 @$slots = unpack($self->{unpack_code} . "*", $str); |
3098 } else { | 3199 } else { |
3099 # We need to unpack 32 bits at a time and combine. | 3200 # We need to unpack 32 bits at a time and combine. |
3100 my @b32_values = unpack($self->{unpack_code} . "*", $str); | 3201 my @b32_values = unpack($self->{unpack_code} . "*", $str); |
3101 my @b64_values = (); | 3202 my @b64_values = (); |
3102 for (my $i = 0; $i < $#b32_values; $i += 2) { | 3203 for (my $i = 0; $i < $#b32_values; $i += 2) { |
3103 # TODO(csilvers): if this is a 32-bit perl, the math below | 3204 # TODO(csilvers): if this is a 32-bit perl, the math below |
3104 # could end up in a too-large int, which perl will promote | 3205 # could end up in a too-large int, which perl will promote |
3105 # to a double, losing necessary precision. Deal with that. | 3206 # to a double, losing necessary precision. Deal with that. |
3106 if ($self->{unpack_code} eq 'V') { # little-endian | 3207 » # Right now, we just die. |
3107 push(@b64_values, $b32_values[$i] + $b32_values[$i+1] * (2**32)); | 3208 » my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]); |
3108 } else { | 3209 if ($self->{unpack_code} eq 'N') { # big-endian |
3109 push(@b64_values, $b32_values[$i] * (2**32) + $b32_values[$i+1]); | 3210 » ($lo, $hi) = ($hi, $lo); |
3110 } | 3211 » } |
| 3212 » my $value = $lo + $hi * (2**32); |
| 3213 » if (!$self->{perl_is_64bit} && # check value is exactly represented |
| 3214 » (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) { |
| 3215 » ::error("Need a 64-bit perl to process this 64-bit profile.\n"); |
| 3216 » } |
| 3217 » push(@b64_values, $value); |
3111 } | 3218 } |
3112 @$slots = @b64_values; | 3219 @$slots = @b64_values; |
3113 } | 3220 } |
3114 } | 3221 } |
3115 | 3222 |
3116 # Access the i-th long in the file (logically), or -1 at EOF. | 3223 # Access the i-th long in the file (logically), or -1 at EOF. |
3117 sub get { | 3224 sub get { |
3118 my ($self, $idx) = @_; | 3225 my ($self, $idx) = @_; |
3119 my $slots = $self->{slots}; | 3226 my $slots = $self->{slots}; |
3120 while ($#$slots >= 0) { | 3227 while ($#$slots >= 0) { |
3121 if ($idx < $self->{base}) { | 3228 if ($idx < $self->{base}) { |
3122 # The only time we expect a reference to $slots[$i - something] | 3229 # The only time we expect a reference to $slots[$i - something] |
3123 # after referencing $slots[$i] is reading the very first header. | 3230 # after referencing $slots[$i] is reading the very first header. |
3124 # Since $stride > |header|, that shouldn't cause any lookback | 3231 # Since $stride > |header|, that shouldn't cause any lookback |
3125 # errors. And everything after the header is sequential. | 3232 # errors. And everything after the header is sequential. |
3126 print STDERR "Unexpected look-back reading CPU profile"; | 3233 print STDERR "Unexpected look-back reading CPU profile"; |
3127 return -1; # shrug, don't know what better to return | 3234 return -1; # shrug, don't know what better to return |
3128 } elsif ($idx > $self->{base} + $#$slots) { | 3235 } elsif ($idx > $self->{base} + $#$slots) { |
3129 $self->overflow(); | 3236 $self->overflow(); |
3130 } else { | 3237 } else { |
3131 return $slots->[$idx - $self->{base}]; | 3238 return $slots->[$idx - $self->{base}]; |
3132 } | 3239 } |
3133 } | 3240 } |
3134 # If we get here, $slots is [], which means we've reached EOF | 3241 # If we get here, $slots is [], which means we've reached EOF |
3135 return -1; # unique since slots is supposed to hold unsigned numbers | 3242 return -1; # unique since slots is supposed to hold unsigned numbers |
3136 } | 3243 } |
3137 } | 3244 } |
3138 | 3245 |
3139 # Return the next line from the profile file, assuming it's a text | 3246 # Reads the top, 'header' section of a profile, and returns the last |
3140 # line (which in this case means, doesn't start with a NUL byte). If | 3247 # line of the header, commonly called a 'header line'. The header |
3141 # it's not a text line, return "". At EOF, return undef, like perl does. | 3248 # section of a profile consists of zero or more 'command' lines that |
3142 # Input file should be in binmode. | 3249 # are instructions to pprof, which pprof executes when reading the |
3143 sub ReadProfileLine { | 3250 # header. All 'command' lines start with a %. After the command |
| 3251 # lines is the 'header line', which is a profile-specific line that |
| 3252 # indicates what type of profile it is, and perhaps other global |
| 3253 # information about the profile. For instance, here's a header line |
| 3254 # for a heap profile: |
| 3255 # heap profile: 53: 38236 [ 5525: 1284029] @ heapprofile |
| 3256 # For historical reasons, the CPU profile does not contain a text- |
| 3257 # readable header line. If the profile looks like a CPU profile, |
| 3258 # this function returns "". If no header line could be found, this |
| 3259 # function returns undef. |
| 3260 # |
| 3261 # The following commands are recognized: |
| 3262 # %warn -- emit the rest of this line to stderr, prefixed by 'WARNING:' |
| 3263 # |
| 3264 # The input file should be in binmode. |
| 3265 sub ReadProfileHeader { |
3144 local *PROFILE = shift; | 3266 local *PROFILE = shift; |
3145 my $firstchar = ""; | 3267 my $firstchar = ""; |
3146 my $line = ""; | 3268 my $line = ""; |
3147 read(PROFILE, $firstchar, 1); | 3269 read(PROFILE, $firstchar, 1); |
3148 seek(PROFILE, -1, 1); # unread the firstchar | 3270 seek(PROFILE, -1, 1); # unread the firstchar |
3149 if ($firstchar eq "\0") { | 3271 if ($firstchar !~ /[[:print:]]/) { # is not a text character |
3150 return ""; | 3272 return ""; |
3151 } | 3273 } |
3152 $line = <PROFILE>; | 3274 while (defined($line = <PROFILE>)) { |
3153 if (defined($line)) { | |
3154 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines | 3275 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines |
| 3276 if ($line =~ /^%warn\s+(.*)/) { # 'warn' command |
| 3277 # Note this matches both '%warn blah\n' and '%warn\n'. |
| 3278 print STDERR "WARNING: $1\n"; # print the rest of the line |
| 3279 } elsif ($line =~ /^%/) { |
| 3280 print STDERR "Ignoring unknown command from profile header: $line"; |
| 3281 } else { |
| 3282 # End of commands, must be the header line. |
| 3283 return $line; |
| 3284 } |
3155 } | 3285 } |
3156 return $line; | 3286 return undef; # got to EOF without seeing a header line |
3157 } | 3287 } |
3158 | 3288 |
3159 sub IsSymbolizedProfileFile { | 3289 sub IsSymbolizedProfileFile { |
3160 my $file_name = shift; | 3290 my $file_name = shift; |
3161 if (!(-e $file_name) || !(-r $file_name)) { | 3291 if (!(-e $file_name) || !(-r $file_name)) { |
3162 return 0; | 3292 return 0; |
3163 } | 3293 } |
3164 # Check if the file contains a symbol-section marker. | 3294 # Check if the file contains a symbol-section marker. |
3165 open(TFILE, "<$file_name"); | 3295 open(TFILE, "<$file_name"); |
3166 binmode TFILE; | 3296 binmode TFILE; |
3167 my $firstline = ReadProfileLine(*TFILE); | 3297 my $firstline = ReadProfileHeader(*TFILE); |
3168 close(TFILE); | 3298 close(TFILE); |
3169 if (!$firstline) { | 3299 if (!$firstline) { |
3170 return 0; | 3300 return 0; |
3171 } | 3301 } |
3172 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash | 3302 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash |
3173 my $symbol_marker = $&; | 3303 my $symbol_marker = $&; |
3174 return $firstline =~ /^--- *$symbol_marker/; | 3304 return $firstline =~ /^--- *$symbol_marker/; |
3175 } | 3305 } |
3176 | 3306 |
3177 # Parse profile generated by common/profiler.cc and return a reference | 3307 # Parse profile generated by common/profiler.cc and return a reference |
3178 # to a map: | 3308 # to a map: |
3179 # $result->{version} Version number of profile file | 3309 # $result->{version} Version number of profile file |
3180 # $result->{period} Sampling period (in microseconds) | 3310 # $result->{period} Sampling period (in microseconds) |
3181 # $result->{profile} Profile object | 3311 # $result->{profile} Profile object |
3182 # $result->{map} Memory map info from profile | 3312 # $result->{map} Memory map info from profile |
3183 # $result->{pcs} Hash of all PC values seen, key is hex address | 3313 # $result->{pcs} Hash of all PC values seen, key is hex address |
3184 sub ReadProfile { | 3314 sub ReadProfile { |
3185 my $prog = shift; | 3315 my $prog = shift; |
3186 my $fname = shift; | 3316 my $fname = shift; |
3187 | 3317 my $result; # return value |
3188 if (IsSymbolizedProfileFile($fname) && !$main::use_symbolized_profile) { | |
3189 # we have both a binary and symbolized profiles, abort | |
3190 usage("Symbolized profile '$fname' cannot be used with a binary arg. " . | |
3191 "Try again without passing '$prog'."); | |
3192 } | |
3193 | |
3194 $main::profile_type = ''; | |
3195 | 3318 |
3196 $CONTENTION_PAGE =~ m,[^/]+$,; # matches everything after the last slash | 3319 $CONTENTION_PAGE =~ m,[^/]+$,; # matches everything after the last slash |
3197 my $contention_marker = $&; | 3320 my $contention_marker = $&; |
3198 $GROWTH_PAGE =~ m,[^/]+$,; # matches everything after the last slash | 3321 $GROWTH_PAGE =~ m,[^/]+$,; # matches everything after the last slash |
3199 my $growth_marker = $&; | 3322 my $growth_marker = $&; |
3200 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash | 3323 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash |
3201 my $symbol_marker = $&; | 3324 my $symbol_marker = $&; |
3202 $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash | 3325 $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash |
3203 my $profile_marker = $&; | 3326 my $profile_marker = $&; |
3204 | 3327 |
3205 # Look at first line to see if it is a heap or a CPU profile. | 3328 # Look at first line to see if it is a heap or a CPU profile. |
3206 # CPU profile may start with no header at all, and just binary data | 3329 # CPU profile may start with no header at all, and just binary data |
3207 # (starting with \0\0\0\0) -- in that case, don't try to read the | 3330 # (starting with \0\0\0\0) -- in that case, don't try to read the |
3208 # whole firstline, since it may be gigabytes(!) of data. | 3331 # whole firstline, since it may be gigabytes(!) of data. |
3209 open(PROFILE, "<$fname") || error("$fname: $!\n"); | 3332 open(PROFILE, "<$fname") || error("$fname: $!\n"); |
3210 binmode PROFILE; # New perls do UTF-8 processing | 3333 binmode PROFILE; # New perls do UTF-8 processing |
3211 my $header = ReadProfileLine(*PROFILE); | 3334 my $header = ReadProfileHeader(*PROFILE); |
3212 if (!defined($header)) { # means "at EOF" | 3335 if (!defined($header)) { # means "at EOF" |
3213 error("Profile is empty.\n"); | 3336 error("Profile is empty.\n"); |
3214 } | 3337 } |
3215 | 3338 |
3216 my $symbols; | 3339 my $symbols; |
3217 if ($header =~ m/^--- *$symbol_marker/o) { | 3340 if ($header =~ m/^--- *$symbol_marker/o) { |
| 3341 # Verify that the user asked for a symbolized profile |
| 3342 if (!$main::use_symbolized_profile) { |
| 3343 # we have both a binary and symbolized profiles, abort |
| 3344 error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " . |
| 3345 "a binary arg. Try again without passing\n $prog\n"); |
| 3346 } |
3218 # Read the symbol section of the symbolized profile file. | 3347 # Read the symbol section of the symbolized profile file. |
3219 $symbols = ReadSymbols(*PROFILE{IO}); | 3348 $symbols = ReadSymbols(*PROFILE{IO}); |
3220 # Read the next line to get the header for the remaining profile. | 3349 # Read the next line to get the header for the remaining profile. |
3221 $header = ReadProfileLine(*PROFILE) || ""; | 3350 $header = ReadProfileHeader(*PROFILE) || ""; |
3222 } | 3351 } |
3223 | 3352 |
3224 my $result; | 3353 $main::profile_type = ''; |
3225 | |
3226 if ($header =~ m/^heap profile:.*$growth_marker/o) { | 3354 if ($header =~ m/^heap profile:.*$growth_marker/o) { |
3227 $main::profile_type = 'growth'; | 3355 $main::profile_type = 'growth'; |
3228 $result = ReadHeapProfile($prog, $fname, $header); | 3356 $result = ReadHeapProfile($prog, *PROFILE, $header); |
3229 } elsif ($header =~ m/^heap profile:/) { | 3357 } elsif ($header =~ m/^heap profile:/) { |
3230 $main::profile_type = 'heap'; | 3358 $main::profile_type = 'heap'; |
3231 $result = ReadHeapProfile($prog, $fname, $header); | 3359 $result = ReadHeapProfile($prog, *PROFILE, $header); |
3232 } elsif ($header =~ m/^--- *$contention_marker/o) { | 3360 } elsif ($header =~ m/^--- *$contention_marker/o) { |
3233 $main::profile_type = 'contention'; | 3361 $main::profile_type = 'contention'; |
3234 $result = ReadSynchProfile($prog, $fname); | 3362 $result = ReadSynchProfile($prog, *PROFILE); |
3235 } elsif ($header =~ m/^--- *Stacks:/) { | 3363 } elsif ($header =~ m/^--- *Stacks:/) { |
3236 print STDERR | 3364 print STDERR |
3237 "Old format contention profile: mistakenly reports " . | 3365 "Old format contention profile: mistakenly reports " . |
3238 "condition variable signals as lock contentions.\n"; | 3366 "condition variable signals as lock contentions.\n"; |
3239 $main::profile_type = 'contention'; | 3367 $main::profile_type = 'contention'; |
3240 $result = ReadSynchProfile($prog, $fname); | 3368 $result = ReadSynchProfile($prog, *PROFILE); |
3241 } elsif ($header =~ m/^--- *$profile_marker/) { | 3369 } elsif ($header =~ m/^--- *$profile_marker/) { |
3242 # the binary cpu profile data starts immediately after this line | 3370 # the binary cpu profile data starts immediately after this line |
3243 $main::profile_type = 'cpu'; | 3371 $main::profile_type = 'cpu'; |
3244 $result = ReadCPUProfile($prog, $fname); | 3372 $result = ReadCPUProfile($prog, $fname, *PROFILE); |
3245 } else { | 3373 } else { |
3246 if (defined($symbols)) { | 3374 if (defined($symbols)) { |
3247 # a symbolized profile contains a format we don't recognize, bail out | 3375 # a symbolized profile contains a format we don't recognize, bail out |
3248 error("$fname: Cannot recognize profile section after symbols.\n"); | 3376 error("$fname: Cannot recognize profile section after symbols.\n"); |
3249 } | 3377 } |
3250 # no ascii header present -- must be a CPU profile | 3378 # no ascii header present -- must be a CPU profile |
3251 $main::profile_type = 'cpu'; | 3379 $main::profile_type = 'cpu'; |
3252 $result = ReadCPUProfile($prog, $fname); | 3380 $result = ReadCPUProfile($prog, $fname, *PROFILE); |
3253 } | 3381 } |
3254 | 3382 |
| 3383 close(PROFILE); |
| 3384 |
3255 # if we got symbols along with the profile, return those as well | 3385 # if we got symbols along with the profile, return those as well |
3256 if (defined($symbols)) { | 3386 if (defined($symbols)) { |
3257 $result->{symbols} = $symbols; | 3387 $result->{symbols} = $symbols; |
3258 } | 3388 } |
3259 | 3389 |
3260 return $result; | 3390 return $result; |
3261 } | 3391 } |
3262 | 3392 |
3263 # Subtract one from caller pc so we map back to call instr. | 3393 # Subtract one from caller pc so we map back to call instr. |
3264 # However, don't do this if we're reading a symbolized profile | 3394 # However, don't do this if we're reading a symbolized profile |
(...skipping 18 matching lines...) Expand all Loading... |
3283 for (my $i = 1; $i <= $#addrs; $i++) { | 3413 for (my $i = 1; $i <= $#addrs; $i++) { |
3284 $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1"); | 3414 $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1"); |
3285 } | 3415 } |
3286 return join $delimiter, @fixedaddrs; | 3416 return join $delimiter, @fixedaddrs; |
3287 } | 3417 } |
3288 } | 3418 } |
3289 | 3419 |
3290 # CPU profile reader | 3420 # CPU profile reader |
3291 sub ReadCPUProfile { | 3421 sub ReadCPUProfile { |
3292 my $prog = shift; | 3422 my $prog = shift; |
3293 my $fname = shift; | 3423 my $fname = shift; # just used for logging |
| 3424 local *PROFILE = shift; |
3294 my $version; | 3425 my $version; |
3295 my $period; | 3426 my $period; |
3296 my $i; | 3427 my $i; |
3297 my $profile = {}; | 3428 my $profile = {}; |
3298 my $pcs = {}; | 3429 my $pcs = {}; |
3299 | 3430 |
3300 # Parse string into array of slots. | 3431 # Parse string into array of slots. |
3301 my $slots = CpuProfileStream->new(*PROFILE, $fname); | 3432 my $slots = CpuProfileStream->new(*PROFILE, $fname); |
3302 | 3433 |
3303 # Read header. The current header version is a 5-element structure | 3434 # Read header. The current header version is a 5-element structure |
(...skipping 46 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
3350 } | 3481 } |
3351 | 3482 |
3352 AddEntry($profile, (join "\n", @k), $n); | 3483 AddEntry($profile, (join "\n", @k), $n); |
3353 $i += $d; | 3484 $i += $d; |
3354 } | 3485 } |
3355 | 3486 |
3356 # Parse map | 3487 # Parse map |
3357 my $map = ''; | 3488 my $map = ''; |
3358 seek(PROFILE, $i * 4, 0); | 3489 seek(PROFILE, $i * 4, 0); |
3359 read(PROFILE, $map, (stat PROFILE)[7]); | 3490 read(PROFILE, $map, (stat PROFILE)[7]); |
3360 close(PROFILE); | |
3361 | 3491 |
3362 my $r = {}; | 3492 my $r = {}; |
3363 $r->{version} = $version; | 3493 $r->{version} = $version; |
3364 $r->{period} = $period; | 3494 $r->{period} = $period; |
3365 $r->{profile} = $profile; | 3495 $r->{profile} = $profile; |
3366 $r->{libs} = ParseLibraries($prog, $map, $pcs); | 3496 $r->{libs} = ParseLibraries($prog, $map, $pcs); |
3367 $r->{pcs} = $pcs; | 3497 $r->{pcs} = $pcs; |
3368 | 3498 |
3369 return $r; | 3499 return $r; |
3370 } | 3500 } |
3371 | 3501 |
3372 sub ReadHeapProfile { | 3502 sub ReadHeapProfile { |
3373 my $prog = shift; | 3503 my $prog = shift; |
3374 my $fname = shift; | 3504 local *PROFILE = shift; |
3375 my $header = shift; | 3505 my $header = shift; |
3376 | 3506 |
3377 my $index = 1; | 3507 my $index = 1; |
3378 if ($main::opt_inuse_space) { | 3508 if ($main::opt_inuse_space) { |
3379 $index = 1; | 3509 $index = 1; |
3380 } elsif ($main::opt_inuse_objects) { | 3510 } elsif ($main::opt_inuse_objects) { |
3381 $index = 0; | 3511 $index = 0; |
3382 } elsif ($main::opt_alloc_space) { | 3512 } elsif ($main::opt_alloc_space) { |
3383 $index = 3; | 3513 $index = 3; |
3384 } elsif ($main::opt_alloc_objects) { | 3514 } elsif ($main::opt_alloc_objects) { |
(...skipping 121 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
3506 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { | 3636 if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) { |
3507 my $stack = $5; | 3637 my $stack = $5; |
3508 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); | 3638 my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4); |
3509 | 3639 |
3510 if ($sample_adjustment) { | 3640 if ($sample_adjustment) { |
3511 if ($sampling_algorithm == 2) { | 3641 if ($sampling_algorithm == 2) { |
3512 # Remote-heap version 2 | 3642 # Remote-heap version 2 |
3513 # The sampling frequency is the rate of a Poisson process. | 3643 # The sampling frequency is the rate of a Poisson process. |
3514 # This means that the probability of sampling an allocation of | 3644 # This means that the probability of sampling an allocation of |
3515 # size X with sampling rate Y is 1 - exp(-X/Y) | 3645 # size X with sampling rate Y is 1 - exp(-X/Y) |
3516 my $ratio; | 3646 » if ($n1 != 0) { |
3517 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); | 3647 » my $ratio = (($s1*1.0)/$n1)/($sample_adjustment); |
3518 my $scale_factor; | 3648 » my $scale_factor = 1/(1 - exp(-$ratio)); |
3519 $scale_factor = 1/(1 - exp(-$ratio)); | 3649 » $n1 *= $scale_factor; |
3520 $n1 *= $scale_factor; | 3650 » $s1 *= $scale_factor; |
3521 $s1 *= $scale_factor; | 3651 » } |
3522 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); | 3652 » if ($n2 != 0) { |
3523 $scale_factor = 1/(1 - exp(-$ratio)); | 3653 » my $ratio = (($s2*1.0)/$n2)/($sample_adjustment); |
3524 $n2 *= $scale_factor; | 3654 » my $scale_factor = 1/(1 - exp(-$ratio)); |
3525 $s2 *= $scale_factor; | 3655 » $n2 *= $scale_factor; |
| 3656 » $s2 *= $scale_factor; |
| 3657 » } |
3526 } else { | 3658 } else { |
3527 # Remote-heap version 1 | 3659 # Remote-heap version 1 |
3528 my $ratio; | 3660 my $ratio; |
3529 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); | 3661 $ratio = (($s1*1.0)/$n1)/($sample_adjustment); |
3530 if ($ratio < 1) { | 3662 if ($ratio < 1) { |
3531 $n1 /= $ratio; | 3663 $n1 /= $ratio; |
3532 $s1 /= $ratio; | 3664 $s1 /= $ratio; |
3533 } | 3665 } |
3534 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); | 3666 $ratio = (($s2*1.0)/$n2)/($sample_adjustment); |
3535 if ($ratio < 1) { | 3667 if ($ratio < 1) { |
(...skipping 11 matching lines...) Expand all Loading... |
3547 my $r = {}; | 3679 my $r = {}; |
3548 $r->{version} = "heap"; | 3680 $r->{version} = "heap"; |
3549 $r->{period} = 1; | 3681 $r->{period} = 1; |
3550 $r->{profile} = $profile; | 3682 $r->{profile} = $profile; |
3551 $r->{libs} = ParseLibraries($prog, $map, $pcs); | 3683 $r->{libs} = ParseLibraries($prog, $map, $pcs); |
3552 $r->{pcs} = $pcs; | 3684 $r->{pcs} = $pcs; |
3553 return $r; | 3685 return $r; |
3554 } | 3686 } |
3555 | 3687 |
3556 sub ReadSynchProfile { | 3688 sub ReadSynchProfile { |
3557 my ($prog, $fname, $header) = @_; | 3689 my $prog = shift; |
| 3690 local *PROFILE = shift; |
| 3691 my $header = shift; |
3558 | 3692 |
3559 my $map = ''; | 3693 my $map = ''; |
3560 my $profile = {}; | 3694 my $profile = {}; |
3561 my $pcs = {}; | 3695 my $pcs = {}; |
3562 my $sampling_period = 1; | 3696 my $sampling_period = 1; |
3563 my $cyclespernanosec = 2.8; # Default assumption for old binaries | 3697 my $cyclespernanosec = 2.8; # Default assumption for old binaries |
3564 my $seen_clockrate = 0; | 3698 my $seen_clockrate = 0; |
3565 my $line; | 3699 my $line; |
3566 | 3700 |
3567 my $index = 0; | 3701 my $index = 0; |
(...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
3622 # So we just silently ignore it for now | 3756 # So we just silently ignore it for now |
3623 } else { | 3757 } else { |
3624 printf STDERR ("Ignoring unnknown variable in /contention output: " . | 3758 printf STDERR ("Ignoring unnknown variable in /contention output: " . |
3625 "'%s' = '%s'\n",$variable,$value); | 3759 "'%s' = '%s'\n",$variable,$value); |
3626 } | 3760 } |
3627 } else { | 3761 } else { |
3628 # Memory map entry | 3762 # Memory map entry |
3629 $map .= $line; | 3763 $map .= $line; |
3630 } | 3764 } |
3631 } | 3765 } |
3632 close PROFILE; | |
3633 | 3766 |
3634 if (!$seen_clockrate) { | 3767 if (!$seen_clockrate) { |
3635 printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n", | 3768 printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n", |
3636 $cyclespernanosec); | 3769 $cyclespernanosec); |
3637 } | 3770 } |
3638 | 3771 |
3639 my $r = {}; | 3772 my $r = {}; |
3640 $r->{version} = 0; | 3773 $r->{version} = 0; |
3641 $r->{period} = $sampling_period; | 3774 $r->{period} = $sampling_period; |
3642 $r->{profile} = $profile; | 3775 $r->{profile} = $profile; |
(...skipping 423 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
4066 } | 4199 } |
4067 } | 4200 } |
4068 | 4201 |
4069 # Extract symbols for all PC values found in profile | 4202 # Extract symbols for all PC values found in profile |
4070 sub ExtractSymbols { | 4203 sub ExtractSymbols { |
4071 my $libs = shift; | 4204 my $libs = shift; |
4072 my $pcset = shift; | 4205 my $pcset = shift; |
4073 | 4206 |
4074 my $symbols = {}; | 4207 my $symbols = {}; |
4075 | 4208 |
4076 # Map each PC value to the containing library | 4209 # Map each PC value to the containing library. To make this faster, |
4077 my %seen = (); | 4210 # we sort libraries by their starting pc value (highest first), and |
4078 foreach my $lib (@{$libs}) { | 4211 # advance through the libraries as we advance the pc. Sometimes the |
| 4212 # addresses of libraries may overlap with the addresses of the main |
| 4213 # binary, so to make sure the libraries 'win', we iterate over the |
| 4214 # libraries in reverse order (which assumes the binary doesn't start |
| 4215 # in the middle of a library, which seems a fair assumption). |
| 4216 my @pcs = (sort { $a cmp $b } keys(%{$pcset})); # pcset is 0-extended strings |
| 4217 foreach my $lib (sort {$b->[1] cmp $a->[1]} @{$libs}) { |
4079 my $libname = $lib->[0]; | 4218 my $libname = $lib->[0]; |
4080 my $start = $lib->[1]; | 4219 my $start = $lib->[1]; |
4081 my $finish = $lib->[2]; | 4220 my $finish = $lib->[2]; |
4082 my $offset = $lib->[3]; | 4221 my $offset = $lib->[3]; |
4083 | 4222 |
4084 # Get list of pcs that belong in this library. | 4223 # Get list of pcs that belong in this library. |
4085 my $contained = []; | 4224 my $contained = []; |
4086 foreach my $pc (keys(%{$pcset})) { | 4225 my ($start_pc_index, $finish_pc_index); |
4087 if (!$seen{$pc} && ($pc ge $start) && ($pc le $finish)) { | 4226 # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index]. |
4088 $seen{$pc} = 1; | 4227 for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0; |
4089 push(@{$contained}, $pc); | 4228 » $finish_pc_index--) { |
4090 } | 4229 last if $pcs[$finish_pc_index - 1] le $finish; |
4091 } | 4230 } |
| 4231 # Find smallest start_pc_index such that $start <= $pc[$start_pc_index]. |
| 4232 for ($start_pc_index = $finish_pc_index; $start_pc_index > 0; |
| 4233 $start_pc_index--) { |
| 4234 last if $pcs[$start_pc_index - 1] lt $start; |
| 4235 } |
| 4236 # This keeps PC values higher than $pc[$finish_pc_index] in @pcs, |
| 4237 # in case there are overlaps in libraries and the main binary. |
| 4238 @{$contained} = splice(@pcs, $start_pc_index, |
| 4239 $finish_pc_index - $start_pc_index); |
4092 # Map to symbols | 4240 # Map to symbols |
4093 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); | 4241 MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols); |
4094 } | 4242 } |
4095 | 4243 |
4096 return $symbols; | 4244 return $symbols; |
4097 } | 4245 } |
4098 | 4246 |
4099 # Map list of PC values to symbols for a given image | 4247 # Map list of PC values to symbols for a given image |
4100 sub MapToSymbols { | 4248 sub MapToSymbols { |
4101 my $image = shift; | 4249 my $image = shift; |
4102 my $offset = shift; | 4250 my $offset = shift; |
4103 my $pclist = shift; | 4251 my $pclist = shift; |
4104 my $symbols = shift; | 4252 my $symbols = shift; |
4105 | 4253 |
4106 my $debug = 0; | 4254 my $debug = 0; |
4107 | 4255 |
4108 # Ignore empty binaries | 4256 # Ignore empty binaries |
4109 if ($#{$pclist} < 0) { return; } | 4257 if ($#{$pclist} < 0) { return; } |
4110 | 4258 |
4111 # Figure out the addr2line command to use | 4259 # Figure out the addr2line command to use |
4112 my $addr2line = $obj_tool_map{"addr2line"}; | 4260 my $addr2line = $obj_tool_map{"addr2line"}; |
4113 my $cmd = "$addr2line -f -C -e $image"; | 4261 my $cmd = "$addr2line -f -C -e $image"; |
4114 if (exists $obj_tool_map{"addr2line_pdb"}) { | 4262 if (exists $obj_tool_map{"addr2line_pdb"}) { |
4115 $addr2line = $obj_tool_map{"addr2line_pdb"}; | 4263 $addr2line = $obj_tool_map{"addr2line_pdb"}; |
4116 $cmd = "$addr2line --demangle -f -C -e $image"; | 4264 $cmd = "$addr2line --demangle -f -C -e $image"; |
4117 } | 4265 } |
4118 | 4266 |
4119 # If "addr2line" isn't installed on the system at all, just use | 4267 # If "addr2line" isn't installed on the system at all, just use |
4120 # nm to get what info we can (function names, but not line numbers). | 4268 # nm to get what info we can (function names, but not line numbers). |
4121 if (system("$addr2line --help >/dev/null 2>&1") != 0) { | 4269 if (system("$addr2line --help >$dev_null 2>&1") != 0) { |
4122 MapSymbolsWithNM($image, $offset, $pclist, $symbols); | 4270 MapSymbolsWithNM($image, $offset, $pclist, $symbols); |
4123 return; | 4271 return; |
4124 } | 4272 } |
4125 | 4273 |
4126 # "addr2line -i" can produce a variable number of lines per input | 4274 # "addr2line -i" can produce a variable number of lines per input |
4127 # address, with no separator that allows us to tell when data for | 4275 # address, with no separator that allows us to tell when data for |
4128 # the next address starts. So we find the address for a special | 4276 # the next address starts. So we find the address for a special |
4129 # symbol (_fini) and interleave this address between all real | 4277 # symbol (_fini) and interleave this address between all real |
4130 # addresses passed to addr2line. The name of this special symbol | 4278 # addresses passed to addr2line. The name of this special symbol |
4131 # can then be used as a separator. | 4279 # can then be used as a separator. |
4132 $sep_address = undef; # May be filled in by MapSymbolsWithNM() | 4280 $sep_address = undef; # May be filled in by MapSymbolsWithNM() |
4133 my $nm_symbols = {}; | 4281 my $nm_symbols = {}; |
4134 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); | 4282 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols); |
4135 # TODO(csilvers): only add '-i' if addr2line supports it. | 4283 # TODO(csilvers): only add '-i' if addr2line supports it. |
4136 if (defined($sep_address)) { | 4284 if (defined($sep_address)) { |
4137 # Only add " -i" to addr2line if the binary supports it. | 4285 # Only add " -i" to addr2line if the binary supports it. |
4138 # addr2line --help returns 0, but not if it sees an unknown flag first. | 4286 # addr2line --help returns 0, but not if it sees an unknown flag first. |
4139 if (system("$cmd -i --help >/dev/null 2>&1") == 0) { | 4287 if (system("$cmd -i --help >$dev_null 2>&1") == 0) { |
4140 $cmd .= " -i"; | 4288 $cmd .= " -i"; |
4141 } else { | 4289 } else { |
4142 $sep_address = undef; # no need for sep_address if we don't support -i | 4290 $sep_address = undef; # no need for sep_address if we don't support -i |
4143 } | 4291 } |
4144 } | 4292 } |
4145 | 4293 |
4146 # Make file with all PC values with intervening 'sep_address' so | 4294 # Make file with all PC values with intervening 'sep_address' so |
4147 # that we can reliably detect the end of inlined function list | 4295 # that we can reliably detect the end of inlined function list |
4148 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); | 4296 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n"); |
4149 if ($debug) { print("---- $image ---\n"); } | 4297 if ($debug) { print("---- $image ---\n"); } |
(...skipping 125 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
4275 # 1) --tools option, if set | 4423 # 1) --tools option, if set |
4276 # 2) PPROF_TOOLS environment variable, if set | 4424 # 2) PPROF_TOOLS environment variable, if set |
4277 # 3) the environment | 4425 # 3) the environment |
4278 sub ConfigureObjTools { | 4426 sub ConfigureObjTools { |
4279 my $prog_file = shift; | 4427 my $prog_file = shift; |
4280 | 4428 |
4281 # Check for the existence of $prog_file because /usr/bin/file does not | 4429 # Check for the existence of $prog_file because /usr/bin/file does not |
4282 # predictably return error status in prod. | 4430 # predictably return error status in prod. |
4283 (-e $prog_file) || error("$prog_file does not exist.\n"); | 4431 (-e $prog_file) || error("$prog_file does not exist.\n"); |
4284 | 4432 |
4285 # Follow symlinks (at least for systems where "file" supports that) | 4433 my $file_type = undef; |
4286 my $file_type = `/usr/bin/file -L $prog_file 2>/dev/null || /usr/bin/file $pro
g_file`; | 4434 if (-e "/usr/bin/file") { |
| 4435 # Follow symlinks (at least for systems where "file" supports that). |
| 4436 $file_type = `/usr/bin/file -L $prog_file 2>$dev_null || /usr/bin/file $prog
_file`; |
| 4437 } elsif ($^O == "MSWin32") { |
| 4438 $file_type = "MS Windows"; |
| 4439 } else { |
| 4440 print STDERR "WARNING: Can't determine the file type of $prog_file"; |
| 4441 } |
| 4442 |
4287 if ($file_type =~ /64-bit/) { | 4443 if ($file_type =~ /64-bit/) { |
4288 # Change $address_length to 16 if the program file is ELF 64-bit. | 4444 # Change $address_length to 16 if the program file is ELF 64-bit. |
4289 # We can't detect this from many (most?) heap or lock contention | 4445 # We can't detect this from many (most?) heap or lock contention |
4290 # profiles, since the actual addresses referenced are generally in low | 4446 # profiles, since the actual addresses referenced are generally in low |
4291 # memory even for 64-bit programs. | 4447 # memory even for 64-bit programs. |
4292 $address_length = 16; | 4448 $address_length = 16; |
4293 } | 4449 } |
4294 | 4450 |
4295 if ($file_type =~ /MS Windows/) { | 4451 if ($file_type =~ /MS Windows/) { |
4296 # For windows, we provide a version of nm and addr2line as part of | 4452 # For windows, we provide a version of nm and addr2line as part of |
(...skipping 18 matching lines...) Expand all Loading... |
4315 } | 4471 } |
4316 | 4472 |
4317 # Returns the path of a caller-specified object tool. If --tools or | 4473 # Returns the path of a caller-specified object tool. If --tools or |
4318 # PPROF_TOOLS are specified, then returns the full path to the tool | 4474 # PPROF_TOOLS are specified, then returns the full path to the tool |
4319 # with that prefix. Otherwise, returns the path unmodified (which | 4475 # with that prefix. Otherwise, returns the path unmodified (which |
4320 # means we will look for it on PATH). | 4476 # means we will look for it on PATH). |
4321 sub ConfigureTool { | 4477 sub ConfigureTool { |
4322 my $tool = shift; | 4478 my $tool = shift; |
4323 my $path; | 4479 my $path; |
4324 | 4480 |
4325 if ($main::opt_tools ne "") { | 4481 # --tools (or $PPROF_TOOLS) is a comma separated list, where each |
4326 # Use a prefix specified by the --tools option... | 4482 # item is either a) a pathname prefix, or b) a map of the form |
4327 $path = $main::opt_tools . $tool; | 4483 # <tool>:<path>. First we look for an entry of type (b) for our |
4328 if (!-x $path) { | 4484 # tool. If one is found, we use it. Otherwise, we consider all the |
4329 error("No '$tool' found with prefix specified by --tools $main::opt_tools\
n"); | 4485 # pathname prefixes in turn, until one yields an existing file. If |
| 4486 # none does, we use a default path. |
| 4487 my $tools = $main::opt_tools || $ENV{"PPROF_TOOLS"} || ""; |
| 4488 if ($tools =~ m/(,|^)\Q$tool\E:([^,]*)/) { |
| 4489 $path = $2; |
| 4490 # TODO(csilvers): sanity-check that $path exists? Hard if it's relative. |
| 4491 } elsif ($tools ne '') { |
| 4492 foreach my $prefix (split(',', $tools)) { |
| 4493 next if ($prefix =~ /:/); # ignore "tool:fullpath" entries in the list |
| 4494 if (-x $prefix . $tool) { |
| 4495 $path = $prefix . $tool; |
| 4496 last; |
| 4497 } |
4330 } | 4498 } |
4331 } elsif (exists $ENV{"PPROF_TOOLS"} && | 4499 if (!$path) { |
4332 $ENV{"PPROF_TOOLS"} ne "") { | 4500 error("No '$tool' found with prefix specified by " . |
4333 #... or specified with the PPROF_TOOLS environment variable... | 4501 "--tools (or \$PPROF_TOOLS) '$tools'\n"); |
4334 $path = $ENV{"PPROF_TOOLS"} . $tool; | |
4335 if (!-x $path) { | |
4336 error("No '$tool' found with prefix specified by PPROF_TOOLS=$ENV{PPROF_TO
OLS}\n"); | |
4337 } | 4502 } |
4338 } else { | 4503 } else { |
4339 # ... otherwise use the version that exists in the same directory as | 4504 # ... otherwise use the version that exists in the same directory as |
4340 # pprof. If there's nothing there, use $PATH. | 4505 # pprof. If there's nothing there, use $PATH. |
4341 $0 =~ m,[^/]*$,; # this is everything after the last slash | 4506 $0 =~ m,[^/]*$,; # this is everything after the last slash |
4342 my $dirname = $`; # this is everything up to and including the last slash | 4507 my $dirname = $`; # this is everything up to and including the last slash |
4343 if (-x "$dirname$tool") { | 4508 if (-x "$dirname$tool") { |
4344 $path = "$dirname$tool"; | 4509 $path = "$dirname$tool"; |
4345 } else { | 4510 } else { |
4346 $path = $tool; | 4511 $path = $tool; |
(...skipping 132 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
4479 my $cppfilt = $obj_tool_map{"c++filt"}; | 4644 my $cppfilt = $obj_tool_map{"c++filt"}; |
4480 | 4645 |
4481 # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm | 4646 # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm |
4482 # binary doesn't support --demangle. In addition, for OS X we need | 4647 # binary doesn't support --demangle. In addition, for OS X we need |
4483 # to use the -f flag to get 'flat' nm output (otherwise we don't sort | 4648 # to use the -f flag to get 'flat' nm output (otherwise we don't sort |
4484 # properly and get incorrect results). Unfortunately, GNU nm uses -f | 4649 # properly and get incorrect results). Unfortunately, GNU nm uses -f |
4485 # in an incompatible way. So first we test whether our nm supports | 4650 # in an incompatible way. So first we test whether our nm supports |
4486 # --demangle and -f. | 4651 # --demangle and -f. |
4487 my $demangle_flag = ""; | 4652 my $demangle_flag = ""; |
4488 my $cppfilt_flag = ""; | 4653 my $cppfilt_flag = ""; |
4489 if (system("$nm --demangle $image >/dev/null 2>&1") == 0) { | 4654 if (system("$nm --demangle $image >$dev_null 2>&1") == 0) { |
4490 # In this mode, we do "nm --demangle <foo>" | 4655 # In this mode, we do "nm --demangle <foo>" |
4491 $demangle_flag = "--demangle"; | 4656 $demangle_flag = "--demangle"; |
4492 $cppfilt_flag = ""; | 4657 $cppfilt_flag = ""; |
4493 } elsif (system("$cppfilt $image >/dev/null 2>&1") == 0) { | 4658 } elsif (system("$cppfilt $image >$dev_null 2>&1") == 0) { |
4494 # In this mode, we do "nm <foo> | c++filt" | 4659 # In this mode, we do "nm <foo> | c++filt" |
4495 $cppfilt_flag = " | $cppfilt"; | 4660 $cppfilt_flag = " | $cppfilt"; |
4496 }; | 4661 }; |
4497 my $flatten_flag = ""; | 4662 my $flatten_flag = ""; |
4498 if (system("$nm -f $image >/dev/null 2>&1") == 0) { | 4663 if (system("$nm -f $image >$dev_null 2>&1") == 0) { |
4499 $flatten_flag = "-f"; | 4664 $flatten_flag = "-f"; |
4500 } | 4665 } |
4501 | 4666 |
4502 # Finally, in the case $imagie isn't a debug library, we try again with | 4667 # Finally, in the case $imagie isn't a debug library, we try again with |
4503 # -D to at least get *exported* symbols. If we can't use --demangle, | 4668 # -D to at least get *exported* symbols. If we can't use --demangle, |
4504 # we use c++filt instead, if it exists on this system. | 4669 # we use c++filt instead, if it exists on this system. |
4505 my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" . | 4670 my @nm_commands = ("$nm -n $flatten_flag $demangle_flag" . |
4506 " $image 2>/dev/null $cppfilt_flag", | 4671 " $image 2>$dev_null $cppfilt_flag", |
4507 "$nm -D -n $flatten_flag $demangle_flag" . | 4672 "$nm -D -n $flatten_flag $demangle_flag" . |
4508 " $image 2>/dev/null $cppfilt_flag", | 4673 " $image 2>$dev_null $cppfilt_flag", |
4509 # 6nm is for Go binaries | 4674 # 6nm is for Go binaries |
4510 » » "6nm $image 2>/dev/null | sort", | 4675 » » "6nm $image 2>$dev_null | sort", |
4511 ); | 4676 ); |
4512 | 4677 |
4513 # If the executable is an MS Windows PDB-format executable, we'll | 4678 # If the executable is an MS Windows PDB-format executable, we'll |
4514 # have set up obj_tool_map("nm_pdb"). In this case, we actually | 4679 # have set up obj_tool_map("nm_pdb"). In this case, we actually |
4515 # want to use both unix nm and windows-specific nm_pdb, since | 4680 # want to use both unix nm and windows-specific nm_pdb, since |
4516 # PDB-format executables can apparently include dwarf .o files. | 4681 # PDB-format executables can apparently include dwarf .o files. |
4517 if (exists $obj_tool_map{"nm_pdb"}) { | 4682 if (exists $obj_tool_map{"nm_pdb"}) { |
4518 my $nm_pdb = $obj_tool_map{"nm_pdb"}; | 4683 my $nm_pdb = $obj_tool_map{"nm_pdb"}; |
4519 push(@nm_commands, "$nm_pdb --demangle $image 2>/dev/null"); | 4684 push(@nm_commands, "$nm_pdb --demangle $image 2>$dev_null"); |
4520 } | 4685 } |
4521 | 4686 |
4522 foreach my $nm_command (@nm_commands) { | 4687 foreach my $nm_command (@nm_commands) { |
4523 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); | 4688 my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp); |
4524 return $symbol_table if (%{$symbol_table}); | 4689 return $symbol_table if (%{$symbol_table}); |
4525 } | 4690 } |
4526 my $symbol_table = {}; | 4691 my $symbol_table = {}; |
4527 return $symbol_table; | 4692 return $symbol_table; |
4528 } | 4693 } |
4529 | 4694 |
(...skipping 204 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
4734 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); | 4899 $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16); |
4735 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); | 4900 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); |
4736 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); | 4901 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); |
4737 if ($error_count > 0) { | 4902 if ($error_count > 0) { |
4738 print STDERR $error_count, " errors: FAILED\n"; | 4903 print STDERR $error_count, " errors: FAILED\n"; |
4739 } else { | 4904 } else { |
4740 print STDERR "PASS\n"; | 4905 print STDERR "PASS\n"; |
4741 } | 4906 } |
4742 exit ($error_count); | 4907 exit ($error_count); |
4743 } | 4908 } |
OLD | NEW |