Support threaded heap profiles in pprof

    - Add a --thread N option to select profile for thread N (otherwise, all
      threads will be printed)
    - The $profile map now has a {threads} element that is a map from thread id to
      a profile that has the same format as the {profile} element
    - Refactor ReadHeapProfile into smaller components and use them to implement
      ReadThreadedHeapProfile

1 files changed, 251 insertions, 126 deletions

diff --git a/bin/pprof b/bin/pprof
index 328138cd..52da6004 100755
--- a/bin/pprof
+++ b/bin/pprof
@@ -2,11 +2,11 @@
 
 # Copyright (c) 1998-2007, Google Inc.
 # All rights reserved.
-# 
+#
 # Redistribution and use in source and binary forms, with or without
 # modification, are permitted provided that the following conditions are
 # met:
-# 
+#
 #     * Redistributions of source code must retain the above copyright
 # notice, this list of conditions and the following disclaimer.
 #     * Redistributions in binary form must reproduce the above
@@ -16,7 +16,7 @@
 #     * Neither the name of Google Inc. nor the names of its
 # contributors may be used to endorse or promote products derived from
 # this software without specific prior written permission.
-# 
+#
 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
@@ -223,6 +223,7 @@ Call-graph Options:
    --edgefraction=<f>  Hide edges below <f>*total [default=.001]
    --maxdegree=<n>     Max incoming/outgoing edges per node [default=8]
    --focus=<regexp>    Focus on nodes matching <regexp>
+   --thread=<n>        Show profile for thread <n>
    --ignore=<regexp>   Ignore nodes matching <regexp>
    --scale=<n>         Set GV scaling [default=0]
    --heapcheck         Make nodes with non-0 object counts
