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

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

Issue 440027: Merge r77 from upstream tcmalloc to the local chromium branch.... (Closed) Base URL: svn://chrome-svn/chrome/trunk/src/
Patch Set: Created 11 years 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 74 matching lines...) Expand 10 before | Expand all | Expand 10 after
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 257 matching lines...) Expand 10 before | Expand all | Expand 10 after
2049 return $result; 1971 return $result;
2050 } 1972 }
2051 1973
2052 # Reduce profile to granularity given by user 1974 # Reduce profile to granularity given by user
2053 sub ReduceProfile { 1975 sub ReduceProfile {
2054 my $symbols = shift; 1976 my $symbols = shift;
2055 my $profile = shift; 1977 my $profile = shift;
2056 my $result = {}; 1978 my $result = {};
2057 foreach my $k (keys(%{$profile})) { 1979 foreach my $k (keys(%{$profile})) {
2058 my $count = $profile->{$k}; 1980 my $count = $profile->{$k};
2059 my @translated = TranslateStack($symbols, $k); 1981 my @addrs = split(/\n/, $k);
2060 my @path = (); 1982 my @path = ();
2061 my %seen = (); 1983 my %seen = ();
2062 $seen{''} = 1; # So that empty keys are skipped 1984 $seen{''} = 1; # So that empty keys are skipped
2063 foreach my $e (@translated) { 1985 foreach my $a (@addrs) {
2064 # To avoid double-counting due to recursion, skip a stack-trace 1986 # To avoid double-counting due to recursion, skip a stack-trace
2065 # entry if it has already been seen 1987 # entry if it has already been seen
2066 if (!$seen{$e}) { 1988 my $key = OutputKey($symbols, $a);
2067 » $seen{$e} = 1; 1989 if (!$seen{$key}) {
2068 » push(@path, $e); 1990 » $seen{$key} = 1;
1991 » push(@path, $key);
2069 } 1992 }
2070 } 1993 }
2071 my $reduced_path = join("\n", @path); 1994 my $reduced_path = join("\n", @path);
2072 AddEntry($result, $reduced_path, $count); 1995 AddEntry($result, $reduced_path, $count);
2073 } 1996 }
2074 return $result; 1997 return $result;
2075 } 1998 }
2076 1999
2077 # Does the specified symbol array match the regexp?
2078 sub SymbolMatches {
2079 my $sym = shift;
2080 my $re = shift;
2081 if (defined($sym)) {
2082 for (my $i = 0; $i < $#{$sym}; $i += 3) {
2083 if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) {
2084 return 1;
2085 }
2086 }
2087 }
2088 return 0;
2089 }
2090
2091 # Focus only on paths involving specified regexps 2000 # Focus only on paths involving specified regexps
2092 sub FocusProfile { 2001 sub FocusProfile {
2093 my $symbols = shift; 2002 my $symbols = shift;
2094 my $profile = shift; 2003 my $profile = shift;
2095 my $focus = shift; 2004 my $focus = shift;
2096 my $result = {}; 2005 my $result = {};
2097 foreach my $k (keys(%{$profile})) { 2006 foreach my $k (keys(%{$profile})) {
2098 my $count = $profile->{$k}; 2007 my $count = $profile->{$k};
2099 my @addrs = split(/\n/, $k); 2008 my @addrs = split(/\n/, $k);
2100 foreach my $a (@addrs) { 2009 foreach my $a (@addrs) {
2101 # Reply if it matches either the address/shortname/fileline 2010 # Reply if it matches either the address/shortname/fileline
2102 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/)))) {
2103 AddEntry($result, $k, $count); 2015 AddEntry($result, $k, $count);
2104 last; 2016 last;
2105 } 2017 }
2106 } 2018 }
2107 } 2019 }
2108 return $result; 2020 return $result;
2109 } 2021 }
2110 2022
2111 # Focus only on paths not involving specified regexps 2023 # Focus only on paths not involving specified regexps
2112 sub IgnoreProfile { 2024 sub IgnoreProfile {
2113 my $symbols = shift; 2025 my $symbols = shift;
2114 my $profile = shift; 2026 my $profile = shift;
2115 my $ignore = shift; 2027 my $ignore = shift;
2116 my $result = {}; 2028 my $result = {};
2117 foreach my $k (keys(%{$profile})) { 2029 foreach my $k (keys(%{$profile})) {
2118 my $count = $profile->{$k}; 2030 my $count = $profile->{$k};
2119 my @addrs = split(/\n/, $k); 2031 my @addrs = split(/\n/, $k);
2120 my $matched = 0; 2032 my $matched = 0;
2121 foreach my $a (@addrs) { 2033 foreach my $a (@addrs) {
2122 # Reply if it matches either the address/shortname/fileline 2034 # Reply if it matches either the address/shortname/fileline
2123 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/)))) {
2124 $matched = 1; 2039 $matched = 1;
2125 last; 2040 last;
2126 } 2041 }
2127 } 2042 }
2128 if (!$matched) { 2043 if (!$matched) {
2129 AddEntry($result, $k, $count); 2044 AddEntry($result, $k, $count);
2130 } 2045 }
2131 } 2046 }
2132 return $result; 2047 return $result;
2133 } 2048 }
(...skipping 139 matching lines...) Expand 10 before | Expand all | Expand 10 after
2273 my @lines = <TFILE>; 2188 my @lines = <TFILE>;
2274 my $result = grep(/^--- *$symbol_marker/, @lines); 2189 my $result = grep(/^--- *$symbol_marker/, @lines);
2275 close(TFILE); 2190 close(TFILE);
2276 return $result > 0; 2191 return $result > 0;
2277 } 2192 }
2278 2193
2279 ##### Code to profile a server dynamically ##### 2194 ##### Code to profile a server dynamically #####
2280 2195
2281 sub CheckSymbolPage { 2196 sub CheckSymbolPage {
2282 my $url = SymbolPageURL(); 2197 my $url = SymbolPageURL();
2283 open(SYMBOL, "$WGET $WGET_FLAGS -qO- '$url' |"); 2198 open(SYMBOL, "$WGET -qO- '$url' |");
2284 my $line = <SYMBOL>; 2199 my $line = <SYMBOL>;
2285 $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
2286 close(SYMBOL); 2201 close(SYMBOL);
2287 unless (defined($line)) { 2202 unless (defined($line)) {
2288 error("$url doesn't exist\n"); 2203 error("$url doesn't exist\n");
2289 } 2204 }
2290 2205
2291 if ($line =~ /^num_symbols:\s+(\d+)$/) { 2206 if ($line =~ /^num_symbols:\s+(\d+)$/) {
2292 if ($1 == 0) { 2207 if ($1 == 0) {
2293 error("Stripped binary. No symbols available.\n"); 2208 error("Stripped binary. No symbols available.\n");
(...skipping 24 matching lines...) Expand all
2318 2233
2319 # We fetch symbols from the first profile argument. 2234 # We fetch symbols from the first profile argument.
2320 sub SymbolPageURL { 2235 sub SymbolPageURL {
2321 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]); 2236 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
2322 return "http://$host:$port$SYMBOL_PAGE"; 2237 return "http://$host:$port$SYMBOL_PAGE";
2323 } 2238 }
2324 2239
2325 sub FetchProgramName() { 2240 sub FetchProgramName() {
2326 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]); 2241 my ($host, $port, $path) = ParseProfileURL($main::pfile_args[0]);
2327 my $url = "http://$host:$port$PROGRAM_NAME_PAGE"; 2242 my $url = "http://$host:$port$PROGRAM_NAME_PAGE";
2328 my $command_line = "$WGET $WGET_FLAGS -qO- '$url'"; 2243 my $command_line = "$WGET -qO- '$url'";
2329 open(CMDLINE, "$command_line |") or error($command_line); 2244 open(CMDLINE, "$command_line |") or error($command_line);
2330 my $cmdline = <CMDLINE>; 2245 my $cmdline = <CMDLINE>;
2331 $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
2332 close(CMDLINE); 2247 close(CMDLINE);
2333 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);
2334 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters. 2249 $cmdline =~ s/\x00.+//; # Remove argv[1] and latters.
2335 $cmdline =~ s!\n!!g; # Remove LFs. 2250 $cmdline =~ s!\n!!g; # Remove LFs.
2336 return $cmdline; 2251 return $cmdline;
2337 } 2252 }
2338 2253
(...skipping 85 matching lines...) Expand 10 before | Expand all | Expand 10 after
2424 my $symbols = {}; 2339 my $symbols = {};
2425 foreach my $pc (@pcs) { 2340 foreach my $pc (@pcs) {
2426 my $fullname; 2341 my $fullname;
2427 # For 64 bits binaries, symbols are extracted with 8 leading zeroes. 2342 # For 64 bits binaries, symbols are extracted with 8 leading zeroes.
2428 # Then /symbol reads the long symbols in as uint64, and outputs 2343 # Then /symbol reads the long symbols in as uint64, and outputs
2429 # 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.
2430 # 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
2431 # /symbol, the symbols match and are retrievable from the map. 2346 # /symbol, the symbols match and are retrievable from the map.
2432 my $shortpc = $pc; 2347 my $shortpc = $pc;
2433 $shortpc =~ s/^0*//; 2348 $shortpc =~ s/^0*//;
2434 # Each line may have a list of names, which includes the function
2435 # and also other functions it has inlined. They are separated
2436 # (in PrintSymbolizedFile), by --, which is illegal in function names.
2437 my $fullnames;
2438 if (defined($symbol_map->{$shortpc})) { 2349 if (defined($symbol_map->{$shortpc})) {
2439 $fullnames = $symbol_map->{$shortpc}; 2350 $fullname = $symbol_map->{$shortpc};
2440 } else { 2351 } else {
2441 $fullnames = "0x" . $pc; # Just use addresses 2352 $fullname = "0x" . $pc; # Just use addresses
2442 } 2353 }
2443 my $sym = []; 2354 my $name = ShortFunctionName($fullname);
2444 $symbols->{$pc} = $sym; 2355 $symbols->{$pc} = [$name, "?", $fullname];
2445 foreach my $fullname (split("--", $fullnames)) {
2446 my $name = ShortFunctionName($fullname);
2447 push(@{$sym}, $name, "?", $fullname);
2448 }
2449 } 2356 }
2450 return $symbols; 2357 return $symbols;
2451 } 2358 }
2452 2359
2453 sub BaseName { 2360 sub BaseName {
2454 my $file_name = shift; 2361 my $file_name = shift;
2455 $file_name =~ s!^.*/!!; # Remove directory name 2362 $file_name =~ s!^.*/!!; # Remove directory name
2456 return $file_name; 2363 return $file_name;
2457 } 2364 }
2458 2365
(...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after
2513 mkdir($profile_dir) 2420 mkdir($profile_dir)
2514 || die("Unable to create profile directory $profile_dir: $!\n"); 2421 || die("Unable to create profile directory $profile_dir: $!\n");
2515 } 2422 }
2516 my $tmp_profile = "$profile_dir/.tmp.$profile_file"; 2423 my $tmp_profile = "$profile_dir/.tmp.$profile_file";
2517 my $real_profile = "$profile_dir/$profile_file"; 2424 my $real_profile = "$profile_dir/$profile_file";
2518 2425
2519 if ($fetch_name_only > 0) { 2426 if ($fetch_name_only > 0) {
2520 return $real_profile; 2427 return $real_profile;
2521 } 2428 }
2522 2429
2523 my $cmd = "$WGET $WGET_FLAGS $wget_timeout -q -O $tmp_profile '$url'"; 2430 my $cmd = "$WGET $wget_timeout -q -O $tmp_profile '$url'";
2524 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){ 2431 if (($path =~ m/$PROFILE_PAGE/) || ($path =~ m/$PMUPROFILE_PAGE/)){
2525 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";
2526 if ($encourage_patience) { 2433 if ($encourage_patience) {
2527 print STDERR "Be patient...\n"; 2434 print STDERR "Be patient...\n";
2528 } 2435 }
2529 } else { 2436 } else {
2530 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";
2531 } 2438 }
2532 2439
2533 (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
2838 error("$fname: stack trace depth >= 2**32\n"); 2745 error("$fname: stack trace depth >= 2**32\n");
2839 } 2746 }
2840 if ($slots->get($i) == 0 && $slots->get($i+1) == 0) { 2747 if ($slots->get($i) == 0 && $slots->get($i+1) == 0) {
2841 # End of profile data marker 2748 # End of profile data marker
2842 $i += 2 * $d; 2749 $i += 2 * $d;
2843 last; 2750 last;
2844 } 2751 }
2845 2752
2846 # Make key out of the stack entries 2753 # Make key out of the stack entries
2847 my @k = (); 2754 my @k = ();
2848 for (my $j = 0; $j < $d; $j++) { 2755 for (my $j = $d; $j--; ) {
2849 my $pclo = $slots->get($i++); 2756 my $pclo = $slots->get($i++);
2850 my $pchi = $slots->get($i++); 2757 my $pchi = $slots->get($i++);
2851 if ($pclo == -1 || $pchi == -1) { 2758 if ($pclo == -1 || $pchi == -1) {
2852 error("$fname: Unexpected EOF when reading stack of depth $d\n"); 2759 error("$fname: Unexpected EOF when reading stack of depth $d\n");
2853 } 2760 }
2854
2855 # Subtract one from caller pc so we map back to call instr.
2856 # However, don't do this if we're reading a symbolized profile
2857 # file, in which case the subtract-one was done when the file
2858 # was written.
2859 if ($j > 0 && !$main::use_symbolized_profile) {
2860 if ($pclo == 0) {
2861 $pchi--;
2862 $pclo = 0xffffffff;
2863 } else {
2864 $pclo--;
2865 }
2866 }
2867
2868 my $pc = sprintf("%08x%08x", $pchi, $pclo); 2761 my $pc = sprintf("%08x%08x", $pchi, $pclo);
2869 $pcs->{$pc} = 1; 2762 $pcs->{$pc} = 1;
2870 push @k, $pc; 2763 push @k, $pc;
2871 } 2764 }
2872 AddEntry($profile, (join "\n", @k), $n); 2765 AddEntry($profile, (join "\n", @k), $n);
2873 } 2766 }
2874 } 2767 }
2875 2768
2876 # Parse map 2769 # Parse map
2877 my $map = ''; 2770 my $map = '';
(...skipping 738 matching lines...) Expand 10 before | Expand all | Expand 10 after
3616 return $symbols; 3509 return $symbols;
3617 } 3510 }
3618 3511
3619 # Map list of PC values to symbols for a given image 3512 # Map list of PC values to symbols for a given image
3620 sub MapToSymbols { 3513 sub MapToSymbols {
3621 my $image = shift; 3514 my $image = shift;
3622 my $offset = shift; 3515 my $offset = shift;
3623 my $pclist = shift; 3516 my $pclist = shift;
3624 my $symbols = shift; 3517 my $symbols = shift;
3625 3518
3626 my $debug = 0;
3627
3628 # Ignore empty binaries 3519 # Ignore empty binaries
3629 if ($#{$pclist} < 0) { return; } 3520 if ($#{$pclist} < 0) { return; }
3630 3521
3631 # Figure out the addr2line command to use 3522 my $got_symbols = MapSymbolsWithNM($image, $offset, $pclist, $symbols);
3632 my $addr2line = $obj_tool_map{"addr2line"}; 3523 if ($main::opt_interactive ||
3633 my $cmd = "$addr2line -f -C -e $image"; 3524 $main::opt_addresses ||
3634 if (exists $obj_tool_map{"addr2line_pdb"}) { 3525 $main::opt_lines ||
3635 $addr2line = $obj_tool_map{"addr2line_pdb"}; 3526 $main::opt_files ||
3636 $cmd = "$addr2line --demangle -f -C -e $image"; 3527 $main::opt_list ||
3528 $main::opt_callgrind ||
3529 !$got_symbols) {
3530 GetLineNumbers($image, $offset, $pclist, $symbols);
3637 } 3531 }
3532 }
3638 3533
3639 # 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.
3640 # nm to get what info we can (function names, but not line numbers). 3535 sub GetLineNumbersViaAddr2Line {
3641 if (system("$addr2line --help >/dev/null 2>&1") != 0) { 3536 my $addr2line_command = shift;
3642 MapSymbolsWithNM($image, $offset, $pclist, $symbols); 3537 my $pclist = shift;
3643 return; 3538 my $symbols = shift;
3644 }
3645 3539
3646 # "addr2line -i" can produce a variable number of lines per input 3540 open(SYMBOLS, "$addr2line_command <$main::tmpfile_sym |")
3647 # address, with no separator that allows us to tell when data for 3541 || error("$addr2line_command: $!\n");
3648 # the next address starts. So we find the address for a special 3542 my $count = 0;
3649 # symbol (_fini) and interleave this address between all real
3650 # addresses passed to addr2line. The name of this special symbol
3651 # can then be used as a separator.
3652 $sep_address = undef; # May be filled in by MapSymbolsWithNM()
3653 my $nm_symbols = {};
3654 MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);
3655 # TODO(csilvers): only add '-i' if addr2line supports it.
3656 if (defined($sep_address)) {
3657 # Only add " -i" to addr2line if the binary supports it.
3658 # addr2line --help returns 0, but not if it sees an unknown flag first.
3659 if (system("$cmd -i --help >/dev/null 2>&1") == 0) {
3660 $cmd .= " -i";
3661 } else {
3662 $sep_address = undef; # no need for sep_address if we don't support -i
3663 }
3664 }
3665
3666 # Make file with all PC values with intervening 'sep_address' so
3667 # that we can reliably detect the end of inlined function list
3668 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
3669 if ($debug) { print("---- $image ---\n"); }
3670 for (my $i = 0; $i <= $#{$pclist}; $i++) {
3671 # addr2line always reads hex addresses, and does not need '0x' prefix.
3672 if ($debug) { printf("%s\n", $pclist->[$i]); }
3673 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
3674 if (defined($sep_address)) {
3675 printf ADDRESSES ("%s\n", $sep_address);
3676 }
3677 }
3678 close(ADDRESSES);
3679 if ($debug) {
3680 print("----\n");
3681 system("cat $main::tmpfile_sym");
3682 print("----\n");
3683 system("$cmd <$main::tmpfile_sym");
3684 print("----\n");
3685 }
3686
3687 open(SYMBOLS, "$cmd <$main::tmpfile_sym |") || error("$cmd: $!\n");
3688 my $count = 0; # Index in pclist
3689 while (<SYMBOLS>) { 3543 while (<SYMBOLS>) {
3690 # Read fullfunction and filelineinfo from next pair of lines
3691 s/\r?\n$//g; 3544 s/\r?\n$//g;
3692 my $fullfunction = $_; 3545 my $fullfunction = $_;
3546
3693 $_ = <SYMBOLS>; 3547 $_ = <SYMBOLS>;
3694 s/\r?\n$//g; 3548 s/\r?\n$//g;
3695 my $filelinenum = $_; 3549 my $filelinenum = $_;
3696 3550 $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths
3697 if (defined($sep_address) && $fullfunction eq $sep_symbol) { 3551 if (!$main::opt_list) {
3698 # Terminating marker for data for this address 3552 $filelinenum =~ s|^.*/([^/]+:\d+)$|$1|; # Remove directory name
3699 $count++;
3700 next;
3701 } 3553 }
3702 3554
3703 $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 }
3704 3573
3705 my $pcstr = $pclist->[$count]; 3574 sub GetLineNumbers {
3706 my $function = ShortFunctionName($fullfunction); 3575 my $image = shift;
3707 if ($fullfunction eq '??') { 3576 my $offset = shift;
3708 # See if nm found a symbol 3577 my $pclist = shift;
3709 my $nms = $nm_symbols->{$pcstr}; 3578 my $symbols = shift;
3710 if (defined($nms)) {
3711 $function = $nms->[0];
3712 $fullfunction = $nms->[2];
3713 }
3714 }
3715 3579
3716 # Prepend to accumulated symbols for pcstr 3580 # Make file with all PC values
3717 # (so that caller comes before callee) 3581 open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
3718 my $sym = $symbols->{$pcstr}; 3582 for (my $i = 0; $i <= $#{$pclist}; $i++) {
3719 if (!defined($sym)) { 3583 # addr2line always reads hex addresses, and does not need '0x' prefix.
3720 $sym = []; 3584 printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
3721 $symbols->{$pcstr} = $sym; 3585 }
3722 } 3586 close(ADDRESSES);
3723 unshift(@{$sym}, $function, $filelinenum, $fullfunction); 3587
3724 if ($debug) { printf("%s => [%s]\n", $pcstr, join(" ", @{$sym})); } 3588 # Pass to addr2line
3725 if (!defined($sep_address)) { 3589 my $addr2line = $obj_tool_map{"addr2line"};
3726 # Inlining is off, se this entry ends immediately 3590 my @addr2line_commands = ("$addr2line -f -C -e $image");
3727 $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;
3728 } 3598 }
3729 } 3599 }
3730 close(SYMBOLS);
3731 } 3600 }
3732 3601
3733 # 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
3734 # are able to read procedure information via nm. 3603 # are able to read procedure information via nm.
3735 sub MapSymbolsWithNM { 3604 sub MapSymbolsWithNM {
3736 my $image = shift; 3605 my $image = shift;
3737 my $offset = shift; 3606 my $offset = shift;
3738 my $pclist = shift; 3607 my $pclist = shift;
3739 my $symbols = shift; 3608 my $symbols = shift;
3740 3609
(...skipping 29 matching lines...) Expand all
3770 } 3639 }
3771 if ($mpc lt $symbol_table->{$fullname}->[1]) { 3640 if ($mpc lt $symbol_table->{$fullname}->[1]) {
3772 $symbols->{$pc} = [$name, "?", $fullname]; 3641 $symbols->{$pc} = [$name, "?", $fullname];
3773 } else { 3642 } else {
3774 my $pcstr = "0x" . $pc; 3643 my $pcstr = "0x" . $pc;
3775 $symbols->{$pc} = [$pcstr, "?", $pcstr]; 3644 $symbols->{$pc} = [$pcstr, "?", $pcstr];
3776 } 3645 }
3777 } 3646 }
3778 return 1; 3647 return 1;
3779 } 3648 }
3780 3649
3781 sub ShortFunctionName { 3650 sub ShortFunctionName {
3782 my $function = shift; 3651 my $function = shift;
3783 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types 3652 while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types
3784 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments 3653 while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments
3785 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type 3654 $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type
3786 return $function; 3655 return $function;
3787 } 3656 }
3788 3657
3789 ##### Miscellaneous ##### 3658 ##### Miscellaneous #####
3790 3659
(...skipping 146 matching lines...) Expand 10 before | Expand all | Expand 10 after
3937 # got touched in the queue), and ignore the others. 3806 # got touched in the queue), and ignore the others.
3938 if ($start_val eq $last_start && $type =~ /t/i) { 3807 if ($start_val eq $last_start && $type =~ /t/i) {
3939 # We are the 'T' symbol at this address, replace previous symbol. 3808 # We are the 'T' symbol at this address, replace previous symbol.
3940 $routine = $this_routine; 3809 $routine = $this_routine;
3941 next; 3810 next;
3942 } elsif ($start_val eq $last_start) { 3811 } elsif ($start_val eq $last_start) {
3943 # 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.
3944 next; 3813 next;
3945 } 3814 }
3946 3815
3947 if ($this_routine eq $sep_symbol) {
3948 $sep_address = HexExtend($start_val);
3949 }
3950
3951 # Tag this routine with the starting address in case the image 3816 # Tag this routine with the starting address in case the image
3952 # has multiple occurrences of this routine. We use a syntax 3817 # has multiple occurrences of this routine. We use a syntax
3953 # that resembles template paramters that are automatically 3818 # that resembles template paramters that are automatically
3954 # stripped out by ShortFunctionName() 3819 # stripped out by ShortFunctionName()
3955 $this_routine .= "<$start_val>"; 3820 $this_routine .= "<$start_val>";
3956 3821
3957 if (defined($routine) && $routine =~ m/$regexp/) { 3822 if (defined($routine) && $routine =~ m/$regexp/) {
3958 $symbol_table->{$routine} = [HexExtend($last_start), 3823 $symbol_table->{$routine} = [HexExtend($last_start),
3959 HexExtend($start_val)]; 3824 HexExtend($start_val)];
3960 } 3825 }
(...skipping 290 matching lines...) Expand 10 before | Expand all | Expand 10 after
4251 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16); 4116 $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);
4252 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16); 4117 $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);
4253 if ($error_count > 0) { 4118 if ($error_count > 0) {
4254 print STDERR $error_count, " errors: FAILED\n"; 4119 print STDERR $error_count, " errors: FAILED\n";
4255 } else { 4120 } else {
4256 print STDERR "PASS\n"; 4121 print STDERR "PASS\n";
4257 } 4122 }
4258 exit ($error_count); 4123 exit ($error_count);
4259 } 4124 }
4260 4125
OLDNEW
« no previous file with comments | « third_party/tcmalloc/chromium/src/pagemap.h ('k') | third_party/tcmalloc/chromium/src/stacktrace_config.h » ('j') | no next file with comments »

Powered by Google App Engine
This is Rietveld 408576698