build ghctags-inplace
[ghc-hetmet.git] / utils / stat2resid / parse-gcstats.prl
1 #
2 # Subroutines to parses a ghc Garbage Collection stats file
3 #
4 #%gcstats = &parse_stats($ARGV[0]);
5 #&print_stats(">-", %gcstats);
6 #exit 0;
7
8 sub to_num {
9     local ($text) = @_;
10     return($1 * 1000000000 + $2 * 1000000 + $3 * 1000 + $4)
11         if ( $text =~ /^(\d*),(\d*),(\d*),(\d*)$/ );
12     return($1 * 1000000 + $2 * 1000 + $3)
13         if ( $text =~ /^(\d*),(\d*),(\d*)$/ );
14     return($1 * 1000 + $2)
15         if ( $text =~ /^(\d*),(\d*)$/ );
16     return($1)
17         if ( $text =~ /^(\d*)$/ );
18     die "Error converting $text\n";
19 }
20
21 sub from_num {
22     local ($num) = @_;
23     local ($b, $m, $t, $o) = (int($num/1000000000), int($num/1000000)%1000,
24                               int($num/1000)%1000, $num%1000);
25     return(sprintf("%d,%03d,%03d,%03d", $b, $m, $t, $o)) if $b > 0;
26     return(sprintf("%d,%03d,%03d", $m, $t, $o))          if $m > 0;
27     return(sprintf("%d,%03d", $t, $o))                   if $t > 0;
28     return(sprintf("%d", $o))                            if $o > 0;
29 }
30
31 sub parse_stats {
32     local($filename) = @_;
33     local($tot_alloc, $tot_gc_user, $tot_mut_user, $tot_user,
34                       $tot_gc_elap, $tot_mut_elap, $tot_elap);
35     local($statsfile, $line, $row, $col, $val);
36     local(@stats, @hdr1, @hdr2, @line_vals);
37     local(%the_stats);
38     local(*STATS);
39
40     open(STATS, $filename) || die "Cant open $filename \n";
41     @stats = <STATS>;
42
43     do {$line = shift(@stats);} until ($line !~ /^$/);
44     chop($line);
45     ($the_stats{"command"}, $the_stats{"args"}) = split(' ', $line, 2);
46
47     do {$line = shift(@stats);} until ($line !~ /^$/);
48     $line =~ /Collector:\s*([A-Z]+)\s*HeapSize:\s*([\d,]+)/;
49     $the_stats{"collector"} = $1;
50     $the_stats{"heapsize"}  = &to_num($2);
51
52     do {$line = shift(@stats);} until ($line !~ /^$/);
53     chop($line);
54     @hdr1 = split(' ', $line);
55     $line = shift(@stats);
56     chop($line);
57     @hdr2 = split(' ', $line);
58
59     $row = 0;
60     $tot_alloc = 0;
61     $tot_gc_user = 0; 
62     $tot_gc_elap = 0; 
63     $tot_mut_user = 0; 
64     $tot_mut_elap = 0; 
65     $tot_user = 0;
66     $tot_elap = 0;
67
68     while (($line = shift(@stats)) !~ /^\s*\d+\s*$/) {
69         chop($line);
70         @line_vals = split(' ', $line);
71
72         $col = -1;
73         word:
74             while(++$col <= $#line_vals) {
75         
76             $val = $line_vals[$col];
77             $_ = @hdr1[$col] . @hdr2[$col];
78
79             /^Allocbytes$/      && do { $tot_alloc += $val;
80                                         $the_stats{"alloc_$row"} = $val;
81                                         next word; };
82
83             /^Collectbytes$/    && do { $the_stats{"collect_$row"} = $val;
84                                         next word; };
85
86             /^Livebytes$/       && do { $the_stats{"live_$row"} = $val;
87                                         next word; };
88
89             /^Residency$/       && do { next word; };
90
91             /^GCuser$/          && do { $tot_gc_user += $val;
92                                         $the_stats{"gc_user_$row"} = $val;
93                                         next word; };
94
95             /^GCelap$/          && do { $tot_gc_elap += $val;
96                                         $the_stats{"gc_elap_$row"} = $val;
97                                         next word; };
98
99             /^TOTuser$/         && do { $the_stats{"mut_user_$row"} =
100                                                 $val - $tot_user - $the_stats{"gc_user_$row"};
101                                         $tot_mut_user += $the_stats{"mut_user_$row"};
102                                         $tot_user = $val;
103                                         next word; };
104
105             /^TOTelap$/         && do { $the_stats{"mut_elap_$row"} =
106                                                 $val - $tot_elap - $the_stats{"gc_elap_$row"};
107                                         $tot_mut_elap += $the_stats{"mut_elap_$row"};
108                                         $tot_elap = $val;
109                                         next word; };
110
111             /^PageGC$/          && do { $the_stats{"gc_pflts_$row"} = $val;
112                                         next word; };
113
114             /^FltsMUT$/         && do { $the_stats{"mut_pflts_$row"} = $val;
115                                         next word; };
116
117             /^Collection/       && do { $the_stats{"mode_$row"} = $val;
118                                         next word; };
119
120             /^Astkbytes$/       && do {next word; };
121             /^Bstkbytes$/       && do {next word; };
122             /^CafNo$/           && do {next word; };
123             /^Cafbytes$/        && do {next word; };
124
125             /^NoAstk$/          && do {next word; };
126             /^ofBstk$/          && do {next word; };
127             /^RootsReg$/        && do {next word; };
128             /^OldGen$/          && do {next word; };
129             /^RootsCaf$/        && do {next word; };
130             /^Sizebytes$/       && do {next word; };
131             /^Resid\%heap$/     && do {next word; };
132
133             /^$/                && do {next word; };
134
135             print STDERR "Unknown: $_ = $val\n";
136         };
137
138         $row++;
139     };
140     $tot_alloc += $line;
141     $the_stats{"alloc_$row"} = $line;
142
143 arg: while($_ = $stats[0]) {
144     shift(@stats);
145
146     /^\s*([\d,]+) bytes alloc/  && do { local($a) = &to_num($1);
147                                         $a == $tot_alloc || die "Total $a != $tot_alloc \n";
148                                         $the_stats{"alloc_total"} = $tot_alloc;
149                                         next arg; };
150
151     /^\s*([\d]+) garbage/       && do { $1 == $row || die "GCNo $1 != $row \n";
152                                         $the_stats{"gc_no"} = $row;
153                                         next arg; };
154
155     /Total time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
156                                         $the_stats{"user_total"} = $1;
157                                         $the_stats{"elap_total"} = $2;
158                                         $the_stats{"mut_user_total"} = $1 - $tot_gc_user;
159                                         $the_stats{"mut_elap_total"} = $2 - $tot_gc_elap;
160                                         $the_stats{"mut_user_$row"} = $1 - $tot_gc_user - $tot_mut_user;
161                                         $the_stats{"mut_elap_$row"} = $2 - $tot_gc_elap - $tot_mut_elap;
162                                         next arg; };
163
164     /GC\s+time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
165                                         # $1 == $tot_gc_user || die "GCuser $1 != $tot_gc_user \n";
166                                         # $2 == $tot_gc_elap || die "GCelap $2 != $tot_gc_elap \n";
167                                         $the_stats{"gc_user_total"} = $tot_gc_user;
168                                         $the_stats{"gc_elap_total"} = $tot_gc_elap;
169                                         next arg; };
170     
171     /MUT\s+time/                && do { next arg; };
172     /INIT\s+time/               && do { next arg; };
173     /^\s*([\d,]+) bytes maximum residency/ && do { next arg; };
174
175     /\%GC time/                 && do { next arg; };
176     /Alloc rate/                && do { next arg; };
177     /Productivity/              && do { next arg; };
178     /^$/                        && do { next arg; };
179     /^\#/                       && do { next arg; };  # Allows comments to follow
180     
181     print STDERR "Unmatched line: $_";
182     }
183
184     close(STATS);
185     %the_stats;
186 }
187
188 sub print_stats {
189     local ($filename, %out_stats) = @_;
190     local($statsfile, $row);
191
192     open($statsfile, $filename) || die "Cant open $filename \n";
193     select($statsfile);
194
195     print $out_stats{"command"}, " ", $out_stats{"args"}, "\n\n";
196     print "Collector: ", $out_stats{"collector"}, "  HeapSize: ", &from_num($out_stats{"heapsize"}), " (bytes)\n\n";
197
198     $row = 0;
199     while ($row < $out_stats{"gc_no"}) {
200         printf  "%7d %7d %7d %5.2f %5.2f %5.2f %5.2f %4d %4d  %s\n",
201                 $out_stats{"alloc_$row"},
202                 $out_stats{"collect_$row"},
203                 $out_stats{"live_$row"},
204                 $out_stats{"gc_user_$row"},
205                 $out_stats{"gc_elap_$row"},
206                 $out_stats{"mut_user_$row"},
207                 $out_stats{"mut_elap_$row"},
208                 $out_stats{"gc_pflts_$row"},
209                 $out_stats{"mut_pflts_$row"},
210                 $out_stats{"mode_$row"};
211         $row++;
212     };
213     printf "%7d %s %5.2f %5.2f \n\n",
214            $out_stats{"alloc_$row"}, " " x 27,
215            $out_stats{"mut_user_$row"},
216            $out_stats{"mut_elap_$row"};
217
218     printf "Total Alloc: %s\n", &from_num($out_stats{"alloc_total"});
219     printf "      GC No: %d\n\n", $out_stats{"gc_no"};
220
221     printf "  MUT User: %6.2fs\n", $out_stats{"mut_user_total"};
222     printf "   GC User: %6.2fs\n", $out_stats{"gc_user_total"};
223     printf "Total User: %6.2fs\n\n", $out_stats{"user_total"};
224
225     printf "  MUT Elap: %6.2fs\n", $out_stats{"mut_elap_total"};
226     printf "   GC Elap: %6.2fs\n", $out_stats{"gc_elap_total"};
227     printf "Total Elap: %6.2fs\n", $out_stats{"elap_total"};
228
229     close($statsfile);
230 }
231
232 1;