Reorganisation of the source tree
[ghc-hetmet.git] / utils / stat2resid / parse-gcstats.prl
diff --git a/utils/stat2resid/parse-gcstats.prl b/utils/stat2resid/parse-gcstats.prl
new file mode 100644 (file)
index 0000000..d882ee6
--- /dev/null
@@ -0,0 +1,232 @@
+#
+# 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);
+    local(*STATS);
+
+    open(STATS, $filename) || die "Cant open $filename \n";
+    @stats = <STATS>;
+
+    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\s+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\s+time/               && do { next arg; };
+    /INIT\s+time/              && do { next arg; };
+    /^\s*([\d,]+) bytes maximum residency/ && 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(STATS);
+    %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;