summaryrefslogtreecommitdiffstats
path: root/tools/rb
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 19:33:14 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 19:33:14 +0000
commit36d22d82aa202bb199967e9512281e9a53db42c9 (patch)
tree105e8c98ddea1c1e4784a60a5a6410fa416be2de /tools/rb
parentInitial commit. (diff)
downloadfirefox-esr-upstream.tar.xz
firefox-esr-upstream.zip
Adding upstream version 115.7.0esr.upstream/115.7.0esrupstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'tools/rb')
-rw-r--r--tools/rb/README6
-rwxr-xr-xtools/rb/filter-log.pl44
-rwxr-xr-xtools/rb/find-comptr-leakers.pl114
-rwxr-xr-xtools/rb/find_leakers.py110
-rwxr-xr-xtools/rb/fix_stacks.py135
-rwxr-xr-xtools/rb/make-tree.pl303
6 files changed, 712 insertions, 0 deletions
diff --git a/tools/rb/README b/tools/rb/README
new file mode 100644
index 0000000000..30418602b1
--- /dev/null
+++ b/tools/rb/README
@@ -0,0 +1,6 @@
+This is the Refcount Balancer. See
+https://firefox-source-docs.mozilla.org/performance/memory/refcount_tracing_and_balancing.html
+for documentation.
+
+Note that the `fix_stacks.py` script is used in several other places in the
+repository.
diff --git a/tools/rb/filter-log.pl b/tools/rb/filter-log.pl
new file mode 100755
index 0000000000..4a1f66741b
--- /dev/null
+++ b/tools/rb/filter-log.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+# Filter a refcount log to show only the entries for a single object.
+# Useful when manually examining refcount logs containing multiple
+# objects.
+
+use 5.004;
+use strict;
+use Getopt::Long;
+
+GetOptions("object=s");
+
+$::opt_object ||
+ die qq{
+usage: filter-log-for.pl < logfile
+ --object <obj> The address of the object to examine (required)
+};
+
+warn "object $::opt_object\n";
+
+LINE: while (<>) {
+ next LINE if (! /^</);
+ my $line = $_;
+ my @fields = split(/ /, $_);
+
+ my $class = shift(@fields);
+ my $obj = shift(@fields);
+ next LINE unless ($obj eq $::opt_object);
+ my $sno = shift(@fields);
+ my $op = shift(@fields);
+ my $cnt = shift(@fields);
+
+ print $line;
+
+ # The lines in the stack trace
+ CALLSITE: while (<>) {
+ print;
+ last CALLSITE if (/^$/);
+ }
+}
diff --git a/tools/rb/find-comptr-leakers.pl b/tools/rb/find-comptr-leakers.pl
new file mode 100755
index 0000000000..925119935c
--- /dev/null
+++ b/tools/rb/find-comptr-leakers.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+# Script loosely based on Chris Waterson's find-leakers.pl and make-tree.pl
+
+use 5.004;
+use strict;
+use Getopt::Long;
+
+# GetOption will create $opt_object, so ignore the
+# warning that gets spit out about those vbls.
+GetOptions("object=s", "list", "help");
+
+# use $::opt_help twice to eliminate warning...
+($::opt_help) && ($::opt_help) && die qq{
+usage: find-comptr-leakers.pl < logfile
+ --object <obj> Examine only object <obj>
+ --list Only list leaked objects
+ --help This message :-)
+};
+
+if ($::opt_object) {
+ warn "Examining only object $::opt_object (THIS IS BROKEN)\n";
+} else {
+ warn "Examining all objects\n";
+}
+
+my %allocs = ( );
+my %counter;
+my $id = 0;
+
+my $accumulating = 0;
+my $savedata = 0;
+my $class;
+my $obj;
+my $sno;
+my $op;
+my $cnt;
+my $ptr;
+my $strace;
+
+sub save_data {
+ # save the data
+ if ($op eq 'nsCOMPtrAddRef') {
+ push @{ $allocs{$sno}->{$ptr} }, [ +1, $strace ];
+ }
+ elsif ($op eq 'nsCOMPtrRelease') {
+ push @{ $allocs{$sno}->{$ptr} }, [ -1, $strace ];
+ my $sum = 0;
+ my @ptrallocs = @{ $allocs{$sno}->{$ptr} };
+ foreach my $alloc (@ptrallocs) {
+ $sum += @$alloc[0];
+ }
+ if ( $sum == 0 ) {
+ delete($allocs{$sno}{$ptr});
+ }
+ }
+}
+
+LINE: while (<>) {
+ if (/^</) {
+ chop; # avoid \n in $ptr
+ my @fields = split(/ /, $_);
+
+ ($class, $obj, $sno, $op, $cnt, $ptr) = @fields;
+
+ $strace = "";
+
+ if ($::opt_list) {
+ save_data();
+ } elsif (!($::opt_object) || ($::opt_object eq $obj)) {
+ $accumulating = 1;
+ }
+ } elsif ( $accumulating == 1 ) {
+ if ( /^$/ ) {
+ # if line is empty
+ $accumulating = 0;
+ save_data();
+ } else {
+ $strace = $strace . $_;
+ }
+ }
+}
+if ( $accumulating == 1) {
+ save_data();
+}
+
+foreach my $serial (keys(%allocs)) {
+ foreach my $comptr (keys( %{$allocs{$serial}} )) {
+ my $sum = 0;
+ my @ptrallocs = @{ $allocs{$serial}->{$comptr} };
+ foreach my $alloc (@ptrallocs) {
+ $sum += @$alloc[0];
+ }
+ print "Object ", $serial, " held by ", $comptr, " is ", $sum, " out of balance.\n";
+ unless ($::opt_list) {
+ print "\n";
+ foreach my $alloc (@ptrallocs) {
+ if (@$alloc[0] == +1) {
+ print "Put into nsCOMPtr at:\n";
+ } elsif (@$alloc[0] == -1) {
+ print "Released from nsCOMPtr at:\n";
+ }
+ print @$alloc[1]; # the stack trace
+ print "\n";
+ }
+ print "\n\n";
+ }
+ }
+}
+
diff --git a/tools/rb/find_leakers.py b/tools/rb/find_leakers.py
new file mode 100755
index 0000000000..9e9a37ac69
--- /dev/null
+++ b/tools/rb/find_leakers.py
@@ -0,0 +1,110 @@
+#!/usr/bin/python
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+# This script processes a `refcount' log, and finds out if any object leaked.
+# It simply goes through the log, finds `AddRef' or `Ctor' lines, and then
+# sees if they `Release' or `Dtor'. If not, it reports them as leaks.
+# Please see README file in the same directory.
+
+import sys
+
+import six
+
+
+def print_output(allocation, obj_to_class):
+ """Formats and prints output."""
+ items = []
+ for (
+ obj,
+ count,
+ ) in six.iteritems(allocation):
+ # Adding items to a list, so we can sort them.
+ items.append((obj, count))
+ # Sorting by count.
+ items.sort(key=lambda item: item[1])
+
+ for (
+ obj,
+ count,
+ ) in items:
+ print(
+ "{obj} ({count}) @ {class_name}".format(
+ obj=obj, count=count, class_name=obj_to_class[obj]
+ )
+ )
+
+
+def process_log(log_lines):
+ """Process through the log lines, and print out the result.
+
+ @param log_lines: List of strings.
+ """
+ allocation = {}
+ class_count = {}
+ obj_to_class = {}
+
+ for log_line in log_lines:
+ if not log_line.startswith("<"):
+ continue
+
+ (class_name, obj, ignore, operation, count,) = log_line.strip("\r\n").split(
+ " "
+ )[:5]
+
+ # for AddRef/Release `count' is the refcount,
+ # for Ctor/Dtor it's the size.
+
+ if (operation == "AddRef" and count == "1") or operation == "Ctor":
+ # Examples:
+ # <nsStringBuffer> 0x01AFD3B8 1 AddRef 1
+ # <PStreamNotifyParent> 0x08880BD0 8 Ctor (20)
+ class_count[class_name] = class_count.setdefault(class_name, 0) + 1
+ allocation[obj] = class_count[class_name]
+ obj_to_class[obj] = class_name
+
+ elif (operation == "Release" and count == "0") or operation == "Dtor":
+ # Examples:
+ # <nsStringBuffer> 0x01AFD3B8 1 Release 0
+ # <PStreamNotifyParent> 0x08880BD0 8 Dtor (20)
+ if obj not in allocation:
+ print(
+ "An object was released that wasn't allocated!",
+ )
+ print(obj, "@", class_name)
+ else:
+ allocation.pop(obj)
+ obj_to_class.pop(obj)
+
+ # Printing out the result.
+ print_output(allocation, obj_to_class)
+
+
+def print_usage():
+ print("")
+ print("Usage: find-leakers.py [log-file]")
+ print("")
+ print("If `log-file' provided, it will read that as the input log.")
+ print("Else, it will read the stdin as the input log.")
+ print("")
+
+
+def main():
+ """Main method of the script."""
+ if len(sys.argv) == 1:
+ # Reading log from stdin.
+ process_log(sys.stdin.readlines())
+ elif len(sys.argv) == 2:
+ # Reading log from file.
+ with open(sys.argv[1], "r") as log_file:
+ log_lines = log_file.readlines()
+ process_log(log_lines)
+ else:
+ print("ERROR: Invalid number of arguments")
+ print_usage()
+
+
+if __name__ == "__main__":
+ main()
diff --git a/tools/rb/fix_stacks.py b/tools/rb/fix_stacks.py
new file mode 100755
index 0000000000..f30aa9944a
--- /dev/null
+++ b/tools/rb/fix_stacks.py
@@ -0,0 +1,135 @@
+#!/usr/bin/env python3
+# vim:sw=4:ts=4:et:
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+# This script uses `fix-stacks` to post-process the entries produced by
+# MozFormatCodeAddress().
+
+import atexit
+import os
+import platform
+import re
+import sys
+from subprocess import PIPE, Popen
+
+# Matches lines produced by MozFormatCodeAddress(), e.g.
+# `#01: ???[tests/example +0x43a0]`.
+line_re = re.compile("#\d+: .+\[.+ \+0x[0-9A-Fa-f]+\]")
+
+fix_stacks = None
+
+
+def autobootstrap():
+ import buildconfig
+ from mozbuild.configure import ConfigureSandbox
+
+ sandbox = ConfigureSandbox(
+ {},
+ argv=[
+ "configure",
+ "--help",
+ "--host={}".format(buildconfig.substs["HOST_ALIAS"]),
+ ],
+ )
+ moz_configure = os.path.join(buildconfig.topsrcdir, "build", "moz.configure")
+ sandbox.include_file(os.path.join(moz_configure, "init.configure"))
+ # bootstrap_search_path_order has a dependency on developer_options, which
+ # is not defined in init.configure. Its value doesn't matter for us, though.
+ sandbox["developer_options"] = sandbox["always"]
+ sandbox.include_file(os.path.join(moz_configure, "bootstrap.configure"))
+ # Expand the `bootstrap_path` template for "fix-stacks", and execute the
+ # expanded function via `_value_for`, which will trigger autobootstrap.
+ sandbox._value_for(sandbox["bootstrap_path"]("fix-stacks"))
+
+
+def initFixStacks(jsonMode, slowWarning, breakpadSymsDir, hide_errors):
+ # Look in MOZ_FETCHES_DIR (for automation), then in MOZBUILD_STATE_PATH
+ # (for a local build where the user has that set), then in ~/.mozbuild
+ # (for a local build with default settings).
+ base = os.environ.get(
+ "MOZ_FETCHES_DIR",
+ os.environ.get("MOZBUILD_STATE_PATH", os.path.expanduser("~/.mozbuild")),
+ )
+ fix_stacks_exe = base + "/fix-stacks/fix-stacks"
+ if platform.system() == "Windows":
+ fix_stacks_exe = fix_stacks_exe + ".exe"
+
+ if not (os.path.isfile(fix_stacks_exe) and os.access(fix_stacks_exe, os.X_OK)):
+ try:
+ autobootstrap()
+ except ImportError:
+ # We're out-of-tree (e.g. tests tasks on CI) and can't autobootstrap
+ # (we shouldn't anyways).
+ pass
+
+ if not (os.path.isfile(fix_stacks_exe) and os.access(fix_stacks_exe, os.X_OK)):
+ raise Exception("cannot find `fix-stacks`; please run `./mach bootstrap`")
+
+ args = [fix_stacks_exe]
+ if jsonMode:
+ args.append("-j")
+ if breakpadSymsDir:
+ args.append("-b")
+ args.append(breakpadSymsDir)
+
+ # Sometimes we need to prevent errors from going to stderr.
+ stderr = open(os.devnull) if hide_errors else None
+
+ global fix_stacks
+ fix_stacks = Popen(
+ args, stdin=PIPE, stdout=PIPE, stderr=stderr, universal_newlines=True
+ )
+
+ # Shut down the fix_stacks process on exit. We use `terminate()`
+ # because it is more forceful than `wait()`, and the Python docs warn
+ # about possible deadlocks with `wait()`.
+ def cleanup(fix_stacks):
+ for fn in [fix_stacks.stdin.close, fix_stacks.terminate]:
+ try:
+ fn()
+ except OSError:
+ pass
+
+ atexit.register(cleanup, fix_stacks)
+
+ if slowWarning:
+ print(
+ "Initializing stack-fixing for the first stack frame, this may take a while..."
+ )
+
+
+def fixSymbols(
+ line, jsonMode=False, slowWarning=False, breakpadSymsDir=None, hide_errors=False
+):
+ is_bytes = isinstance(line, bytes)
+ line_str = line.decode("utf-8") if is_bytes else line
+ if line_re.search(line_str) is None:
+ return line
+
+ if not fix_stacks:
+ initFixStacks(jsonMode, slowWarning, breakpadSymsDir, hide_errors)
+
+ # Sometimes `line` is lacking a trailing newline. If we pass such a `line`
+ # to `fix-stacks` it will wait until it receives a newline, causing this
+ # script to hang. So we add a newline if one is missing and then remove it
+ # from the output.
+ is_missing_newline = not line_str.endswith("\n")
+ if is_missing_newline:
+ line_str = line_str + "\n"
+ fix_stacks.stdin.write(line_str)
+ fix_stacks.stdin.flush()
+ out = fix_stacks.stdout.readline()
+ if is_missing_newline:
+ out = out[:-1]
+
+ if is_bytes and not isinstance(out, bytes):
+ out = out.encode("utf-8")
+ return out
+
+
+if __name__ == "__main__":
+ bpsyms = os.environ.get("BREAKPAD_SYMBOLS_PATH", None)
+ for line in sys.stdin:
+ sys.stdout.write(fixSymbols(line, breakpadSymsDir=bpsyms))
diff --git a/tools/rb/make-tree.pl b/tools/rb/make-tree.pl
new file mode 100755
index 0000000000..04f0d85341
--- /dev/null
+++ b/tools/rb/make-tree.pl
@@ -0,0 +1,303 @@
+#!/usr/bin/perl -w
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+use 5.004;
+use strict;
+use Getopt::Long;
+
+$::opt_prune_depth = 0;
+$::opt_subtree_size = 0;
+$::opt_reverse = 0;
+
+# GetOption will create $opt_object & $opt_exclude, so ignore the
+# warning that gets spit out about those vbls.
+GetOptions("object=s", "exclude=s", "comptrs=s", "ignore-balanced", "subtree-size=i", "prune-depth=i",
+ "collapse-to-method", "collapse-to-class", "old-style", "reverse");
+
+$::opt_object ||
+ die qq{
+usage: leak.pl < logfile
+ --object <obj> The address of the object to examine (required)
+ --exclude <file> Exclude routines listed in <file>
+ --comptrs <file> Subtract all the data in the balanced COMPtr log <file>
+ --ignore-balanced Ignore balanced subtrees
+ --subtree-size <n> Print subtrees with more than <n> nodes separately
+ --prune-depth <depth> Prune the tree to <depth>
+ --collapse-to-method Aggregate data by method
+ --collapse-to-class Aggregate data by class (subsumes --collapse-to-method)
+ --reverse Reverse call stacks, showing leaves first
+ --old-style Old-style formatting
+};
+
+$::opt_prune_depth = 0 if $::opt_prune_depth < 0;
+$::opt_subtree_size = 0 if $::opt_subtree_size < 0;
+
+warn "object $::opt_object\n";
+warn "ignoring balanced subtrees\n" if $::opt_ignore_balanced;
+warn "prune depth $::opt_prune_depth\n" if $::opt_prune_depth;
+warn "collapsing to class\n" if $::opt_collapse_to_class;
+warn "collapsing to method\n" if $::opt_collapse_to_method && !$::opt_collapse_to_class;
+warn "reversing call stacks\n" if $::opt_reverse;
+
+
+# The 'excludes' are functions that, if detected in a particular call
+# stack, will cause the _entire_ call stack to be ignored. You might,
+# for example, explicitly exclude two functions that have a matching
+# AddRef/Release pair.
+
+my %excludes;
+
+if ($::opt_exclude) {
+ open(EXCLUDE, "<".$::opt_exclude)
+ || die "unable to open $::opt_exclude";
+
+ while (<EXCLUDE>) {
+ chomp $_;
+ warn "excluding $_\n";
+ $excludes{$_} = 1;
+ }
+}
+
+# Each entry in the tree rooted by callGraphRoot contains the following:
+# #name# This call's name+offset string
+# #refcount# The net reference count of this call
+# #label# The label used for this subtree; only defined for labeled nodes
+# #children# List of children in alphabetical order
+# zero or more children indexed by method name+offset strings.
+
+my $callGraphRoot;
+$callGraphRoot = { '#name#' => '.root', '#refcount#' => 'n/a' };
+
+# The 'imbalance' is a gross count of how balanced a particular
+# callsite is. It is used to prune away callsites that are detected to
+# be balanced; that is, that have matching AddRef/Release() pairs.
+
+my %imbalance;
+$imbalance{'.root'} = 'n/a';
+
+# The main read loop.
+
+sub read_data($$$) {
+ my ($INFILE, $plus, $minus) = @_;
+
+ LINE: while (<$INFILE>) {
+ next LINE if (! /^</);
+ my @fields = split(/ /, $_);
+
+ my $class = shift(@fields);
+ my $obj = shift(@fields);
+ my $sno = shift(@fields);
+ next LINE unless ($obj eq $::opt_object);
+
+ my $op = shift(@fields);
+ next LINE unless ($op eq $plus || $op eq $minus);
+
+ my $cnt = shift(@fields);
+
+ # Collect the remaining lines to create a stack trace. We need to
+ # filter out the frame numbers so that frames that differ only in
+ # their frame number are considered equivalent. However, we need to
+ # keep a frame number on each line so that the fix*.py scripts can
+ # parse the output. So we set the frame number to 0 for every frame.
+ my @stack;
+ CALLSITE: while (<$INFILE>) {
+ chomp;
+ last CALLSITE if (/^$/);
+ $_ =~ s/#\d+: /#00: /; # replace frame number with 0
+ $stack[++$#stack] = $_;
+ }
+
+ # Reverse the remaining fields to produce the call stack, with the
+ # oldest frame at the front of the array.
+ if (! $::opt_reverse) {
+ @stack = reverse(@stack);
+ }
+
+ my $call;
+
+ # If any of the functions in the stack are supposed to be excluded,
+ # march on to the next line.
+ foreach $call (@stack) {
+ next LINE if exists($excludes{$call});
+ }
+
+
+ # Add the callstack as a path through the call graph, updating
+ # refcounts at each node.
+
+ my $caller = $callGraphRoot;
+
+ foreach $call (@stack) {
+
+ # Chop the method offset if we're 'collapsing to method' or
+ # 'collapsing to class'.
+ $call =~ s/\+0x.*$//g if ($::opt_collapse_to_method || $::opt_collapse_to_class);
+
+ # Chop the method name if we're 'collapsing to class'.
+ $call =~ s/::.*$//g if ($::opt_collapse_to_class);
+
+ my $site = $caller->{$call};
+ if (!$site) {
+ # This is the first time we've seen this callsite. Add a
+ # new entry to the call tree.
+
+ $site = { '#name#' => $call, '#refcount#' => 0 };
+ $caller->{$call} = $site;
+ }
+
+ if ($op eq $plus) {
+ ++($site->{'#refcount#'});
+ ++($imbalance{$call});
+ } elsif ($op eq $minus) {
+ --($site->{'#refcount#'});
+ --($imbalance{$call});
+ } else {
+ die "Bad operation $op";
+ }
+
+ $caller = $site;
+ }
+ }
+}
+
+read_data(*STDIN, "AddRef", "Release");
+
+if ($::opt_comptrs) {
+ warn "Subtracting comptr log ". $::opt_comptrs . "\n";
+ open(COMPTRS, "<".$::opt_comptrs)
+ || die "unable to open $::opt_comptrs";
+
+ # read backwards to subtract
+ read_data(*COMPTRS, "nsCOMPtrRelease", "nsCOMPtrAddRef");
+}
+
+sub num_alpha {
+ my ($aN, $aS, $bN, $bS);
+ ($aN, $aS) = ($1, $2) if $a =~ /^(\d+) (.+)$/;
+ ($bN, $bS) = ($1, $2) if $b =~ /^(\d+) (.+)$/;
+ return $a cmp $b unless defined $aN && defined $bN;
+ return $aN <=> $bN unless $aN == $bN;
+ return $aS cmp $bS;
+}
+
+# Given a subtree and its nesting level, return true if that subtree should be pruned.
+# If it shouldn't be pruned, destructively attempt to prune its children.
+# Also compute the #children# properties of unpruned nodes.
+sub prune($$) {
+ my ($site, $nest) = @_;
+
+ # If they want us to prune the tree's depth, do so here.
+ return 1 if ($::opt_prune_depth && $nest >= $::opt_prune_depth);
+
+ # If the subtree is balanced, ignore it.
+ return 1 if ($::opt_ignore_balanced && !$site->{'#refcount#'});
+
+ my $name = $site->{'#name#'};
+
+ # If the symbol isn't imbalanced, then prune here (and warn)
+ if ($::opt_ignore_balanced && !$imbalance{$name}) {
+ warn "discarding " . $name . "\n";
+# return 1;
+ }
+
+ my @children;
+ foreach my $child (sort num_alpha keys(%$site)) {
+ if (substr($child, 0, 1) ne '#') {
+ if (prune($site->{$child}, $nest + 1)) {
+ delete $site->{$child};
+ } else {
+ push @children, $site->{$child};
+ }
+ }
+ }
+ $site->{'#children#'} = \@children;
+ return 0;
+}
+
+
+# Compute the #label# properties of this subtree.
+# Return the subtree's number of nodes, not counting nodes reachable
+# through a labeled node.
+sub createLabels($) {
+ my ($site) = @_;
+ my @children = @{$site->{'#children#'}};
+ my $nChildren = @children;
+ my $nDescendants = 0;
+
+ foreach my $child (@children) {
+ my $childDescendants = createLabels($child);
+ if ($nChildren > 1 && $childDescendants > $::opt_subtree_size) {
+ die "Internal error" if defined($child->{'#label#'});
+ $child->{'#label#'} = "__label__";
+ $childDescendants = 1;
+ }
+ $nDescendants += $childDescendants;
+ }
+ return $nDescendants + 1;
+}
+
+
+my $nextLabel = 0;
+my @labeledSubtrees;
+
+sub list($$$$$) {
+ my ($site, $nest, $nestStr, $childrenLeft, $root) = @_;
+ my $label = !$root && $site->{'#label#'};
+
+ # Assign a unique number to the label.
+ if ($label) {
+ die unless $label eq "__label__";
+ $label = "__" . ++$nextLabel . "__";
+ $site->{'#label#'} = $label;
+ push @labeledSubtrees, $site;
+ }
+
+ print $nestStr;
+ if ($::opt_old_style) {
+ print $label, " " if $label;
+ print $site->{'#name#'}, ": bal=", $site->{'#refcount#'}, "\n";
+ } else {
+ my $refcount = $site->{'#refcount#'};
+ my $l = 8 - length $refcount;
+ $l = 1 if $l < 1;
+ print $refcount, " " x $l;
+ print $label, " " if $label;
+ print $site->{'#name#'}, "\n";
+ }
+
+ $nestStr .= $childrenLeft && !$::opt_old_style ? "| " : " ";
+ if (!$label) {
+ my @children = @{$site->{'#children#'}};
+ $childrenLeft = @children;
+ foreach my $child (@children) {
+ $childrenLeft--;
+ list($child, $nest + 1, $nestStr, $childrenLeft);
+ }
+ }
+}
+
+
+if (!prune($callGraphRoot, 0)) {
+ createLabels $callGraphRoot if ($::opt_subtree_size);
+ list $callGraphRoot, 0, "", 0, 1;
+ while (@labeledSubtrees) {
+ my $labeledSubtree = shift @labeledSubtrees;
+ print "\n------------------------------\n",
+$labeledSubtree->{'#label#'}, "\n";
+ list $labeledSubtree, 0, "", 0, 1;
+ }
+ print "\n------------------------------\n" if @labeledSubtrees;
+}
+
+print qq{
+Imbalance
+---------
+};
+
+foreach my $call (sort num_alpha keys(%imbalance)) {
+ print $call . " " . $imbalance{$call} . "\n";
+}
+