Use --force-local when calling tar in bindisttest/
[ghc-hetmet.git] / utils / parallel / qp2ap.pl
1 #! /usr/local/bin/perl
2 ##############################################################################
3 # Time-stamp: <Wed Jul 24 1996 22:05:31 Stardate: [-31]7859.39 hwloidl>
4 #
5 # Usage: qp2ap [options] <max-x> <max-y> <prg> <date>
6 #
7 # Filter that transforms a quasi-parallel profile (a .qp file) at stdin to  
8 # a PostScript file at stdout, showing an activity profile with one horizontal
9 # line for each task (thickness of the line shows if it's active or suspended).
10 #
11 # Options:
12 #  -o <file> ... write .ps file to <file>
13 #  -m        ... create mono PostScript file instead a color one.
14 #  -O        ... optimise i.e. try to minimise the size of the .ps file.
15 #  -s <n>    ... scaling factor of y axis (default: 1)
16 #  -w <n>    ... width of lines denoting running threads (default: 2) 
17 #  -v        ... be talkative. 
18 #  -h        ... print help message (this header).
19 #
20 ##############################################################################
21
22
23 require "getopts.pl";
24
25 &Getopts('hvms:w:OlD');  
26
27 do process_options();
28
29 if ( $opt_v ) {
30     do print_verbose_message();
31 }
32
33 # ---------------------------------------------------------------------------
34 # Init
35 # ---------------------------------------------------------------------------
36
37 $y_scaling = 0;
38 $gtid = 1;               # number of process so far = $gtid-1
39
40 $xmin = 100;
41 $xmax = 790;
42
43 $scalex = $xmin;
44 $labelx = $scalex - 45;
45 $markx =  $scalex - 30;
46 $major = $scalex - 5;
47 $majorticks = 10;
48
49 # $pmax = 40;
50 $ymin = 50;
51 $ymax = 500;
52
53 if ( ($ymax - $ymin)/$pmax < 3 ) {
54     print STDERR "Warning: Too many tasks! Distance will be smaller than 3 pixels.\n";
55 }
56
57 if ( !$width ) { 
58     $width = 2/3 * ($ymax - $ymin)/$pmax;
59 }
60
61 do write_prolog();
62 do print_y_axis();
63
64 # ---------------------------------------------------------------------------
65 # Main Part
66 # ---------------------------------------------------------------------------
67
68 while(<STDIN>) {
69     next if /^[^0-9]/;   # ignore lines not beginning with a digit (esp. last)
70     chop;
71     ($time, $event, $tid, $addr, $tid2, $addr2) = split;
72
73     if ( $event eq "*G") {
74             $TID{$addr} = $gtid++;
75             $START{$addr} = $time;
76     }
77
78     elsif ($event eq "*A") {
79             $TID{$addr} = $gtid++;
80             $SUSPEND{$addr} = $time;
81     }
82
83     elsif ($event eq "G*" || $event eq "GR" ) {
84         do psout($START{$addr},$time,$TID{$addr},"runlineto");
85 #       $STOP{$addr} = $time;
86     }
87
88     elsif ($event eq "GA" || $event eq "GC" || $event eq "GY") {
89         do psout($START{$addr},$time,$TID{$addr},"runlineto");
90         $SUSPEND{$addr} = $time;
91     }
92         
93     elsif ($event eq "RA") {
94         $SUSPEND{$addr} = $time;
95     }
96
97     elsif ($event eq "YR") {
98         do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
99     }
100
101     elsif ($event eq "CA" || $event eq "YA" ) {
102         do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
103         $SUSPEND{$addr} = $time;
104     }
105
106     elsif ($event eq "AC" || $event eq "AY" ) {
107         do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
108         $SUSPEND{$addr} = $time;
109     }
110
111     elsif ($event eq "RG") {
112         $START{$addr} = $time;
113     }
114
115     elsif ($event eq "AG") {
116         do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
117         $START{$addr} = $time;
118     } 
119
120     elsif ($event eq "CG" || $event eq "YG" ) {
121         do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
122         $START{$addr} = $time;
123     } elsif ( $event eq "B*" || $event eq "*B" || $event eq "BB" ) {
124         print STDERR "Ignoring spark event $event at $time\n"  if $opt_v;
125     } else {
126         print STDERR "Unexpected event $event at $time\n";
127     }
128
129     print("%% $time: $event $addr $TID{$addr}\n\n")  if $opt_D;
130 }
131
132 # ---------------------------------------------------------------------------
133
134 # Logo
135 print("HE14 setfont\n");
136 if ( $opt_m ) {
137     print("50 550 asciilogo\n");                     
138 } else {
139     print("50 550 logo\n");                          #
140 }
141
142 # Epilogue
143 print("showpage\n");
144
145 if ( $gtid-1 != $pmax ) {
146     if ( $pedantic ) {
147         die "Error: Calculated max no. of tasks ($gtid-1) does not agree with stated max. no. of tasks ($pmax)\n";
148     } else {
149         print STDERR  "Warning: Calculated total no. of tasks ($gtid-1) does not agree with stated total no. of tasks ($pmax)\n" if $opt_v;
150         $y_scaling = $pmax/($gtid-1); 
151     }
152 }
153
154
155 exit 0;
156
157 # ---------------------------------------------------------------------------
158
159 sub psout {
160     local($x1, $x2, $y, $cmd) = @_;
161     print("% ($x1,$y) -- ($x2,$y) $cmd\n")  if $opt_D;
162     $x1 = int(($x1/$tmax) * ($xmax-$xmin) + $xmin);
163     $x2 = int(($x2/$tmax) * ($xmax-$xmin) + $xmin);
164     $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
165     if ( $x1 == $x2 ) {
166         $x2 = $x1 + 1;
167     }
168     
169     if ( $opt_l ) {
170         print("newpath\n");
171         print("$x1 $y moveto\n");
172         print("$x2 $y $cmd\n");
173         print("stroke\n");
174     } elsif ( $opt_O ) {
175         print "$x1 $x2 $y " .
176             ( $cmd eq "runlineto" ? "G RL\n" :
177               $cmd eq "suspendlineto" ? "R SL\n" :
178               $cmd eq "fetchlineto" ? "B FL\n" :
179               "\n% ERROR: Unknown command $cmd\n");
180
181     } else {
182         print "$x2 $y $x1 $y " . 
183             ( $cmd eq "runlineto" ? "green run\n" :
184               $cmd eq "suspendlineto" ? "red suspend\n" :
185               $cmd eq "fetchlineto" ? "blue fetch\n" :
186               "\n% ERROR: Unknown command $cmd\n");
187     }       
188 }
189
190 # -----------------------------------------------------------------------------
191
192 sub get_date {
193     local ($date);
194
195     chop($date = `date`);
196     return ($date);
197 }
198
199 # -----------------------------------------------------------------------------
200
201 sub write_prolog {
202     local ($now);
203
204     $now = do get_date();
205
206     print("%!PS-Adobe-2.0\n");
207     print("%%BoundingBox:    0 0 560 800\n");
208     print("%%Title:          Per-thread Activity Profile\n");
209     print("%%Creator:        qp2ap\n");
210     print("%%StartTime:      $date\n");
211     print("%%CreationDate:   $now\n");
212     print("%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
213     print("%%EndComments\n");
214
215     print "% " . "-" x 77 . "\n";
216     print "% Tunable Parameters:\n";
217     print "% The width of a line representing a task\n";
218     print "/width $width def\n";
219     print "% Scaling factor for the y-axis (usful to enlarge)\n";
220     print "/y-scale $y_scale def\n";
221     print "% " . "-" x 77 . "\n";
222
223     print "/total-len $tmax def\n";
224     print "/show-len $xmax def\n";
225     print "/x-offset $xmin def\n";
226     print "/y-offset $ymin def\n";
227     print "% normalize is the PS version of the formula: \n" .
228           "%   int(($x1/$tmax) * ($xmax-$xmin) + $xmin) \n" .
229           "% in psout.\n";
230     print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
231     print "/x-normalize { exch show-len mul total-len div exch } def\n";
232     print "/y-normalize { y-offset sub y-scale mul y-offset add } def\n";
233     print "/str-len 12 def\n";
234     print "/prt-n { cvi str-len string cvs \n" .
235           "         dup stringwidth pop \n" .
236           "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
237           "         neg 0 rmoveto \n" . 
238           "         show  } def \n" .
239           "        % print top-of-stack integer centered at the current point\n";
240     # print "/prt-n { cvi str-len string cvs \n" .
241     #       "         dup stringwidth pop 2 div neg 0 rmoveto \n" . 
242     #       "         show  } def \n" .
243     #       "        % print top-of-stack integer centered at the current point\n";
244
245     if ( $opt_l ) {
246         print ("/runlineto {1.5 setlinewidth lineto} def\n");
247         print ("/suspendlineto {0.5 setlinewidth lineto} def\n");
248         print ("/fetchlineto {0.2 setlinewidth lineto} def\n");
249     } else {
250             if ( $opt_m ) {
251                 if ( $opt_O ) {
252                     print  "/R { 0 } def\n";
253                     print  "/G { 0.5 } def\n";
254                     print  "/B { 0.2 } def\n";
255                 } else {
256                     print  "/red { 0 } def\n";
257                     print  "/green { 0.5 } def\n";
258                     print  "/blue { 0.2 } def\n";
259                 }
260                 print  "/set-bg { setgray } def\n";
261             } else {
262                 if ( $opt_O ) {
263                     print  "/R { 0.8 0 0 } def\n";
264                     print  "/G { 0 0.9 0.1 } def\n";
265                     print  "/B { 0 0.1 0.9 } def\n";
266                     print  "/set-bg { setrgbcolor } def\n";
267                 } else {
268                     print  "/red { 0.8 0 0 } def\n";
269                     print  "/green { 0 0.9 0.1 } def\n";
270                     print  "/blue { 0 0.1 0.9 } def\n";
271                     print  "/set-bg { setrgbcolor } def\n";
272                 }
273             }
274
275             if ( $opt_O ) {
276                 print "% RL: runlineto; draws a horizontal line in given color\n";
277                 print "% Operands: x-from x-to y color\n";
278                 print "/RL { set-bg   % set color \n" .
279                       "      newpath y-normalize  % mangle y val\n" .
280                       "      2 index 1 index moveto width setlinewidth \n" .
281                       "      lineto pop stroke} def\n";
282                 print "% SL: suspendlineto; draws a horizontal line in given color (thinner)\n";
283                 print "% Operands: x-from x-to y color\n";
284                 print "/SL { set-bg   % set color \n" .
285                       "      newpath y-normalize  % mangle y val\n" .
286                       "      2 index 1 index moveto width 2 div setlinewidth \n" .
287                       "      lineto pop stroke} def\n";
288                 print "% FL: fetchlineto; draws a horizontal line in given color (thinner)\n";
289                 print "% Operands: x-from x-to y color\n";
290                 print "/FL { set-bg   % set color \n" .
291                       "      newpath y-normalize  % mangle y val\n" .
292                       "      2 index 1 index moveto width " . 
293                           ( $opt_m ? " 4 " : " 2 ") . 
294                       " div setlinewidth \n" .
295                       "      lineto pop stroke} def\n";
296             } else {
297                 print "/run { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
298                     "setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
299                 print "/suspend { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
300                     "2 div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
301                 print "/fetch { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
302                     ( $opt_m ? " 4 " : " 2 ") .
303                         "div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
304                 #print ("/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n");
305                 #print ("/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n");
306             }
307         }
308
309     print  "/printText { 0 0 moveto (GrAnSim) show } def\n";      
310     print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
311     if ( $opt_m ) {
312         print "/logo { asciilogo } def\n";
313     } else {
314         print "/logo { gsave \n" .
315             "        translate \n" .
316                 "        .95 -.05 0\n" .
317                     "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
318                         "        1 0 0 setrgbcolor printText\n" . 
319                             "        grestore} def\n";
320     }
321     print "% For debugging PS uncomment this line and add the file behandler.ps\n";
322     print "% $brkpage begin printonly endprint \n";
323
324     print("/HE10 /Helvetica findfont 10 scalefont def\n");
325     print("/HE12 /Helvetica findfont 12 scalefont def\n");
326     print("/HE14 /Helvetica findfont 14 scalefont def\n");
327     print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
328     print "% " . "-" x 77 . "\n";
329     print("newpath\n");
330
331     print("-90 rotate\n");
332     print("-785 30 translate\n");
333     print("0 8.000000 moveto\n");
334     print("0 525.000000 760.000000 525.000000 8.000000 arcto\n");
335     print("4 {pop} repeat\n");
336     print("760.000000 525.000000 760.000000 0 8.000000 arcto\n");
337     print("4 {pop} repeat\n");
338     print("760.000000 0 0 0 8.000000 arcto\n");
339     print("4 {pop} repeat\n");
340     print("0 0 0 525.000000 8.000000 arcto\n");
341     print("4 {pop} repeat\n");
342     print("0.500000 setlinewidth\n");
343     print("stroke\n");
344     print("newpath\n");
345     print("4.000000 505.000000 moveto\n");
346     print("4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n");
347     print("4 {pop} repeat\n");
348     print("752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n");
349     print("4 {pop} repeat\n");
350     print("752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n");
351     print("4 {pop} repeat\n");
352     print("4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n");
353     print("4 {pop} repeat\n");
354     print("0.500000 setlinewidth\n");
355     print("stroke\n");
356
357     print("HE14 setfont\n");
358     print("100 505 moveto\n");
359     print("($pname ) show\n");
360     
361     print("($date) dup stringwidth pop 750 exch sub 505.000000 moveto show\n");
362     
363     # print "/total-len $tmax def\n";
364     print("-40 -40 translate\n");
365
366     print "% " . "-" x 77 . "\n";
367     print "% Print x-axis:\n";
368     print "/y-val $ymin def % { y-offset 40 sub 2 div y-offset add } def\n";
369     print "0.5 setlinewidth\n";
370     print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
371     print "0 total-len 10 div total-len\n" .
372           " { dup normalize dup y-val moveto 0 -2 rlineto stroke  % tic\n" .
373           "   y-val 10 sub moveto HE10 setfont round prt-n  % print label \n" .
374           " } for \n";
375     print "1 setlinewidth\n";
376     print "% " . "-" x 77 . "\n";
377
378 }
379
380 # -----------------------------------------------------------------------------
381
382 sub print_y_axis {
383     local ($i);
384     local ($y, $smax,$majormax, $majorint);
385
386 # Y-axis label
387
388     print "% " . ("-" x 75) . "\n";
389     print "% Y-Axis:\n";
390     print "% " . ("-" x 75) . "\n";
391
392     if ( $opt_m ) {
393         print "0 setgray\n";
394     } else {
395         print "0 0 0 setrgbcolor\n";
396     }
397
398     print("gsave\n");
399     print("HE12 setfont\n");
400     print("(tasks)\n");
401     print("dup stringwidth pop\n");
402     print("$ymax\n");
403     print("exch sub\n");
404     print("$labelx exch\n");
405     print("translate\n");
406     print("90 rotate\n");
407     print("0 0 moveto\n");
408     print("show\n");
409     print("grestore\n");
410
411 # Scale
412
413     if ($pmax < $majorticks) {
414         $majorticks = $pmax;
415     }
416
417     print "0.5 setlinewidth\n";
418
419     print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
420     print("% Total number of tasks: $pmax\n");
421     print("% Number of ticks: $majorticks\n");
422
423     $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
424     print("$scalex $y moveto\n$major $y lineto\n");
425     print("$markx $y moveto\n($pmax) show\n");
426
427     $majormax = int($pmax/$majorticks)*$majorticks;
428     $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
429     $majorint = $majormax/$majorticks;
430
431     for($i=0; $i <= $majorticks; ++$i) {
432         $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
433         $majorval = int($majorint * ($majormax/$majorint-$i));
434         print("$scalex $y moveto\n$major $y lineto\n");
435         print("$markx $y moveto\n($majorval) show\n");
436     }
437
438     # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
439     print " stroke\n";
440     print "1 setlinewidth\n";
441     print "% " . ("-" x 75) . "\n";
442 }
443
444 # ---------------------------------------------------------------------------
445
446 sub print_verbose_message {
447
448     print "Prg Name: $pname  Date: $date\n";
449     print "Input: stdin  Output: stdout\n";
450 }
451
452 # ----------------------------------------------------------------------------
453
454 sub process_options {
455
456      if ( $opt_h ) {                      
457         open(ME,$0) || die "Can't open myself ($0): $!\n";
458         $n = 0;
459         while (<ME>) {
460             last if $_ =~ /^$/;
461             print $_;
462             $n++;
463         }
464         close(ME);
465         exit ;
466     }
467     
468      if ( $opt_s ) {                      
469          $y_scale = $opt_s;
470      } else {
471          $y_scale = 1; 
472      }
473
474     if ( $#ARGV != 3 ) {
475         print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
476         print "Use -h option to get details\n";
477         exit 1;
478     }
479
480     $tmax = $ARGV[0];
481     $pmax = $ARGV[1];
482     # GUM uses the absolute path (with '=' instead of '/') of the executed file
483     # (for PVM reasons); if you want to have the full path in the generated
484     # graph, too, eliminate the substitution below
485     ($pname = $ARGV[2]) =~ s/.*=//;
486     $date = $ARGV[3];
487
488      if ( $opt_w ) {
489          $width = $opt_w;
490      } else {
491          $width = 0;
492      }
493
494 }
495 # -----------------------------------------------------------------------------