| OLD | NEW |
| 1 #! /usr/bin/env perl | 1 #! /usr/bin/env perl |
| 2 | 2 |
| 3 # Copyright (c) 1998-2007, Google Inc. | 3 # Copyright (c) 1998-2007, Google Inc. |
| 4 # All rights reserved. | 4 # All rights reserved. |
| 5 # | 5 # |
| 6 # Redistribution and use in source and binary forms, with or without | 6 # Redistribution and use in source and binary forms, with or without |
| 7 # modification, are permitted provided that the following conditions are | 7 # modification, are permitted provided that the following conditions are |
| 8 # met: | 8 # met: |
| 9 # | 9 # |
| 10 # * Redistributions of source code must retain the above copyright | 10 # * Redistributions of source code must retain the above copyright |
| (...skipping 54 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 65 # Generates disassembly listing of all routines with at least one | 65 # Generates disassembly listing of all routines with at least one |
| 66 # sample that match the --disasm=<regexp> pattern. The listing is | 66 # sample that match the --disasm=<regexp> pattern. The listing is |
| 67 # annotated with the flat and cumulative sample counts at each PC value. | 67 # annotated with the flat and cumulative sample counts at each PC value. |
| 68 # | 68 # |
| 69 # TODO: Use color to indicate files? | 69 # TODO: Use color to indicate files? |
| 70 | 70 |
| 71 use strict; | 71 use strict; |
| 72 use warnings; | 72 use warnings; |
| 73 use Getopt::Long; | 73 use Getopt::Long; |
| 74 | 74 |
| 75 my $PPROF_VERSION = "1.5"; | 75 my $PPROF_VERSION = "1.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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 Loading... |
| 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 |
| OLD | NEW |