Chromium Code Reviews
chromiumcodereview-hr@appspot.gserviceaccount.com (chromiumcodereview-hr) | Please choose your nickname with Settings | Help | Chromium Project | Gerrit Changes | Sign out
(28)

Side by Side Diff: third_party/tcmalloc/chromium/src/pprof

Issue 1076002: Revert 41938 - Merged third_party/tcmalloc/vendor/src(googleperftools r87) in... (Closed) Base URL: svn://svn.chromium.org/chrome/trunk/src/
Patch Set: Created 10 years, 9 months ago
Use n/p to move between diff chunks; N/P to move between comments. Draft comments are only viewable by you.
Jump to:
View unified diff | Download patch | Annotate | Revision Log
OLDNEW
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
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.4";
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 $PS2PDF = "ps2pdf"; 92 my $PS2PDF = "ps2pdf";
93 # These are used for dynamic profiles 93 # These are used for dynamic profiles
94 my $WGET = "wget"; 94 my $WGET = "wget";
95 my $WGET_FLAGS = "--no-http-keep-alive"; # only supported by some wgets
96 my $CURL = "curl"; 95 my $CURL = "curl";
97 96
98 # These are the web pages that servers need to support for dynamic profiles 97 # These are the web pages that servers need to support for dynamic profiles
99 my $HEAP_PAGE = "/pprof/heap"; 98 my $HEAP_PAGE = "/pprof/heap";
100 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#" 99 my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#"
101 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param 100 my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param
102 # ?seconds=#&event=x&period=n 101 # ?seconds=#&event=x&period=n
103 my $GROWTH_PAGE = "/pprof/growth"; 102 my $GROWTH_PAGE = "/pprof/growth";
104 my $CONTENTION_PAGE = "/pprof/contention"; 103 my $CONTENTION_PAGE = "/pprof/contention";
105 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter 104 my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter
106 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?"; 105 my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?";
107 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST 106 my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST
108 my $PROGRAM_NAME_PAGE = "/pprof/cmdline"; 107 my $PROGRAM_NAME_PAGE = "/pprof/cmdline";
109 108
110 # default binary name 109 # default binary name
111 my $UNKNOWN_BINARY = "(unknown)"; 110 my $UNKNOWN_BINARY = "(unknown)";
112 111
113 # There is a pervasive dependency on the length (in hex characters, 112 # There is a pervasive dependency on the length (in hex characters,
114 # i.e., nibbles) of an address, distinguishing between 32-bit and 113 # i.e., nibbles) of an address, distinguishing between 32-bit and
115 # 64-bit profiles. To err on the safe size, default to 64-bit here: 114 # 64-bit profiles. To err on the safe size, default to 64-bit here:
116 my $address_length = 16; 115 my $address_length = 16;
117 116
118 # A list of paths to search for shared object files 117 # A list of paths to search for shared object files
119 my @prefix_list = (); 118 my @prefix_list = ();
120 119
121 # Special routine name that should not have any symbols.
122 # Used as separator to parse "addr2line -i" output.
123 my $sep_symbol = '_fini';
124 my $sep_address = undef;
125
126 ##### Argument parsing ##### 120 ##### Argument parsing #####
127 121
128 sub usage_string { 122 sub usage_string {
129 return <<EOF; 123 return <<EOF;
130 Usage: 124 Usage:
131 pprof [options] <program> <profiles> 125 pprof [options] <program> <profiles>
132 <profiles> is a space separated list of profile names. 126 <profiles> is a space separated list of profile names.
133 pprof [options] <symbolized-profiles> 127 pprof [options] <symbolized-profiles>
134 <symbolized-profiles> is a list of profile files where each file contains 128 <symbolized-profiles> is a list of profile files where each file contains
135 the necessary symbol mappings as well as profile data (likely generated 129 the necessary symbol mappings as well as profile data (likely generated
(...skipping 367 matching lines...) Expand 10 before | Expand all | Expand 10 after
503 if ($main::use_symbol_page) { 497 if ($main::use_symbol_page) {
504 unless (IsProfileURL($main::pfile_args[0])) { 498 unless (IsProfileURL($main::pfile_args[0])) {
505 error("The first profile should be a remote form to use $SYMBOL_PAGE\n"); 499 error("The first profile should be a remote form to use $SYMBOL_PAGE\n");
506 } 500 }
507 CheckSymbolPage(); 501 CheckSymbolPage();
508 $main::prog = FetchProgramName(); 502 $main::prog = FetchProgramName();
509 } elsif (!$main::use_symbolized_profile) { # may not need objtools! 503 } elsif (!$main::use_symbolized_profile) { # may not need objtools!
510 ConfigureObjTools($main::prog) 504 ConfigureObjTools($main::prog)
511 } 505 }
512 506
513 # Check what flags our commandline utilities support
514 if (open(TFILE, "$WGET $WGET_FLAGS -V 2>&1 |")) {
515 my @lines = <TFILE>;
516 if (grep(/unrecognized/, @lines) > 0) {
517 # grep found 'unrecognized' token from WGET, clear WGET flags
518 $WGET_FLAGS = "";
519 }
520 close(TFILE);
521 }
522 # TODO(csilvers): check all the other binaries and objtools to see
523 # if they are installed and what flags they support, and store that
524 # in a data structure here, rather than scattering these tests about.
525 # Then, ideally, rewrite code to use wget OR curl OR GET or ...
526
527 # Break the opt_list_prefix into the prefix_list array 507 # Break the opt_list_prefix into the prefix_list array
528 @prefix_list = split (',', $main::opt_lib_prefix); 508 @prefix_list = split (',', $main::opt_lib_prefix);
529 509
530 # Remove trailing / from the prefixes, in the list to prevent 510 # Remove trailing / from the prefixes, in the list to prevent
531 # searching things like /my/path//lib/mylib.so 511 # searching things like /my/path//lib/mylib.so
532 foreach (@prefix_list) { 512 foreach (@prefix_list) {
533 s|/+$||; 513 s|/+$||;
534 } 514 }
535 } 515 }
536 516
(...skipping 428 matching lines...) Expand 10 before | Expand all | Expand 10 after
965 my $prog = shift; 945 my $prog = shift;
966 946
967 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash 947 $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
968 my $symbol_marker = $&; 948 my $symbol_marker = $&;
969 949
970 print '--- ', $symbol_marker, "\n"; 950 print '--- ', $symbol_marker, "\n";
971 if (defined($prog)) { 951 if (defined($prog)) {
972 print 'binary=', $prog, "\n"; 952 print 'binary=', $prog, "\n";
973 } 953 }
974 while (my ($pc, $name) = each(%{$symbols})) { 954 while (my ($pc, $name) = each(%{$symbols})) {
975 my $sep = ' '; 955 my $fullname = $name->[2];
976 print '0x', $pc; 956 print '0x', $pc, ' ', $fullname, "\n";
977 # We have a list of function names, which include the inlined
978 # calls. They are separated (and terminated) by --, which is
979 # illegal in function names.
980 for (my $j = 2; $j <= $#{$name}; $j += 3) {
981 print $sep, $name->[$j];
982 $sep = '--';
983 }
984 print "\n";
985 } 957 }
986 print '---', "\n"; 958 print '---', "\n";
987 959
988 $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash
989 my $profile_marker = $&;
990 print '--- ', $profile_marker, "\n";
991 if (defined($main::collected_profile)) { 960 if (defined($main::collected_profile)) {
992 # if used with remote fetch, simply dump the collected profile to output. 961 # if used with remote fetch, simply dump the collected profile to output.
993 open(SRC, "<$main::collected_profile"); 962 open(SRC, "<$main::collected_profile");
994 while (<SRC>) { 963 while (<SRC>) {
995 print $_; 964 print $_;
996 } 965 }
997 close(SRC);
998 } else { 966 } else {
999 # dump a cpu-format profile to standard out 967 # dump a cpu-format profile to standard out
968 $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash
969 my $profile_marker = $&;
970 print '--- ', $profile_marker, "\n";
1000 PrintProfileData($profile); 971 PrintProfileData($profile);
1001 } 972 }
1002 } 973 }
1003 974
1004 # Print text output 975 # Print text output
1005 sub PrintText { 976 sub PrintText {
1006 my $symbols = shift; 977 my $symbols = shift;
1007 my $flat = shift; 978 my $flat = shift;
1008 my $cumulative = shift; 979 my $cumulative = shift;
1009 my $total = shift; 980 my $total = shift;
(...skipping 81 matching lines...) Expand 10 before | Expand all | Expand 10 after
1091 $start_addr, $end_addr, $total); 1062 $start_addr, $end_addr, $total);
1092 last; 1063 last;
1093 } 1064 }
1094 $addr = AddressInc($addr); 1065 $addr = AddressInc($addr);
1095 } 1066 }
1096 } 1067 }
1097 } 1068 }
1098 } 1069 }
1099 1070
1100 # Return reference to array of tuples of the form: 1071 # Return reference to array of tuples of the form:
1101 # [start_address, filename, linenumber, instruction, limit_address] 1072 # [address, filename, linenumber, instruction]
1102 # E.g., 1073 # E.g.,
1103 # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"] 1074 # ["0x806c43d", "/foo/bar.cc", 131, "ret"]
1104 sub Disassemble { 1075 sub Disassemble {
1105 my $prog = shift; 1076 my $prog = shift;
1106 my $offset = shift; 1077 my $offset = shift;
1107 my $start_addr = shift; 1078 my $start_addr = shift;
1108 my $end_addr = shift; 1079 my $end_addr = shift;
1109 1080
1110 my $objdump = $obj_tool_map{"objdump"}; 1081 my $objdump = $obj_tool_map{"objdump"};
1111 my $cmd = sprintf("$objdump -C -d -l --no-show-raw-insn " . 1082 my $cmd = sprintf("$objdump -C -d -l --no-show-raw-insn " .
1112 "--start-address=0x$start_addr " . 1083 "--start-address=0x$start_addr " .
1113 "--stop-address=0x$end_addr $prog"); 1084 "--stop-address=0x$end_addr $prog");
1114 open(OBJDUMP, "$cmd |") || error("$objdump: $!\n"); 1085 open(OBJDUMP, "$cmd |") || error("$objdump: $!\n");
1115 my @result = (); 1086 my @result = ();
1116 my $filename = ""; 1087 my $filename = "";
1117 my $linenumber = -1; 1088 my $linenumber = -1;
1118 my $last = ["", "", "", ""];
1119 while (<OBJDUMP>) { 1089 while (<OBJDUMP>) {
1120 s/\r//g; # turn windows-looking lines into unix-looking lines 1090 s/\r//g; # turn windows-looking lines into unix-looking lines
1121 chop; 1091 chop;
1122 if (m|\s*([^:\s]+):(\d+)\s*$|) { 1092 if (m|\s*([^:\s]+):(\d+)\s*$|) {
1123 # Location line of the form: 1093 # Location line of the form:
1124 # <filename>:<linenumber> 1094 # <filename>:<linenumber>
1125 $filename = $1; 1095 $filename = $1;
1126 $linenumber = $2; 1096 $linenumber = $2;
1127 } elsif (m/^ +([0-9a-f]+):\s*(.*)/) { 1097 } elsif (m/^ +([0-9a-f]+):\s*(.*)/) {
1128 # Disassembly line -- zero-extend address to full length 1098 # Disassembly line -- zero-extend address to full length
1129 my $addr = HexExtend($1); 1099 my $addr = HexExtend($1);
1130 my $k = AddressAdd($addr, $offset); 1100 my $k = AddressAdd($addr, $offset);
1131 $last->[4] = $k; # Store ending address for previous instruction 1101 push(@result, [$k, $filename, $linenumber, $2]);
1132 $last = [$k, $filename, $linenumber, $2, $end_addr];
1133 push(@result, $last);
1134 } 1102 }
1135 } 1103 }
1136 close(OBJDUMP); 1104 close(OBJDUMP);
1137 return @result; 1105 return @result;
1138 } 1106 }
1139 1107
1140 # The input file should contain lines of the form /proc/maps-like 1108 # The input file should contain lines of the form /proc/maps-like
1141 # output (same format as expected from the profiles) or that looks 1109 # output (same format as expected from the profiles) or that looks
1142 # like hex addresses (like "0xDEADBEEF"). We will parse all 1110 # like hex addresses (like "0xDEADBEEF"). We will parse all
1143 # /proc/maps output, and for all the hex addresses, we will output 1111 # /proc/maps output, and for all the hex addresses, we will output
(...skipping 155 matching lines...) Expand 10 before | Expand all | Expand 10 after
1299 # Assign all samples to the range $firstline,$lastline, 1267 # Assign all samples to the range $firstline,$lastline,
1300 # Hack 4: If an instruction does not occur in the range, its samples 1268 # Hack 4: If an instruction does not occur in the range, its samples
1301 # are moved to the next instruction that occurs in the range. 1269 # are moved to the next instruction that occurs in the range.
1302 my $samples1 = {}; 1270 my $samples1 = {};
1303 my $samples2 = {}; 1271 my $samples2 = {};
1304 my $running1 = 0; # Unassigned flat counts 1272 my $running1 = 0; # Unassigned flat counts
1305 my $running2 = 0; # Unassigned cumulative counts 1273 my $running2 = 0; # Unassigned cumulative counts
1306 my $total1 = 0; # Total flat counts 1274 my $total1 = 0; # Total flat counts
1307 my $total2 = 0; # Total cumulative counts 1275 my $total2 = 0; # Total cumulative counts
1308 foreach my $e (@instructions) { 1276 foreach my $e (@instructions) {
1309 # Add up counts for all address that fall inside this instruction 1277 my $c1 = GetEntry($flat, $e->[0]);
1310 my $c1 = 0; 1278 my $c2 = GetEntry($cumulative, $e->[0]);
1311 my $c2 = 0;
1312 for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
1313 $c1 += GetEntry($flat, $a);
1314 $c2 += GetEntry($cumulative, $a);
1315 }
1316 $running1 += $c1; 1279 $running1 += $c1;
1317 $running2 += $c2; 1280 $running2 += $c2;
1318 $total1 += $c1; 1281 $total1 += $c1;
1319 $total2 += $c2; 1282 $total2 += $c2;
1320 my $file = $e->[1]; 1283 my $file = $e->[1];
1321 my $line = $e->[2]; 1284 my $line = $e->[2];
1322 if (($file eq $filename) && 1285 if (($file eq $filename) &&
1323 ($line >= $firstline) && 1286 ($line >= $firstline) &&
1324 ($line <= $lastline)) { 1287 ($line <= $lastline)) {
1325 # Assign all accumulated samples to this line 1288 # Assign all accumulated samples to this line
(...skipping 90 matching lines...) Expand 10 before | Expand all | Expand 10 after
1416 1379
1417 # Disassemble all instructions 1380 # Disassemble all instructions
1418 my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr); 1381 my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);
1419 1382
1420 # Make array of counts per instruction 1383 # Make array of counts per instruction
1421 my @flat_count = (); 1384 my @flat_count = ();
1422 my @cum_count = (); 1385 my @cum_count = ();
1423 my $flat_total = 0; 1386 my $flat_total = 0;
1424 my $cum_total = 0; 1387 my $cum_total = 0;
1425 foreach my $e (@instructions) { 1388 foreach my $e (@instructions) {
1426 # Add up counts for all address that fall inside this instruction 1389 my $c1 = GetEntry($flat, $e->[0]);
1427 my $c1 = 0; 1390 my $c2 = GetEntry($cumulative, $e->[0]);
1428 my $c2 = 0;
1429 for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
1430 $c1 += GetEntry($flat, $a);
1431 $c2 += GetEntry($cumulative, $a);
1432 }
1433 push(@flat_count, $c1); 1391 push(@flat_count, $c1);
1434 push(@cum_count, $c2); 1392 push(@cum_count, $c2);
1435 $flat_total += $c1; 1393 $flat_total += $c1;
1436 $cum_total += $c2; 1394 $cum_total += $c2;
1437 } 1395 }
1438 1396
1439 # Print header with total counts 1397 # Print header with total counts
1440 printf("ROUTINE ====================== %s\n" . 1398 printf("ROUTINE ====================== %s\n" .
1441 "%6s %6s %s (flat, cumulative) %.1f%% of total\n", 1399 "%6s %6s %s (flat, cumulative) %.1f%% of total\n",
1442 ShortFunctionName($routine), 1400 ShortFunctionName($routine),
(...skipping 207 matching lines...) Expand 10 before | Expand all | Expand 10 after
1650 $style, 1608 $style,
1651 ); 1609 );
1652 } 1610 }
1653 1611
1654 # Get edges and counts per edge 1612 # Get edges and counts per edge
1655 my %edge = (); 1613 my %edge = ();
1656 my $n; 1614 my $n;
1657 foreach my $k (keys(%{$raw})) { 1615 foreach my $k (keys(%{$raw})) {
1658 # TODO: omit low %age edges 1616 # TODO: omit low %age edges
1659 $n = $raw->{$k}; 1617 $n = $raw->{$k};
1660 my @translated = TranslateStack($symbols, $k); 1618 my @addrs = split(/\n/, $k);
1661 for (my $i = 1; $i <= $#translated; $i++) { 1619 for (my $i = 1; $i <= $#addrs; $i++) {
1662 my $src = $translated[$i]; 1620 my $src = OutputKey($symbols, $addrs[$i]);
1663 my $dst = $translated[$i-1]; 1621 my $dst = OutputKey($symbols, $addrs[$i-1]);
1664 #next if ($src eq $dst); # Avoid self-edges? 1622 #next if ($src eq $dst); # Avoid self-edges?
1665 if (exists($node{$src}) && exists($node{$dst})) { 1623 if (exists($node{$src}) && exists($node{$dst})) {
1666 my $edge_label = "$src\001$dst"; 1624 my $edge_label = "$src\001$dst";
1667 if (!exists($edge{$edge_label})) { 1625 if (!exists($edge{$edge_label})) {
1668 $edge{$edge_label} = 0; 1626 $edge{$edge_label} = 0;
1669 } 1627 }
1670 $edge{$edge_label} += $n; 1628 $edge{$edge_label} += $n;
1671 } 1629 }
1672 } 1630 }
1673 } 1631 }
1674 1632
1675 # Print edges 1633 # Print edges
1676 foreach my $e (keys(%edge)) { 1634 foreach my $e (keys(%edge)) {
1677 my @x = split(/\001/, $e); 1635 my @x = split(/\001/, $e);
1678 $n = $edge{$e}; 1636 $n = $edge{$e};
1679 1637
1680 if (abs($n) > $edgelimit) { 1638 if (abs($n) > $edgelimit) {
1681 # Compute line width based on edge count 1639 # Compute line width based on edge count
1682 my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0); 1640 my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0);
1683 if ($fraction > 1) { $fraction = 1; } 1641 if ($fraction > 1) { $fraction = 1; }
1684 my $w = $fraction * 2; 1642 my $w = $fraction * 2;
1685 #if ($w < 1) { $w = 1; } 1643 #if ($w < 1) { $w = 1; }
1686 1644
1687 # Dot sometimes segfaults if given edge weights that are too large, so 1645 # Dot sometimes segfaults if given edge weights that are too large, so
1688 # we cap the weights at a large value 1646 # we cap the weights at a large value
1689 my $edgeweight = abs($n) ** 0.7; 1647 my $edgeweight = abs($n) ** 0.7;
1690 if ($edgeweight > 100000) { $edgeweight = 100000; } 1648 if ($edgeweight > 100000) { $edgeweight = 100000; }
1691 $edgeweight = int($edgeweight); 1649 $edgeweight = int($edgeweight);
1692 1650
1693 my $style = sprintf("setlinewidth(%f)", $w);
1694 if ($x[1] =~ m/\(inline\)/) {
1695 $style .= ",dashed";
1696 }
1697
1698 # Use a slightly squashed function of the edge count as the weight 1651 # Use a slightly squashed function of the edge count as the weight
1699 printf DOT ("N%s -> N%s [label=%s, weight=%d, style=\"%s\"];\n", 1652 printf DOT ("N%s -> N%s [label=%s, weight=%d, " .
1653 "style=\"setlinewidth(%f)\"];\n",
1700 $node{$x[0]}, 1654 $node{$x[0]},
1701 $node{$x[1]}, 1655 $node{$x[1]},
1702 Unparse($n), 1656 Unparse($n),
1703 $edgeweight, 1657 $edgeweight,
1704 $style); 1658 $w);
1705 } 1659 }
1706 } 1660 }
1707 1661
1708 print DOT ("}\n"); 1662 print DOT ("}\n");
1709 1663
1710 close(DOT); 1664 close(DOT);
1711 return 1; 1665 return 1;
1712 } 1666 }
1713 1667
1714 # Translate a stack of addresses into a stack of symbols 1668 # Generate the key under which a given address should be counted
1715 sub TranslateStack { 1669 # based on the user-specified output granularity.
1670 sub OutputKey {
1716 my $symbols = shift; 1671 my $symbols = shift;
1717 my $k = shift; 1672 my $a = shift;
1718 1673
1719 my @addrs = split(/\n/, $k); 1674 # Skip large addresses since they sometimes show up as fake entries on RH9
1720 my @result = (); 1675 if (length($a) > 8) {
1721 for (my $i = 0; $i <= $#addrs; $i++) { 1676 if ($a gt "7fffffffffffffff") { return ''; }
1722 my $a = $addrs[$i];
1723
1724 # Skip large addresses since they sometimes show up as fake entries on RH9
1725 if (length($a) > 8 && $a gt "7fffffffffffffff") {
1726 next;
1727 }
1728
1729 if ($main::opt_disasm || $main::opt_list) {
1730 # We want just the address for the key
1731 push(@result, $a);
1732 next;
1733 }
1734
1735 my $symlist = $symbols->{$a};
1736 if (!defined($symlist)) {
1737 $symlist = [$a, "", $a];
1738 }
1739
1740 # We can have a sequence of symbols for a particular entry
1741 # (more than one symbol in the case of inlining). Callers
1742 # come before callees in symlist, so walk backwards since
1743 # the translated stack should contain callees before callers.
1744 for (my $j = $#{$symlist}; $j >= 2; $j -= 3) {
1745 my $func = $symlist->[$j-2];
1746 my $fileline = $symlist->[$j-1];
1747 my $fullfunc = $symlist->[$j];
1748 if ($j > 2) {
1749 $func = "$func (inline)";
1750 }
1751 if ($main::opt_addresses) {
1752 push(@result, "$a $func $fileline");
1753 } elsif ($main::opt_lines) {
1754 if ($func eq '??' && $fileline eq '??:0') {
1755 push(@result, "$a");
1756 } else {
1757 push(@result, "$func $fileline");
1758 }
1759 } elsif ($main::opt_functions) {
1760 if ($func eq '??') {
1761 push(@result, "$a");
1762 } else {
1763 push(@result, $func);
1764 }
1765 } elsif ($main::opt_files) {
1766 if ($fileline eq '??:0' || $fileline eq '') {
1767 push(@result, "$a");
1768 } else {
1769 my $f = $fileline;
1770 $f =~ s/:\d+$//;
1771 push(@result, $f);
1772 }
1773 } else {
1774 push(@result, $a);
1775 last; # Do not print inlined info
1776 }
1777 }
1778 } 1677 }
1779 1678
1780 # print join(",", @addrs), " => ", join(",", @result), "\n"; 1679 # Extract symbolic info for address
1781 return @result; 1680 my $func = $a;
1681 my $fullfunc = $a;
1682 my $fileline = "";
1683 if (exists($symbols->{$a})) {
1684 $func = $symbols->{$a}->[0];
1685 $fullfunc = $symbols->{$a}->[2];
1686 $fileline = $symbols->{$a}->[1];
1687 }
1688
1689 if ($main::opt_disasm || $main::opt_list) {
1690 return $a; # We want just the address for the key
1691 } elsif ($main::opt_addresses) {
1692 return "$a $func $fileline";
1693 } elsif ($main::opt_lines) {
1694 return "$func $fileline";
1695 } elsif ($main::opt_functions) {
1696 return $func;
1697 } elsif ($main::opt_files) {
1698 my $f = ($fileline eq '') ? $a : $fileline;
1699 $f =~ s/:\d+$//;
1700 return $f;
1701 } else {
1702 return $a;
1703 }
1782 } 1704 }
1783 1705
1784 # Generate percent string for a number and a total 1706 # Generate percent string for a number and a total
1785 sub Percent { 1707 sub Percent {
1786 my $num = shift; 1708 my $num = shift;
1787 my $tot = shift; 1709 my $tot = shift;
1788 if ($tot != 0) { 1710 if ($tot != 0) {
1789 return sprintf("%.1f%%", $num * 100.0 / $tot); 1711 return sprintf("%.1f%%", $num * 100.0 / $tot);
1790 } else { 1712 } else {
1791 return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf"); 1713 return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf");
(...skipping 169 matching lines...) Expand 10 before | Expand all | Expand 10 after
1961 'tc_valloc', 1883 'tc_valloc',
1962 'tc_realloc', 1884 'tc_realloc',
1963 'tc_new', 1885 'tc_new',
1964 'tc_delete', 1886 'tc_delete',
1965 'tc_newarray', 1887 'tc_newarray',
1966 'tc_deletearray', 1888 'tc_deletearray',
1967 'tc_new_nothrow', 1889 'tc_new_nothrow',
1968 'tc_newarray_nothrow', 1890 'tc_newarray_nothrow',
1969 'do_malloc', 1891 'do_malloc',
1970 '::do_malloc', # new name -- got moved to an unnamed ns 1892 '::do_malloc', # new name -- got moved to an unnamed ns
1971 '::do_malloc_or_cpp_alloc',
1972 'DoSampledAllocation', 1893 'DoSampledAllocation',
1973 'simple_alloc::allocate', 1894 'simple_alloc::allocate',
1974 '__malloc_alloc_template::allocate', 1895 '__malloc_alloc_template::allocate',
1975 '__builtin_delete', 1896 '__builtin_delete',
1976 '__builtin_new', 1897 '__builtin_new',
1977 '__builtin_vec_delete', 1898 '__builtin_vec_delete',
1978 '__builtin_vec_new', 1899 '__builtin_vec_new',
1979 'operator new', 1900 'operator new',
1980 'operator new[]', 1901 'operator new[]') {
1981 » » # These mark the beginning/end of our custom sections
1982 » » '__start_google_malloc',
1983 » » '__stop_google_malloc',
1984 » » '__start_malloc_hook',
1985 » » '__stop_malloc_hook') {
1986 $skip{$name} = 1; 1902 $skip{$name} = 1;
1987 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything 1903 $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything
1988 } 1904 }
1989 # TODO: Remove TCMalloc once everything has been 1905 # TODO: Remove TCMalloc once everything has been
1990 # moved into the tcmalloc:: namespace and we have flushed 1906 # moved into the tcmalloc:: namespace and we have flushed
1991 # old code out of the system. 1907 # old code out of the system.
1992 $skip_regexp = "TCMalloc|^tcmalloc::"; 1908 $skip_regexp = "TCMalloc|^tcmalloc::";
1993 } elsif ($main::profile_type eq 'contention') { 1909 } elsif ($main::profile_type eq 'contention') {
1994 foreach my $vname ('Mutex::Unlock', 'Mutex::UnlockSlow') { 1910 foreach my $vname ('Mutex::Unlock', 'Mutex::UnlockSlow') {
1995 $skip{$vname} = 1; 1911 $skip{$vname} = 1;
(...skipping 59 matching lines...) Expand 10 before | Expand all | Expand 10 after
2055 return $result; 1971 return $result;
2056 } 1972 }
2057 1973
2058 # Reduce profile to granularity given by user 1974 # Reduce profile to granularity given by user
2059 sub ReduceProfile { 1975 sub ReduceProfile {
2060 my $symbols = shift; 1976 my $symbols = shift;
2061 my $profile = shift; 1977 my $profile = shift;
2062 my $result = {}; 1978 my $result = {};
2063 foreach my $k (keys(%{$profile})) { 1979 foreach my $k (keys(%{$profile})) {
2064 my $count = $profile->{$k}; 1980 my $count = $profile->{$k};
2065 my @translated = TranslateStack($symbols, $k); 1981 my @addrs = split(/\n/, $k);
2066 my @path = (); 1982 my @path = ();
2067 my %seen = (); 1983 my %seen = ();
2068 $seen{''} = 1; # So that empty keys are skipped 1984 $seen{''} = 1; # So that empty keys are skipped
2069 foreach my $e (@translated) { 1985 foreach my $a (@addrs) {
2070 # To avoid double-counting due to recursion, skip a stack-trace 1986 # To avoid double-counting due to recursion, skip a stack-trace
2071 # entry if it has already been seen 1987 # entry if it has already been seen
2072 if (!$seen{$e}) { 1988 my $key = OutputKey($symbols, $a);
2073 » $seen{$e} = 1; 1989 if (!$seen{$key}) {
2074 » push(@path, $e); 1990 » $seen{$key} = 1;
1991 » push(@path, $key);
2075 } 1992 }
2076 } 1993 }
2077 my $reduced_path = join("\n", @path); 1994 my $reduced_path = join("\n", @path);
2078 AddEntry($result, $reduced_path, $count); 1995 AddEntry($result, $reduced_path, $count);
2079 } 1996 }
2080 return $result; 1997 return $result;
2081 } 1998 }
2082 1999
2083 # Does the specified symbol array match the regexp?
2084 sub SymbolMatches {
2085 my $sym = shift;
2086 my $re = shift;
2087 if (defined($sym)) {
2088 for (my $i = 0; $i < $#{$sym}; $i += 3) {
2089 if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) {
2090 return 1;
2091 }
2092 }
2093 }
2094 return 0;
2095 }
2096
2097 # Focus only on paths involving specified regexps 2000 # Focus only on paths involving specified regexps
2098 sub FocusProfile { 2001 sub FocusProfile {
2099 my $symbols = shift; 2002 my $symbols = shift;
2100 my $profile = shift; 2003 my $profile = shift;
2101 my $focus = shift; 2004 my $focus = shift;
2102 my $result = {}; 2005 my $result = {};
2103 foreach my $k (keys(%{$profile})) { 2006 foreach my $k (keys(%{$profile})) {
2104 my $count = $profile->{$k}; 2007 my $count = $profile->{$k};
2105 my @addrs = split(/\n/, $k); 2008 my @addrs = split(/\n/, $k);
2106 foreach my $a (@addrs) { 2009 foreach my $a (@addrs) {
2107 # Reply if it matches either the address/shortname/fileline 2010 # Reply if it matches either the address/shortname/fileline
2108 if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) { 2011 if (($a =~ m/$focus/) ||
2012 (exists($symbols->{$a}) &&
2013 (($symbols->{$a}->[0] =~ m/$focus/) ||
2014 ($symbols->{$a}->[1] =~ m/$focus/)))) {
2109 AddEntry($result, $k, $count); 2015 AddEntry($result, $k, $count);
2110 last; 2016 last;
2111 } 2017 }
2112 } 2018 }
2113 } 2019 }
2114 return $result; 2020 return $result;
2115 } 2021 }
2116 2022
2117 # Focus only on paths not involving specified regexps 2023 # Focus only on paths not involving specified regexps
2118 sub IgnoreProfile { 2024 sub IgnoreProfile {
2119 my $symbols = shift; 2025 my $symbols = shift;
2120 my $profile = shift; 2026 my $profile = shift;
2121 my $ignore = shift; 2027 my $ignore = shift;
2122 my $result = {}; 2028 my $result = {};
2123 foreach my $k (keys(%{$profile})) { 2029 foreach my $k (keys(%{$profile})) {
2124 my $count = $profile->{$k}; 2030 my $count = $profile->{$k};
2125 my @addrs = split(/\n/, $k); 2031 my @addrs = split(/\n/, $k);
2126 my $matched = 0; 2032 my $matched = 0;
2127 foreach my $a (@addrs) { 2033 foreach my $a (@addrs) {
2128 # Reply if it matches either the address/shortname/fileline 2034 # Reply if it matches either the address/shortname/fileline
2129 if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) { 2035 if (($a =~ m/$ignore/) ||
2036 (exists($symbols->{$a}) &&
2037 (($symbols->{$a}->[0] =~ m/$ignore/) ||
2038 ($symbols->{$a}->[1] =~ m/$ignore/)))) {
2130 $matched = 1; 2039 $matched = 1;
2131 last; 2040 last;
2132 } 2041 }
2133 } 2042 }
2134 if (!$matched) { 2043 if (!$matched) {
2135 AddEntry($result, $k, $count); 2044 AddEntry($result, $k, $count);
2136 } 2045 }
2137 } 2046 }
2138 return $result; 2047 return $result;
2139 } 2048 }
(...skipping 139 matching lines...) Expand 10 before | Expand all | Expand 10 after
2279 my @lines = <TFILE>; 2188 my @lines = <TFILE>;
2280 my $result = grep(/^--- *$symbol_marker/, @lines); 2189 my $result = grep(/^--- *$symbol_marker/, @lines);
2281 close(TFILE); 2190 close(TFILE);
2282 return $result > 0; 2191 return $result > 0;
2283 } 2192 }
2284 2193
2285 ##### Code to profile a server dynamically ##### 2194 ##### Code to profile a server dynamically #####
2286 2195
2287 sub CheckSymbolPage { 2196 sub CheckSymbolPage {
2288 my $url = SymbolPageURL(); 2197 my $url = SymbolPageURL();
2289 open(SYMBOL, "$WGET $WGET_FLAGS -qO- '$url' |"); 2198 open(SYMBOL, "$WGET -qO- '$url' |");
2290 my $line = <SYMBOL>; 2199 my $line = <SYMBOL>;
2291 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines 2200 $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
2292 close(SYMBOL); 2201 close(SYMBOL);
2293 unless (defined($line)) { 2202 unless (defined($line)) {
2294 error("$url doesn't exist\n"); 2203 error("$url doesn't exist\n");
2295 } 2204 }
2296 2205
2297 if ($line =~ /^num_symbols:\s+(\d+)$/) { 2206 if ($line =~ /^num_symbols:\s+(\d+)$/) {
2298 if ($1 == 0) { 2207 if ($1 == 0) {
2299 error("Stripped binary. No symbols available.\n"); 2208 error("Stripped binary. No symbols available.\n");
(...skipping 24 matching lines...) Expand all
2324 2233
2325 # We fetch symbols from the first profile argument. 2234 # We fetch symbols from the first profile argument.
2326 sub SymbolPageURL { 2235 sub SymbolPageURL {
2327 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]); 2236 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
2328 return "http://$host:$port$SYMBOL_PAGE"; 2237 return "http://$host:$port$SYMBOL_PAGE";
2329 } 2238 }
2330 2239
2331 sub FetchProgramName() { 2240 sub FetchProgramName() {
2332 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]); 2241 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
2333 my $url = "http://$host:$port$PROGRAM_NAME_PAGE"; 2242 my $url = "http://$host:$port$PROGRAM_NAME_PAGE";
2334 my $command_line = "$WGET $WGET_FLAGS -qO- '$url'"; 2243 my $command_line = "$WGET -qO- '$url'";
2335 open(CMDLINE, "$command_line |") or error($command_line); 2244 open(CMDLINE, "$command_line |") or error($command_line);
2336 my $cmdline = <CMDLINE>; 2245 my $cmdline = <CMDLINE>;
2337 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines 2246 $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
2338 close(CMDLINE); 2247 close(CMDLINE);
2339 error("Failed to get program name from $url\n") unless defined($cmdline); 2248 error("Failed to get program name from $url\n") unless defined($cmdline);
2340 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. 2249 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters.
2341 $cmdline =~ s!\n!!g; # Remove LFs. 2250 $cmdline =~ s!\n!!g; # Remove LFs.
2342 return $cmdline; 2251 return $cmdline;
2343 } 2252 }
2344 2253
(...skipping 85 matching lines...) Expand 10 before | Expand all | Expand 10 after
2430 my $symbols = {}; 2339 my $symbols = {};
2431 foreach my $pc (@pcs) { 2340 foreach my $pc (@pcs) {
2432 my $fullname; 2341 my $fullname;
2433 # For 64 bits binaries, symbols are extracted with 8 leading zeroes. 2342 # For 64 bits binaries, symbols are extracted with 8 leading zeroes.
2434 # Then /symbol reads the long symbols in as uint64, and outputs 2343 # Then /symbol reads the long symbols in as uint64, and outputs
2435 # the result with a "0x%08llx" format which get rid of the zeroes. 2344 # the result with a "0x%08llx" format which get rid of the zeroes.
2436 # By removing all the leading zeroes in both $pc and the symbols from 2345 # By removing all the leading zeroes in both $pc and the symbols from
2437 # /symbol, the symbols match and are retrievable from the map. 2346 # /symbol, the symbols match and are retrievable from the map.
2438 my $shortpc = $pc; 2347 my $shortpc = $pc;
2439 $shortpc =~ s/^0*//; 2348 $shortpc =~ s/^0*//;
2440 # Each line may have a list of names, which includes the function
2441 # and also other functions it has inlined. They are separated
2442 # (in PrintSymbolizedFile), by --, which is illegal in function names.
2443 my $fullnames;
2444 if (defined($symbol_map->{$shortpc})) { 2349 if (defined($symbol_map->{$shortpc})) {
2445 $fullnames = $symbol_map->{$shortpc}; 2350 $fullname = $symbol_map->{$shortpc};
2446 } else { 2351 } else {
2447 $fullnames = "0x" . $pc; # Just use addresses 2352 $fullname = "0x" . $pc; # Just use addresses
2448 } 2353 }
2449 my $sym = []; 2354 my $name = ShortFunctionName($fullname);
2450 $symbols->{$pc} = $sym; 2355 $symbols->{$pc} = [$name, "?", $fullname];
2451 foreach my $fullname (split("--", $fullnames)) {
2452 my $name = ShortFunctionName($fullname);
2453 push(@{$sym}, $name, "?", $fullname);
2454 }
2455 } 2356 }
2456 return $symbols; 2357 return $symbols;
2457 } 2358 }
2458 2359
2459 sub BaseName { 2360 sub BaseName {
2460 my $file_name = shift; 2361 my $file_name = shift;
2461 $file_name =~ s!^.*/!!; # Remove directory name 2362 $file_name =~ s!^.*/!!; # Remove directory name
2462 return $file_name; 2363 return $file_name;
2463 } 2364 }
2464 2365
(...skipping 19 matching lines...) Expand all
2484 # Missing type specifier defaults to cpu-profile 2385 # Missing type specifier defaults to cpu-profile
2485 $path = $PROFILE_PAGE; 2386 $path = $PROFILE_PAGE;
2486 } 2387 }
2487 2388
2488 my $profile_file = MakeProfileBaseName($binary_name, $profile_name); 2389 my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
2489 2390
2490 my $url; 2391 my $url;
2491 my $wget_timeout; 2392 my $wget_timeout;
2492 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) { 2393 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)) {
2493 if ($path =~ m/$PROFILE_PAGE/) { 2394 if ($path =~ m/$PROFILE_PAGE/) {
2494 $url = sprintf("http://$host:$port$path?seconds=%d", 2395 $url = sprintf("http://$host:$port$PROFILE_PAGE?seconds=%d",
2495 $main::opt_seconds); 2396 $main::opt_seconds);
2496 } else { 2397 } else {
2497 if ($profile_name =~ m/[?]/) { 2398 if ($profile_name =~ m/[?]/) {
2498 $profile_name .= "&" 2399 $profile_name .= "&"
2499 } else { 2400 } else {
2500 $profile_name .= "?" 2401 $profile_name .= "?"
2501 } 2402 }
2502 $url = sprintf("http://$profile_name" . "seconds=%d", 2403 $url = sprintf("http://$profile_name" . "seconds=%d",
2503 $main::opt_seconds); 2404 $main::opt_seconds);
2504 } 2405 }
(...skipping 14 matching lines...) Expand all
2519 mkdir($profile_dir) 2420 mkdir($profile_dir)
2520 || die("Unable to create profile directory $profile_dir: $!\n"); 2421 || die("Unable to create profile directory $profile_dir: $!\n");
2521 } 2422 }
2522 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; 2423 my $tmp_profile = "$profile_dir/.tmp.$profile_file";
2523 my $real_profile = "$profile_dir/$profile_file"; 2424 my $real_profile = "$profile_dir/$profile_file";
2524 2425
2525 if ($fetch_name_only > 0) { 2426 if ($fetch_name_only > 0) {
2526 return $real_profile; 2427 return $real_profile;
2527 } 2428 }
2528 2429
2529 my $cmd = "$WGET $WGET_FLAGS $wget_timeout -q -O $tmp_profile '$url'"; 2430 my $cmd = "$WGET $wget_timeout -q -O $tmp_profile '$url'";
2530 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){ 2431 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){
2531 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon ds to\n ${real_profile}\n"; 2432 print STDERR "Gathering CPU profile from $url for $main::opt_seconds secon ds to\n ${real_profile}\n";
2532 if ($encourage_patience) { 2433 if ($encourage_patience) {
2533 print STDERR "Be patient...\n"; 2434 print STDERR "Be patient...\n";
2534 } 2435 }
2535 } else { 2436 } else {
2536 print STDERR "Fetching $path profile from $host:$port to\n ${real_profile }\n"; 2437 print STDERR "Fetching $path profile from $host:$port to\n ${real_profile }\n";
2537 } 2438 }
2538 2439
2539 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n"); 2440 (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
(...skipping 304 matching lines...) Expand 10 before | Expand all | Expand 10 after
2844 error("$fname: stack trace depth >= 2**32\n"); 2745 error("$fname: stack trace depth >= 2**32\n");
2845 } 2746 }
2846 if ($slots->get($i) == 0 && $slots->get($i+1) == 0) { 2747 if ($slots->get($i) == 0 && $slots->get($i+1) == 0) {
2847 # End of profile data marker 2748 # End of profile data marker
2848 $i += 2 * $d; 2749 $i += 2 * $d;
2849 last; 2750 last;
2850 } 2751 }
2851 2752
2852 # Make key out of the stack entries 2753 # Make key out of the stack entries
2853 my @k = (); 2754 my @k = ();
2854 for (my $j = 0; $j < $d; $j++) { 2755 for (my $j = $d; $j--; ) {
2855 my $pclo = $slots->get($i++); 2756 my $pclo = $slots->get($i++);
2856 my $pchi = $slots->get($i++); 2757 my $pchi = $slots->get($i++);
2857 if ($pclo == -1 || $pchi == -1) { 2758 if ($pclo == -1 || $pchi == -1) {
2858 error("$fname: Unexpected EOF when reading stack of depth $d\n"); 2759 error("$fname: Unexpected EOF when reading stack of depth $d\n");
2859 } 2760 }
2860
2861 # Subtract one from caller pc so we map back to call instr.
2862 # However, don't do this if we're reading a symbolized profile
2863 # file, in which case the subtract-one was done when the file
2864 # was written.
2865 if ($j > 0 && !$main::use_symbolized_profile) {
2866 if ($pclo == 0) {
2867 $pchi--;
2868 $pclo = 0xffffffff;
2869 } else {
2870 $pclo--;
2871 }
2872 }
2873
2874 my $pc = sprintf("%08x%08x", $pchi, $pclo); 2761 my $pc = sprintf("%08x%08x", $pchi, $pclo);
2875 $pcs->{$pc} = 1; 2762 $pcs->{$pc} = 1;
2876 push @k, $pc; 2763 push @k, $pc;
2877 } 2764 }
2878 AddEntry($profile, (join "\n", @k), $n); 2765 AddEntry($profile, (join "\n", @k), $n);
2879 } 2766 }
2880 } 2767 }
2881 2768
2882 # Parse map 2769 # Parse map
2883 my $map = ''; 2770 my $map = '';
(...skipping 478 matching lines...) Expand 10 before | Expand all | Expand 10 after
3362 my $buildvar = ""; 3249 my $buildvar = "";
3363 foreach my $l (split("\n", $map)) { 3250 foreach my $l (split("\n", $map)) {
3364 if ($l =~ m/^\s*build=(.*)$/) { 3251 if ($l =~ m/^\s*build=(.*)$/) {
3365 $buildvar = $1; 3252 $buildvar = $1;
3366 } 3253 }
3367 3254
3368 my $start; 3255 my $start;
3369 my $finish; 3256 my $finish;
3370 my $offset; 3257 my $offset;
3371 my $lib; 3258 my $lib;
3372 if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+\.(so|dll|dylib|bu ndle)((\.\d+)+\w*)?)$/i) { 3259 if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+\.(so|dll|dylib)(( \.\d+)+\w*)?)$/i) {
3373 # Full line from /proc/self/maps. Example: 3260 # Full line from /proc/self/maps. Example:
3374 # 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so 3261 # 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so
3375 $start = HexExtend($1); 3262 $start = HexExtend($1);
3376 $finish = HexExtend($2); 3263 $finish = HexExtend($2);
3377 $offset = HexExtend($3); 3264 $offset = HexExtend($3);
3378 $lib = $4; 3265 $lib = $4;
3379 $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths 3266 $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths
3380 } elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) { 3267 } elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) {
3381 # Cooked line from DumpAddressMap. Example: 3268 # Cooked line from DumpAddressMap. Example:
3382 # 40000000-40015000: /lib/ld-2.3.2.so 3269 # 40000000-40015000: /lib/ld-2.3.2.so
(...skipping 239 matching lines...) Expand 10 before | Expand all | Expand 10 after
3622 return $symbols; 3509 return $symbols;
3623 } 3510 }
3624 3511
3625 # Map list of PC values to symbols for a given image 3512 # Map list of PC values to symbols for a given image
3626 sub MapToSymbols { 3513 sub MapToSymbols {
3627 my $image = shift; 3514 my $image = shift;
3628 my $offset = shift; 3515 my $offset = shift;
3629 my $pclist = shift; 3516 my $pclist = shift;
3630 my $symbols = shift; 3517 my $symbols = shift;
3631 3518
3632 my $debug = 0;
3633
3634 # Ignore empty binaries 3519 # Ignore empty binaries
3635 if ($#{$pclist} < 0) { return; } 3520 if ($#{$pclist} < 0) { return; }
3636 3521
3637 # Figure out the addr2line command to use 3522 my $got_symbols = MapSymbolsWithNM($image, $offset, $pclist, $symbols);
3638 my $addr2line = $obj_tool_map{"addr2line"}; 3523 if ($main::opt_interactive ||
3639 my $cmd = "$addr2line -f -C -e $image"; 3524 $main::opt_addresses ||
3640 if (exists $obj_tool_map{"addr2line_pdb"}) { 3525 $main::opt_lines ||
3641 $addr2line = $obj_tool_map{"addr2line_pdb"}; 3526 $main::opt_files ||
3642 $cmd = "$addr2line --demangle -f -C -e $image"; 3527 $main::opt_list ||
3528 $main::opt_callgrind ||
3529 !$got_symbols) {
3530 GetLineNumbers($image, $offset, $pclist, $symbols);
3643 } 3531 }
3532 }
3644 3533
3645 # If "addr2line" isn't installed on the system at all, just use 3534 # The file $tmpfile_sym must already have been created before calling this.
3646 # nm to get what info we can (function names, but not line numbers). 3535 sub GetLineNumbersViaAddr2Line {
3647 if (system("$addr2line --help >/dev/null 2>&1") != 0) { 3536 my $addr2line_command = shift;
3648 MapSymbolsWithNM($image, $offset, $pclist, $symbols); 3537 my $pclist = shift;
3649 return; 3538 my $symbols = shift;
3650 }
3651 3539
3652 # "addr2line -i" can produce a variable number of lines per input 3540 open(SYMBOLS, "$addr2line_command <$main::tmpfile_sym |")
3653 # address, with no separator that allows us to tell when data for 3541 || error("$addr2line_command: $!\n");
3654 # the next address starts. So we find the address for a special 3542 my $count = 0;
3655 # symbol (_fini) and interleave this address between all real
3656 # addresses passed to addr2line. The name of this special symbol
3657 # can then be used as a separator.
3658 $sep_address = undef; # May be filled in by MapSymbolsWithNM()
3659 my $nm_symbols = {};
3660 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);
3661 # TODO(csilvers): only add '-i' if addr2line supports it.
3662 if (defined($sep_address)) {
3663 # Only add " -i" to addr2line if the binary supports it.
3664 # addr2line --help returns 0, but not if it sees an unknown flag first.
3665 if (system("$cmd -i --help >/dev/null 2>&1") == 0) {
3666 $cmd .= " -i";
3667 } else {
3668 $sep_address = undef; # no need for sep_address if we don't support -i
3669 }
3670 }
3671
3672 # Make file with all PC values with intervening 'sep_address' so
3673 # that we can reliably detect the end of inlined function list
3674 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
3675 if ($debug) { print("---- $image ---\n"); }
3676 for (my $i = 0; $i <= $#{$pclist}; $i++) {
3677 # addr2line always reads hex addresses, and does not need '0x' prefix.
3678 if ($debug) { printf("%s\n", $pclist->[$i]); }
3679 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
3680 if (defined($sep_address)) {
3681 printf ADDRESSES ("%s\n", $sep_address);
3682 }
3683 }
3684 close(ADDRESSES);
3685 if ($debug) {
3686 print("----\n");
3687 system("cat $main::tmpfile_sym");
3688 print("----\n");
3689 system("$cmd <$main::tmpfile_sym");
3690 print("----\n");
3691 }
3692
3693 open(SYMBOLS, "$cmd <$main::tmpfile_sym |") || error("$cmd: $!\n");
3694 my $count = 0; # Index in pclist
3695 while (<SYMBOLS>) { 3543 while (<SYMBOLS>) {
3696 # Read fullfunction and filelineinfo from next pair of lines
3697 s/\r?\n$//g; 3544 s/\r?\n$//g;
3698 my $fullfunction = $_; 3545 my $fullfunction = $_;
3546
3699 $_ = <SYMBOLS>; 3547 $_ = <SYMBOLS>;
3700 s/\r?\n$//g; 3548 s/\r?\n$//g;
3701 my $filelinenum = $_; 3549 my $filelinenum = $_;
3702 3550 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths
3703 if (defined($sep_address) && $fullfunction eq $sep_symbol) { 3551 if (!$main::opt_list) {
3704 # Terminating marker for data for this address 3552 $filelinenum =~ s|^.*/([^/]+:\d+)$|$1|; # Remove directory name
3705 $count++;
3706 next;
3707 } 3553 }
3708 3554
3709 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths 3555 my $pcstr = $pclist->[$count];
3556 if (defined($symbols->{$pcstr})) {
3557 # Override just the line-number portion. The function name portion
3558 # is less buggy when computed using nm instead of addr2line. But
3559 # don't override if addr2line is giving ??'s and nm didn't. (This
3560 # may be seen mostly/entirely on cygwin's addr2line/nm.)
3561 if (($filelinenum ne "??:0") || ($symbols->{$pcstr}->[1] eq "?")) {
3562 $symbols->{$pcstr}->[1] = $filelinenum;
3563 }
3564 } else {
3565 my $function = ShortFunctionName($fullfunction);
3566 $symbols->{$pcstr} = [$function, $filelinenum, $fullfunction];
3567 }
3568 $count++;
3569 }
3570 close(SYMBOLS);
3571 return $count;
3572 }
3710 3573
3711 my $pcstr = $pclist->[$count]; 3574 sub GetLineNumbers {
3712 my $function = ShortFunctionName($fullfunction); 3575 my $image = shift;
3713 if ($fullfunction eq '??') { 3576 my $offset = shift;
3714 # See if nm found a symbol 3577 my $pclist = shift;
3715 my $nms = $nm_symbols->{$pcstr}; 3578 my $symbols = shift;
3716 if (defined($nms)) {
3717 $function = $nms->[0];
3718 $fullfunction = $nms->[2];
3719 }
3720 }
3721 3579
3722 # Prepend to accumulated symbols for pcstr 3580 # Make file with all PC values
3723 # (so that caller comes before callee) 3581 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
3724 my $sym = $symbols->{$pcstr}; 3582 for (my $i = 0; $i <= $#{$pclist}; $i++) {
3725 if (!defined($sym)) { 3583 # addr2line always reads hex addresses, and does not need '0x' prefix.
3726 $sym = []; 3584 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
3727 $symbols->{$pcstr} = $sym; 3585 }
3728 } 3586 close(ADDRESSES);
3729 unshift(@{$sym}, $function, $filelinenum, $fullfunction); 3587
3730 if ($debug) { printf("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } 3588 # Pass to addr2line
3731 if (!defined($sep_address)) { 3589 my $addr2line = $obj_tool_map{"addr2line"};
3732 # Inlining is off, se this entry ends immediately 3590 my @addr2line_commands = ("$addr2line -f -C -e $image");
3733 $count++; 3591 if (exists $obj_tool_map{"addr2line_pdb"}) {
3592 my $addr2line_pdb = $obj_tool_map{"addr2line_pdb"};
3593 push(@addr2line_commands, "$addr2line_pdb --demangle -f -C -e $image");
3594 }
3595 foreach my $addr2line_command (@addr2line_commands) {
3596 if (GetLineNumbersViaAddr2Line("$addr2line_command", $pclist, $symbols)) {
3597 last;
3734 } 3598 }
3735 } 3599 }
3736 close(SYMBOLS);
3737 } 3600 }
3738 3601
3739 # Use nm to map the list of referenced PCs to symbols. Return true iff we 3602 # Use nm to map the list of referenced PCs to symbols. Return true iff we
3740 # are able to read procedure information via nm. 3603 # are able to read procedure information via nm.
3741 sub MapSymbolsWithNM { 3604 sub MapSymbolsWithNM {
3742 my $image = shift; 3605 my $image = shift;
3743 my $offset = shift; 3606 my $offset = shift;
3744 my $pclist = shift; 3607 my $pclist = shift;
3745 my $symbols = shift; 3608 my $symbols = shift;
3746 3609
(...skipping 29 matching lines...) Expand all
3776 } 3639 }
3777 if ($mpc lt $symbol_table->{$fullname}->[1]) { 3640 if ($mpc lt $symbol_table->{$fullname}->[1]) {
3778 $symbols->{$pc} = [$name, "?", $fullname]; 3641 $symbols->{$pc} = [$name, "?", $fullname];
3779 } else { 3642 } else {
3780 my $pcstr = "0x" . $pc; 3643 my $pcstr = "0x" . $pc;
3781 $symbols->{$pc} = [$pcstr, "?", $pcstr]; 3644 $symbols->{$pc} = [$pcstr, "?", $pcstr];
3782 } 3645 }
3783 } 3646 }
3784 return 1; 3647 return 1;
3785 } 3648 }
3786 3649
3787 sub ShortFunctionName { 3650 sub ShortFunctionName {
3788 my $function = shift; 3651 my $function = shift;
3789 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types 3652 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types
3790 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments 3653 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments
3791 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type 3654 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type
3792 return $function; 3655 return $function;
3793 } 3656 }
3794 3657
3795 ##### Miscellaneous ##### 3658 ##### Miscellaneous #####
3796 3659
(...skipping 146 matching lines...) Expand 10 before | Expand all | Expand 10 after
3943 # got touched in the queue), and ignore the others. 3806 # got touched in the queue), and ignore the others.
3944 if ($start_val eq $last_start && $type =~ /t/i) { 3807 if ($start_val eq $last_start && $type =~ /t/i) {
3945 # We are the 'T' symbol at this address, replace previous symbol. 3808 # We are the 'T' symbol at this address, replace previous symbol.
3946 $routine = $this_routine; 3809 $routine = $this_routine;
3947 next; 3810 next;
3948 } elsif ($start_val eq $last_start) { 3811 } elsif ($start_val eq $last_start) {
3949 # We're not the 'T' symbol at this address, so ignore us. 3812 # We're not the 'T' symbol at this address, so ignore us.
3950 next; 3813 next;
3951 } 3814 }
3952 3815
3953 if ($this_routine eq $sep_symbol) {
3954 $sep_address = HexExtend($start_val);
3955 }
3956
3957 # Tag this routine with the starting address in case the image 3816 # Tag this routine with the starting address in case the image
3958 # has multiple occurrences of this routine. We use a syntax 3817 # has multiple occurrences of this routine. We use a syntax
3959 # that resembles template paramters that are automatically 3818 # that resembles template paramters that are automatically
3960 # stripped out by ShortFunctionName() 3819 # stripped out by ShortFunctionName()
3961 $this_routine .= "<$start_val>"; 3820 $this_routine .= "<$start_val>";
3962 3821
3963 if (defined($routine) && $routine =~ m/$regexp/) { 3822 if (defined($routine) && $routine =~ m/$regexp/) {
3964 $symbol_table->{$routine} = [HexExtend($last_start), 3823 $symbol_table->{$routine} = [HexExtend($last_start),
3965 HexExtend($start_val)]; 3824 HexExtend($start_val)];
3966 } 3825 }
(...skipping 290 matching lines...) Expand 10 before | Expand all | Expand 10 after
4257 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); 4116 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);
4258 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); 4117 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);
4259 if ($error_count > 0) { 4118 if ($error_count > 0) {
4260 print STDERR $error_count, " errors: FAILED\n"; 4119 print STDERR $error_count, " errors: FAILED\n";
4261 } else { 4120 } else {
4262 print STDERR "PASS\n"; 4121 print STDERR "PASS\n";
4263 } 4122 }
4264 exit ($error_count); 4123 exit ($error_count);
4265 } 4124 }
4266 4125
OLDNEW
« no previous file with comments | « third_party/tcmalloc/chromium/src/pagemap.h ('k') | third_party/tcmalloc/chromium/src/profile-handler.cc » ('j') | no next file with comments »

Powered by Google App Engine
This is Rietveld 408576698