ghc/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 # -----------------------------------------------------------------------------