@@ -332,6 +333,7 @@ sub Init() {
   $main::opt_edgefraction = 0.001;
   $main::opt_maxdegree = 8;
   $main::opt_focus = '';
+  $main::opt_thread = undef;
   $main::opt_ignore = '';
   $main::opt_scale = 0;
   $main::opt_heapcheck = 0;
@@ -402,6 +404,7 @@ sub Init() {
              "edgefraction=f" => \$main::opt_edgefraction,
              "maxdegree=i"    => \$main::opt_maxdegree,
              "focus=s"        => \$main::opt_focus,
+             "thread=i"       => \$main::opt_thread,
              "ignore=s"       => \$main::opt_ignore,
              "scale=i"        => \$main::opt_scale,
              "heapcheck"      => \$main::opt_heapcheck,
@@ -562,66 +565,12 @@ sub Init() {
   }
 }
 
-sub Main() {
-  Init();
-  $main::collected_profile = undef;
-  @main::profile_files = ();
-  $main::op_time = time();
-
-  # Printing symbols is special and requires a lot less info that most.
-  if ($main::opt_symbols) {
-    PrintSymbols(*STDIN);   # Get /proc/maps and symbols output from stdin
-    return;
-  }
-
-  # Fetch all profile data
-  FetchDynamicProfiles();
-
-  # this will hold symbols that we read from the profile files
-  my $symbol_map = {};
-
-  # Read one profile, pick the last item on the list
-  my $data = ReadProfile($main::prog, pop(@main::profile_files));
-  my $profile = $data->{profile};
-  my $pcs = $data->{pcs};
-  my $libs = $data->{libs};   # Info about main program and shared libraries
-  $symbol_map = MergeSymbols($symbol_map, $data->{symbols});
-
-  # Add additional profiles, if available.
-  if (scalar(@main::profile_files) > 0) {
-    foreach my $pname (@main::profile_files) {
-      my $data2 = ReadProfile($main::prog, $pname);
-      $profile = AddProfile($profile, $data2->{profile});
-      $pcs = AddPcs($pcs, $data2->{pcs});
-      $symbol_map = MergeSymbols($symbol_map, $data2->{symbols});
-    }
-  }
-
-  # Subtract base from profile, if specified
-  if ($main::opt_base ne '') {
-    my $base = ReadProfile($main::prog, $main::opt_base);
-    $profile = SubtractProfile($profile, $base->{profile});
-    $pcs = AddPcs($pcs, $base->{pcs});
-    $symbol_map = MergeSymbols($symbol_map, $base->{symbols});
-  }
+sub FilterAndPrint {
+  my ($profile, $symbols, $libs, $thread) = @_;
 
   # Get total data in profile
   my $total = TotalProfile($profile);
 
-  # Collect symbols
-  my $symbols;
-  if ($main::use_symbolized_profile) {
-    $symbols = FetchSymbols($pcs, $symbol_map);
-  } elsif ($main::use_symbol_page) {
-    $symbols = FetchSymbols($pcs);
-  } else {
-    # TODO(csilvers): $libs uses the /proc/self/maps data from profile1,
-    # which may differ from the data from subsequent profiles, especially
-    # if they were run on different machines.  Use appropriate libs for
-    # each pc somehow.
-    $symbols = ExtractSymbols($libs, $pcs);
-  }
-
   # Remove uniniteresting stack items
   $profile = RemoveUninterestingFrames($symbols, $profile);
 
@@ -656,7 +605,9 @@ sub Main() {
       # (only matters when --heapcheck is given but we must be
       # compatible with old branches that did not pass --heapcheck always):
       if ($total != 0) {
-        printf("Total: %s %s\n", Unparse($total), Units());
+        printf("Total%s: %s %s\n",
+               (defined($thread) ? " (t$thread)" : ""),
+               Unparse($total), Units());
       }
       PrintText($symbols, $flat, $cumulative, -1);
     } elsif ($main::opt_raw) {
@@ -692,6 +643,76 @@ sub Main() {
   } else {
     InteractiveMode($profile, $symbols, $libs, $total);
   }
+}
+
+sub Main() {
+  Init();
+  $main::collected_profile = undef;
+  @main::profile_files = ();
+  $main::op_time = time();
+
+  # Printing symbols is special and requires a lot less info that most.
+  if ($main::opt_symbols) {
+    PrintSymbols(*STDIN);   # Get /proc/maps and symbols output from stdin
+    return;
+  }
+
+  # Fetch all profile data
+  FetchDynamicProfiles();
+
+  # this will hold symbols that we read from the profile files
+  my $symbol_map = {};
+
+  # Read one profile, pick the last item on the list
+  my $data = ReadProfile($main::prog, pop(@main::profile_files));
+  my $profile = $data->{profile};
+  my $pcs = $data->{pcs};
+  my $libs = $data->{libs};   # Info about main program and shared libraries
+  $symbol_map = MergeSymbols($symbol_map, $data->{symbols});
+
+  # Add additional profiles, if available.
+  if (scalar(@main::profile_files) > 0) {
+    foreach my $pname (@main::profile_files) {
+      my $data2 = ReadProfile($main::prog, $pname);
+      $profile = AddProfile($profile, $data2->{profile});
+      $pcs = AddPcs($pcs, $data2->{pcs});
+      $symbol_map = MergeSymbols($symbol_map, $data2->{symbols});
+    }
+  }
+
+  # Subtract base from profile, if specified
+  if ($main::opt_base ne '') {
+    my $base = ReadProfile($main::prog, $main::opt_base);
+    $profile = SubtractProfile($profile, $base->{profile});
+    $pcs = AddPcs($pcs, $base->{pcs});
+    $symbol_map = MergeSymbols($symbol_map, $base->{symbols});
+  }
+
+  # Collect symbols
+  my $symbols;
+  if ($main::use_symbolized_profile) {
+    $symbols = FetchSymbols($pcs, $symbol_map);
+  } elsif ($main::use_symbol_page) {
+    $symbols = FetchSymbols($pcs);
+  } else {
+    # TODO(csilvers): $libs uses the /proc/self/maps data from profile1,
+    # which may differ from the data from subsequent profiles, especially
+    # if they were run on different machines.  Use appropriate libs for
+    # each pc somehow.
+    $symbols = ExtractSymbols($libs, $pcs);
+  }
+
+  if (!defined($main::opt_thread)) {
+    FilterAndPrint($profile, $symbols, $libs);
+  }
+  if (defined($data->{threads})) {
+    foreach my $thread (sort { $a <=> $b } keys(%{$data->{threads}})) {
+      if (!defined($main::opt_thread) || $main::opt_thread == $thread) {
+        my $thread_profile = $data->{threads}{$thread};
+        FilterAndPrint($thread_profile, $symbols, $libs, $thread);
+      }
+    }
+  }
 
   cleanup();
   exit(0);
@@ -1683,23 +1704,23 @@ sub PrintSource {
                         HtmlPrintNumber($c2),
                         UnparseAddress($offset, $e->[0]),
                         CleanDisassembly($e->[3]));
-      
+
       # Append the most specific source line associated with this instruction
       if (length($dis) < 80) { $dis .= (' ' x (80 - length($dis))) };
       $dis = HtmlEscape($dis);
       my $f = $e->[5];
       my $l = $e->[6];
       if ($f ne $last_dis_filename) {
-        $dis .= sprintf("<span class=disasmloc>%s:%d</span>", 
+        $dis .= sprintf("<span class=disasmloc>%s:%d</span>",
                         HtmlEscape(CleanFileName($f)), $l);
       } elsif ($l ne $last_dis_linenum) {
         # De-emphasize the unchanged file name portion
         $dis .= sprintf("<span class=unimportant>%s</span>" .
-                        "<span class=disasmloc>:%d</span>", 
+                        "<span class=disasmloc>:%d</span>",
                         HtmlEscape(CleanFileName($f)), $l);
       } else {
         # De-emphasize the entire location
-        $dis .= sprintf("<span class=unimportant>%s:%d</span>", 
+        $dis .= sprintf("<span class=unimportant>%s:%d</span>",
                         HtmlEscape(CleanFileName($f)), $l);
       }
       $last_dis_filename = $f;
@@ -1788,8 +1809,8 @@ sub PrintSource {
         if (defined($dis) && $dis ne '') {
           $asm = "<span class=\"asm\">" . $dis . "</span>";
         }
-        my $source_class = (($n1 + $n2 > 0) 
-                            ? "livesrc" 
+        my $source_class = (($n1 + $n2 > 0)
+                            ? "livesrc"
                             : (($asm ne "") ? "deadsrc" : "nop"));
         printf $output (
           "<span class=\"line\">%5d</span> " .
@@ -3689,6 +3710,7 @@ sub IsSymbolizedProfileFile {
 #      $result->{version}     Version number of profile file
 #      $result->{period}      Sampling period (in microseconds)
 #      $result->{profile}     Profile object
+#      $result->{threads}     Map of thread IDs to profile objects
 #      $result->{map}         Memory map info from profile
 #      $result->{pcs}         Hash of all PC values seen, key is hex address
 sub ReadProfile {
@@ -3737,6 +3759,9 @@ sub ReadProfile {
   } elsif ($header =~ m/^heap profile:/) {
     $main::profile_type = 'heap';
     $result =  ReadHeapProfile($prog, *PROFILE, $header);
+  } elsif ($header =~ m/^heap/) {
+    $main::profile_type = 'heap';
+    $result = ReadThreadedHeapProfile($prog, $fname, $header);
   } elsif ($header =~ m/^--- *$contention_marker/o) {
     $main::profile_type = 'contention';
     $result = ReadSynchProfile($prog, *PROFILE);
@@ -3879,11 +3904,7 @@ sub ReadCPUProfile {
   return $r;
 }
 
-sub ReadHeapProfile {
-  my $prog = shift;
-  local *PROFILE = shift;
-  my $header = shift;
-
+sub HeapProfileIndex {
   my $index = 1;
   if ($main::opt_inuse_space) {
     $index = 1;
@@ -3894,6 +3915,84 @@ sub ReadHeapProfile {
   } elsif ($main::opt_alloc_objects) {
     $index = 2;
   }
+  return $index;
+}
+
+sub ReadMappedLibraries {
+  my $fh = shift;
+  my $map = "";
+  # Read the /proc/self/maps data
+  while (<$fh>) {
+    s/\r//g;         # turn windows-looking lines into unix-looking lines
+    $map .= $_;
+  }
+  return $map;
+}
+
+sub ReadMemoryMap {
+  my $fh = shift;
+  my $map = "";
+  # Read /proc/self/maps data as formatted by DumpAddressMap()
+  my $buildvar = "";
+  while (<PROFILE>) {
+    s/\r//g;         # turn windows-looking lines into unix-looking lines
+    # Parse "build=<dir>" specification if supplied
+    if (m/^\s*build=(.*)\n/) {
+      $buildvar = $1;
+    }
+
+    # Expand "$build" variable if available
+    $_ =~ s/\$build\b/$buildvar/g;
+
+    $map .= $_;
+  }
+  return $map;
+}
+
+sub AdjustSamples {
+  my ($sample_adjustment, $sampling_algorithm, $n1, $s1, $n2, $s2) = @_;
+  if ($sample_adjustment) {
+    if ($sampling_algorithm == 2) {
+      # Remote-heap version 2
+      # The sampling frequency is the rate of a Poisson process.
+      # This means that the probability of sampling an allocation of
+      # size X with sampling rate Y is 1 - exp(-X/Y)
+      if ($n1 != 0) {
+        my $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
+        my $scale_factor = 1/(1 - exp(-$ratio));
+        $n1 *= $scale_factor;
+        $s1 *= $scale_factor;
+      }
+      if ($n2 != 0) {
+        my $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
+        my $scale_factor = 1/(1 - exp(-$ratio));
+        $n2 *= $scale_factor;
+        $s2 *= $scale_factor;
+      }
+    } else {
+      # Remote-heap version 1
+      my $ratio;
+      $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
+      if ($ratio < 1) {
+        $n1 /= $ratio;
+        $s1 /= $ratio;
+      }
+      $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
+      if ($ratio < 1) {
+        $n2 /= $ratio;
+        $s2 /= $ratio;
+      }
+    }
+  }
+  return ($n1, $s1, $n2, $s2);
+}
+
+sub ReadHeapProfile {
+  my $prog = shift;
+  local *PROFILE = shift;
+  my $header = shift;
+
+  my $index = HeapProfileIndex();
 
   # Find the type of this profile.  The header line looks like:
   #    heap profile:   1246:  8800744 [  1246:  8800744] @ <heap-url>/266053
@@ -3983,29 +4082,12 @@ sub ReadHeapProfile {
   while (<PROFILE>) {
     s/\r//g;         # turn windows-looking lines into unix-looking lines
     if (/^MAPPED_LIBRARIES:/) {
-      # Read the /proc/self/maps data
-      while (<PROFILE>) {
-        s/\r//g;         # turn windows-looking lines into unix-looking lines
-        $map .= $_;
-      }
+      $map .= ReadMappedLibraries(*PROFILE);
       last;
     }
 
     if (/^--- Memory map:/) {
-      # Read /proc/self/maps data as formatted by DumpAddressMap()
-      my $buildvar = "";
-      while (<PROFILE>) {
-        s/\r//g;         # turn windows-looking lines into unix-looking lines
-        # Parse "build=<dir>" specification if supplied
-        if (m/^\s*build=(.*)\n/) {
-          $buildvar = $1;
-        }
-
-        # Expand "$build" variable if available
-        $_ =~ s/\$build\b/$buildvar/g;
-
-        $map .= $_;
-      }
+      $map .= ReadMemoryMap(*PROFILE);
       last;
     }
 
@@ -4016,43 +4098,85 @@ sub ReadHeapProfile {
     if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) {
       my $stack = $5;
       my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
+      my @counts = AdjustSamples($sample_adjustment, $sampling_algorithm,
+                                 $n1, $s1, $n2, $s2);
+      AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
+    }
+  }
 
-      if ($sample_adjustment) {
-        if ($sampling_algorithm == 2) {
-          # Remote-heap version 2
-          # The sampling frequency is the rate of a Poisson process.
-          # This means that the probability of sampling an allocation of
-          # size X with sampling rate Y is 1 - exp(-X/Y)
-          if ($n1 != 0) {
-            my $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
-            my $scale_factor = 1/(1 - exp(-$ratio));
-            $n1 *= $scale_factor;
-            $s1 *= $scale_factor;
-          }
-          if ($n2 != 0) {
-            my $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
-            my $scale_factor = 1/(1 - exp(-$ratio));
-            $n2 *= $scale_factor;
-            $s2 *= $scale_factor;
-          }
-        } else {
-          # Remote-heap version 1
-          my $ratio;
-          $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
-          if ($ratio < 1) {
-            $n1 /= $ratio;
-            $s1 /= $ratio;
-          }
-          $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
-          if ($ratio < 1) {
-            $n2 /= $ratio;
-            $s2 /= $ratio;
-          }
+  my $r = {};
+  $r->{version} = "heap";
+  $r->{period} = 1;
+  $r->{profile} = $profile;
+  $r->{libs} = ParseLibraries($prog, $map, $pcs);
+  $r->{pcs} = $pcs;
+  return $r;
+}
+
+sub ReadThreadedHeapProfile {
+  my ($prog, $fname, $header) = @_;
+
+  my $index = HeapProfileIndex();
+  my $sampling_algorithm = 0;
+  my $sample_adjustment = 0;
+  chomp($header);
+  my $type = "unknown";
+  # Assuming a very specific type of header for now.
+  if ($header =~ m"^heap_v2/(\d+)") {
+    $type = "_v2";
+    $sampling_algorithm = 2;
+    $sample_adjustment = int($1);
+  }
+  if ($type ne "_v2" || !defined($sample_adjustment)) {
+    die "Threaded heap profiles require v2 sampling with a sample rate\n";
+  }
+
+  my $profile = {};
+  my $thread_profiles = {};
+  my $pcs = {};
+  my $map = "";
+  my $stack = "";
+
+  while (<PROFILE>) {
+    s/\r//g;
+    if (/^MAPPED_LIBRARIES:/) {
+      $map .= ReadMappedLibraries(*PROFILE);
+      last;
+    }
+
+    if (/^--- Memory map:/) {
+      $map .= ReadMemoryMap(*PROFILE);
+      last;
+    }
+
+    # Read entry of the form:
+    # @ a1 a2 ... an
+    #   t*: <count1>: <bytes1> [<count2>: <bytes2>]
+    #   t1: <count1>: <bytes1> [<count2>: <bytes2>]
+    #     ...
+    #   tn: <count1>: <bytes1> [<count2>: <bytes2>]
+    s/^\s*//;
+    s/\s*$//;
+    if (m/^@\s+(.*)$/) {
+      $stack = $1;
+    } elsif (m/^\s*(t(\*|\d+)):\s+(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]$/) {
+      if ($stack eq "") {
+        # Still in the header, so this is just a per-thread summary.
+        next;
+      }
+      my $thread = $2;
+      my ($n1, $s1, $n2, $s2) = ($3, $4, $5, $6);
+      my @counts = AdjustSamples($sample_adjustment, $sampling_algorithm,
+                                 $n1, $s2, $n2, $s2);
+      if ($thread eq "*") {
+        AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
+      } else {
+        if (!exists($thread_profiles->{$thread})) {
+          $thread_profiles->{$thread} = {};
         }
+        AddEntries($thread_profiles->{$thread}, $pcs,
+                   FixCallerAddresses($stack), $counts[$index]);
       }
-
-      my @counts = ($n1, $s1, $n2, $s2);
-      AddEntries($profile, $pcs, FixCallerAddresses($stack), $counts[$index]);
     }
   }
 
@@ -4060,6 +4184,7 @@ sub ReadHeapProfile {
   $r->{version} = "heap";
   $r->{period} = 1;
   $r->{profile} = $profile;
+  $r->{threads} = $thread_profiles;
   $r->{libs} = ParseLibraries($prog, $map, $pcs);
   $r->{pcs} = $pcs;
   return $r;
@@ -4756,7 +4881,7 @@ sub MapToSymbols {
 	}
       }
     }
-    
+
     # Prepend to accumulated symbols for pcstr
     # (so that caller comes before callee)
     my $sym = $symbols->{$pcstr};
@@ -4950,7 +5075,7 @@ sub ConfigureTool {
     my $dirname = $`;    # this is everything up to and including the last slash
     if (-x "$dirname$tool") {
       $path = "$dirname$tool";
-    } else { 
+    } else {
       $path = $tool;
     }
   }