summaryrefslogtreecommitdiff
path: root/ghc/utils/stat2resid/parse-gcstats.prl
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/utils/stat2resid/parse-gcstats.prl')
-rw-r--r--ghc/utils/stat2resid/parse-gcstats.prl230
1 files changed, 230 insertions, 0 deletions
diff --git a/ghc/utils/stat2resid/parse-gcstats.prl b/ghc/utils/stat2resid/parse-gcstats.prl
new file mode 100644
index 0000000000..b6e80fd9e6
--- /dev/null
+++ b/ghc/utils/stat2resid/parse-gcstats.prl
@@ -0,0 +1,230 @@
+#!/local/sun4/bin/perl
+#
+# Subroutines to parses a ghc Garbage Collection stats file
+#
+#%gcstats = &parse_stats($ARGV[0]);
+#&print_stats(">-", %gcstats);
+#exit 0;
+
+sub to_num {
+ local ($text) = @_;
+ return($1 * 1000000000 + $2 * 1000000 + $3 * 1000 + $4)
+ if ( $text =~ /^(\d*),(\d*),(\d*),(\d*)$/ );
+ return($1 * 1000000 + $2 * 1000 + $3)
+ if ( $text =~ /^(\d*),(\d*),(\d*)$/ );
+ return($1 * 1000 + $2)
+ if ( $text =~ /^(\d*),(\d*)$/ );
+ return($1)
+ if ( $text =~ /^(\d*)$/ );
+ die "Error converting $text\n";
+}
+
+sub from_num {
+ local ($num) = @_;
+ local ($b, $m, $t, $o) = (int($num/1000000000), int($num/1000000)%1000,
+ int($num/1000)%1000, $num%1000);
+ return(sprintf("%d,%03d,%03d,%03d", $b, $m, $t, $o)) if $b > 0;
+ return(sprintf("%d,%03d,%03d", $m, $t, $o)) if $m > 0;
+ return(sprintf("%d,%03d", $t, $o)) if $t > 0;
+ return(sprintf("%d", $o)) if $o > 0;
+}
+
+sub parse_stats {
+ local($filename) = @_;
+ local($tot_alloc, $tot_gc_user, $tot_mut_user, $tot_user,
+ $tot_gc_elap, $tot_mut_elap, $tot_elap);
+ local($statsfile, $line, $row, $col, $val);
+ local(@stats, @hdr1, @hdr2, @line_vals);
+ local(%the_stats);
+
+ open($statsfile, $filename) || die "Cant open $filename \n";
+ @stats = <$statsfile>;
+
+ do {$line = shift(@stats);} until ($line !~ /^$/);
+ chop($line);
+ ($the_stats{"command"}, $the_stats{"args"}) = split(' ', $line, 2);
+
+ do {$line = shift(@stats);} until ($line !~ /^$/);
+ $line =~ /Collector:\s*([A-Z]+)\s*HeapSize:\s*([\d,]+)/;
+ $the_stats{"collector"} = $1;
+ $the_stats{"heapsize"} = &to_num($2);
+
+ do {$line = shift(@stats);} until ($line !~ /^$/);
+ chop($line);
+ @hdr1 = split(' ', $line);
+ $line = shift(@stats);
+ chop($line);
+ @hdr2 = split(' ', $line);
+
+ $row = 0;
+ $tot_alloc = 0;
+ $tot_gc_user = 0;
+ $tot_gc_elap = 0;
+ $tot_mut_user = 0;
+ $tot_mut_elap = 0;
+ $tot_user = 0;
+ $tot_elap = 0;
+
+ while (($line = shift(@stats)) !~ /^\s*\d+\s*$/) {
+ chop($line);
+ @line_vals = split(' ', $line);
+
+ $col = -1;
+ word:
+ while(++$col <= $#line_vals) {
+
+ $val = $line_vals[$col];
+ $_ = @hdr1[$col] . @hdr2[$col];
+
+ /^Allocbytes$/ && do { $tot_alloc += $val;
+ $the_stats{"alloc_$row"} = $val;
+ next word; };
+
+ /^Collectbytes$/ && do { $the_stats{"collect_$row"} = $val;
+ next word; };
+
+ /^Livebytes$/ && do { $the_stats{"live_$row"} = $val;
+ next word; };
+
+ /^Residency$/ && do { next word; };
+
+ /^GCuser$/ && do { $tot_gc_user += $val;
+ $the_stats{"gc_user_$row"} = $val;
+ next word; };
+
+ /^GCelap$/ && do { $tot_gc_elap += $val;
+ $the_stats{"gc_elap_$row"} = $val;
+ next word; };
+
+ /^TOTuser$/ && do { $the_stats{"mut_user_$row"} =
+ $val - $tot_user - $the_stats{"gc_user_$row"};
+ $tot_mut_user += $the_stats{"mut_user_$row"};
+ $tot_user = $val;
+ next word; };
+
+ /^TOTelap$/ && do { $the_stats{"mut_elap_$row"} =
+ $val - $tot_elap - $the_stats{"gc_elap_$row"};
+ $tot_mut_elap += $the_stats{"mut_elap_$row"};
+ $tot_elap = $val;
+ next word; };
+
+ /^PageGC$/ && do { $the_stats{"gc_pflts_$row"} = $val;
+ next word; };
+
+ /^FltsMUT$/ && do { $the_stats{"mut_pflts_$row"} = $val;
+ next word; };
+
+ /^Collection/ && do { $the_stats{"mode_$row"} = $val;
+ next word; };
+
+ /^Astkbytes$/ && do {next word; };
+ /^Bstkbytes$/ && do {next word; };
+ /^CafNo$/ && do {next word; };
+ /^Cafbytes$/ && do {next word; };
+
+ /^NoAstk$/ && do {next word; };
+ /^ofBstk$/ && do {next word; };
+ /^RootsReg$/ && do {next word; };
+ /^OldGen$/ && do {next word; };
+ /^RootsCaf$/ && do {next word; };
+ /^Sizebytes$/ && do {next word; };
+ /^Resid\%heap$/ && do {next word; };
+
+ /^$/ && do {next word; };
+
+ print STDERR "Unknown: $_ = $val\n";
+ };
+
+ $row++;
+ };
+ $tot_alloc += $line;
+ $the_stats{"alloc_$row"} = $line;
+
+arg: while($_ = $stats[0]) {
+ shift(@stats);
+
+ /^\s*([\d,]+) bytes alloc/ && do { local($a) = &to_num($1);
+ $a == $tot_alloc || die "Total $a != $tot_alloc \n";
+ $the_stats{"alloc_total"} = $tot_alloc;
+ next arg; };
+
+ /^\s*([\d]+) garbage/ && do { $1 == $row || die "GCNo $1 != $row \n";
+ $the_stats{"gc_no"} = $row;
+ next arg; };
+
+ /Total time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
+ $the_stats{"user_total"} = $1;
+ $the_stats{"elap_total"} = $2;
+ $the_stats{"mut_user_total"} = $1 - $tot_gc_user;
+ $the_stats{"mut_elap_total"} = $2 - $tot_gc_elap;
+ $the_stats{"mut_user_$row"} = $1 - $tot_gc_user - $tot_mut_user;
+ $the_stats{"mut_elap_$row"} = $2 - $tot_gc_elap - $tot_mut_elap;
+ next arg; };
+
+ /GC time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
+ # $1 == $tot_gc_user || die "GCuser $1 != $tot_gc_user \n";
+ # $2 == $tot_gc_elap || die "GCelap $2 != $tot_gc_elap \n";
+ $the_stats{"gc_user_total"} = $tot_gc_user;
+ $the_stats{"gc_elap_total"} = $tot_gc_elap;
+ next arg; };
+
+ /MUT time/ && do { next arg; };
+
+ /\%GC time/ && do { next arg; };
+ /Alloc rate/ && do { next arg; };
+ /Productivity/ && do { next arg; };
+ /^$/ && do { next arg; };
+ /^\#/ && do { next arg; }; # Allows comments to follow
+
+ print STDERR "Unmatched line: $_";
+ }
+
+ close($statsfile);
+ %the_stats;
+}
+
+sub print_stats {
+ local ($filename, %out_stats) = @_;
+ local($statsfile, $row);
+
+ open($statsfile, $filename) || die "Cant open $filename \n";
+ select($statsfile);
+
+ print $out_stats{"command"}, " ", $out_stats{"args"}, "\n\n";
+ print "Collector: ", $out_stats{"collector"}, " HeapSize: ", &from_num($out_stats{"heapsize"}), " (bytes)\n\n";
+
+ $row = 0;
+ while ($row < $out_stats{"gc_no"}) {
+ printf "%7d %7d %7d %5.2f %5.2f %5.2f %5.2f %4d %4d %s\n",
+ $out_stats{"alloc_$row"},
+ $out_stats{"collect_$row"},
+ $out_stats{"live_$row"},
+ $out_stats{"gc_user_$row"},
+ $out_stats{"gc_elap_$row"},
+ $out_stats{"mut_user_$row"},
+ $out_stats{"mut_elap_$row"},
+ $out_stats{"gc_pflts_$row"},
+ $out_stats{"mut_pflts_$row"},
+ $out_stats{"mode_$row"};
+ $row++;
+ };
+ printf "%7d %s %5.2f %5.2f \n\n",
+ $out_stats{"alloc_$row"}, " " x 27,
+ $out_stats{"mut_user_$row"},
+ $out_stats{"mut_elap_$row"};
+
+ printf "Total Alloc: %s\n", &from_num($out_stats{"alloc_total"});
+ printf " GC No: %d\n\n", $out_stats{"gc_no"};
+
+ printf " MUT User: %6.2fs\n", $out_stats{"mut_user_total"};
+ printf " GC User: %6.2fs\n", $out_stats{"gc_user_total"};
+ printf "Total User: %6.2fs\n\n", $out_stats{"user_total"};
+
+ printf " MUT Elap: %6.2fs\n", $out_stats{"mut_elap_total"};
+ printf " GC Elap: %6.2fs\n", $out_stats{"gc_elap_total"};
+ printf "Total Elap: %6.2fs\n", $out_stats{"elap_total"};
+
+ close($statsfile);
+}
+
+1;