Comments only
[ghc-hetmet.git] / utils / parallel / gr2qp.pl
1 #!/usr/local/bin/perl
2 ##############################################################################
3 # Time-stamp: <Wed Jul 24 1996 20:35:01 Stardate: [-31]7859.07 hwloidl>
4 #
5 # Usage: gr2qp [options]
6 #
7 # Filter that transforms a GrAnSim profile (a .gr file) at stdin to  
8 # a quasi-parallel profile (a .qp file). It is the common front-end for most
9 # visualization tools (except gr2pe). It collects  running,
10 # runnable and blocked tasks in queues of different `colours', whose meaning
11 # is:
12 #  G ... green;   queue of all running tasks
13 #  A ... amber;   queue of all runnable tasks
14 #  R ... red;     queue of all blocked tasks
15 #  Y ... cyan;    queue of fetching tasks 
16 #  C ... crimson; queue of tasks that are being stolen
17 #  B ... blue;    queue of all sparks
18 #
19 # Options:
20 #  -i <int>  ... info level from 1 to 7; number of queues to count (see qp3ps)
21 #  -I <str>  ... count tasks that are in one of the given queues; encoding:
22 #                 'a' ... active (running)
23 #                 'r' ... runnable
24 #                 'b' ... blocked
25 #                 'f' ... fetching
26 #                 'm' ... migrating
27 #                 's' ... sparks
28 #                (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
29 #  -c        ... check consistency of data (e.g. no neg. number of tasks)
30 #  -v        ... be talkative. 
31 #  -h        ... print help message (this header).
32 #
33 ##############################################################################
34
35 require "getopts.pl";
36
37 &Getopts('hvDSci:I:');  
38
39 do process_options();
40
41 if ( $opt_v ) {
42     do print_verbose_message();
43 }
44
45 # ---------------------------------------------------------------------------
46 # Init
47 # ---------------------------------------------------------------------------
48
49 $max = 0;
50 $pmax = 0;
51 $ptotal = 0;
52 $n = 0;
53
54 $active = 0;
55 $runnable = 0;
56 $blocked = 0;
57 $fetching = 0;
58 $migrating = 0;
59 $sparks = 0;
60
61 $improved_sort_option = $opt_S ? "-S" : "";
62
63 open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
64
65 $in_header = 9; 
66 while(<>) {
67     if ( $in_header == 8 ) {
68         $start_time = $1 if /^Start-Time: (.*)$/;
69         $in_header = 0;
70         next;
71     }
72     if ( $in_header == 9 ) {
73         if (/^=/) {
74             $gum_style_gr = 1;
75             $in_header = 8;
76             next;
77         } else {
78             $gum_style_gr = 0;
79             $in_header = 1;
80         }
81         
82     }
83     if (/^\++$/) {
84         $in_header=0;
85         next;
86     }
87     next if $in_header;
88     next if /^$/;
89     next if /^=/;
90     chop;
91     ($PE, $pe, $time, $act, $tid, $rest) = split;
92     $time =~ s/[\[\]:]//g;
93     # next if $act eq 'REPLY';
94     chop($tid) if $act eq 'END';
95     $from = $queue{$tid};
96     $extra = "";
97     if ($act eq 'START') {
98         $from = '*';
99         $to = 'G';
100         $n++;
101         if ( $n > $pmax ) { $pmax = $n; }
102         $ptotal++;
103     } elsif ($act eq 'START(Q)') {
104         $from = '*';
105         $to = 'A';
106         $n++;
107         if ( $n > $pmax ) { $pmax = $n; }
108         $ptotal++;
109     } elsif ($act eq 'STEALING') {
110         $to = 'C';
111     } elsif ($act eq 'STOLEN') {
112         $to = 'G';
113     } elsif ($act eq 'STOLEN(Q)') {
114         $to = 'A';
115     } elsif ($act eq 'FETCH') {
116         $to = 'Y';
117     } elsif ($act eq 'REPLY') {
118         $to = 'R';
119     } elsif ($act eq 'BLOCK') {
120         $to = 'R';
121     } elsif ($act eq 'RESUME') {
122         $to = 'G';
123         $extra = " 0 0x0";
124     } elsif ($act eq 'RESUME(Q)') {
125         $to = 'A';
126         $extra = " 0 0x0";
127     } elsif ($act eq 'END') {
128         $to = '*';
129         $n--;
130         if ( $opt_c && $n < 0 ) { 
131             print STDERR "Error at time $time: neg. number of tasks: $n\n";
132         }
133     } elsif ($act eq 'SCHEDULE') {
134         $to = 'G';
135     } elsif ($act eq 'DESCHEDULE') {
136         $to = 'A';
137     # The following are only needed for spark profiling
138     } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
139         $from = '*';
140         $to = 'B';
141     } elsif ($act eq 'USED') {
142         $from = 'B';
143         $to = '*';
144     } elsif ($act eq 'PRUNED') {
145         $from = 'B';
146         $to = '*';
147     } elsif ($act eq 'EXPORTED') {
148         $from = 'B';
149         $to = 'B';
150     } elsif ($act eq 'ACQUIRED') {
151         $from = 'B';
152         $to = 'B';
153     } else {
154         print STDERR "Error at time $time: unknown event $act\n";
155     }
156     $queue{$tid} = $to;
157
158     if ( $from eq '' ) {
159         print STDERRR "Error at time $time: process $tid has no from queue\n";
160     }
161     if ($to ne $from) {
162         print FOOL $time, "  ", 
163           $from, $to, " 0 0x", $tid, $extra, "\n";
164     }
165
166     if ($to ne $from) {
167         # Compare with main loop in qp3ps
168         if ($from eq '*') {
169         } elsif ($from eq 'G') {
170             --$active;
171         } elsif ($from eq 'A') {
172             --$runnable;
173         } elsif ($from eq 'R') {
174             --$blocked;
175         } elsif ($from eq 'B') {
176             --$sparks;
177         } elsif ($from eq 'C') {
178             --$migrating;
179         } elsif ($from eq 'Y') {
180             --$fetching;
181         } else {
182             print STDERR "Illegal from char: $from at $time\n";
183         }
184
185         if ($to eq '*') {
186         } elsif ($to eq 'G') {
187             ++$active;
188         } elsif ($to eq 'A') {
189             ++$runnable;
190         } elsif ($to eq 'R') {
191             ++$blocked;
192         } elsif ($to eq 'B') {
193             ++$sparks;
194         } elsif ($to eq 'C') {
195             ++$migrating;
196         } elsif ($to eq 'Y') {
197             ++$fetching;
198         } else {
199             print STDERR "Illegal to char: $to at $time\n";
200         }
201
202     }
203
204     $curr = &count();
205     if ( $curr > $max ) {
206         $max = $curr;
207     }
208
209     if ( 0 ) {
210         print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
211             "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
212                 " max = $max\n"  ;
213     }
214
215     #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n"  if $opt_D;
216  
217     if ( $time > $tmax ) {
218         $tmax = $time;
219     }
220     delete $queue{$tid} if $to eq '*';
221     
222 }
223
224 print "Time: ", $tmax, " Max_selected_tasks: ", $max, 
225       " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
226
227 close(FOOL);
228
229 exit 0;
230
231 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
232 # Copied from qp3ps and slightly modified (we don't keep a list for each queue
233 # but just compute the max value we get out of all calls to count during the
234 # execution of the script).
235 # -----------------------------------------------------------------------------
236
237 # -----------------------------------------------------------------------------
238
239 sub queue_on {
240     local ($queue) = @_;
241
242     return index($show,$queue)+1;
243 }
244
245 # -----------------------------------------------------------------------------
246
247 sub count {
248     local ($res);
249
250     $res = (($queue_on_a)  ? $active : 0) +
251            (($queue_on_r)  ? $runnable : 0) +
252            (($queue_on_b)  ? $blocked : 0) +
253            (($queue_on_f)  ? $fetching : 0) +
254            (($queue_on_m)  ? $migrating : 0) +
255            (($queue_on_s)  ? $sparks : 0);
256
257     return $res;
258 }
259     
260 # -----------------------------------------------------------------------------
261 # DaH 'oH lo'lu'Qo'
262 # -----------------------------------------------------------------------------
263
264 sub set_values {
265     local ($samples,
266            $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
267
268     $G[$samples] = queue_on_a ? $active : 0;   
269     $A[$samples] = queue_on_r ? $runnable : 0; 
270     $R[$samples] = queue_on_b ? $blocked : 0;  
271     $Y[$samples] = queue_on_f ? $fetching : 0; 
272     $B[$samples] = queue_on_s ? $sparks : 0;   
273     $C[$samples] = queue_on_m ? $migrating : 0;
274 }
275
276 # -----------------------------------------------------------------------------
277
278 sub process_options { 
279     if ( $opt_h ) {                      
280         open(ME,$0) || die "Can't open myself ($0): $!\n";
281         $n = 0;
282         while (<ME>) {
283             last if $_ =~ /^$/;
284             print $_;
285             $n++;
286         }
287         close(ME);
288         exit ;
289     }
290
291     $show = "armfb";
292
293     if ( $opt_i ) { 
294         $show = "a"             if info_level == 1;
295         $show = "ar"            if info_level == 2;
296         $show = "arb"           if info_level == 3;
297         $show = "arfb"          if info_level == 4;
298         $show = "armfb"         if info_level == 5;
299         $show = "armfbs"        if info_level == 6;
300     }
301
302     if ( $opt_I ) {
303         $show = $opt_I;
304     }
305
306     if ( $opt_v ){ 
307         $verbose = 1;
308     }    
309
310     $queue_on_a = &queue_on("a");
311     $queue_on_r = &queue_on("r"); 
312     $queue_on_b = &queue_on("b"); 
313     $queue_on_f = &queue_on("f"); 
314     $queue_on_s = &queue_on("s"); 
315     $queue_on_m = &queue_on("m"); 
316 }
317
318 sub print_verbose_message { 
319
320     print STDERR "Info-str: $show\n";
321     print STDERR "The following queues are turned on: " .
322           ( $queue_on_a ? "active, " : "") .   
323           ( $queue_on_r ? "runnable, " : "") . 
324           ( $queue_on_b ? "blocked, " : "") .  
325           ( $queue_on_f ? "fetching, " : "") . 
326           ( $queue_on_m ? "migrating, " : "") .
327           ( $queue_on_s ? "sparks" : "") .
328           "\n";
329 }