ghc/utils/parallel/qp2ps.pl

   1 #! /usr/local/bin/perl
   2 ##############################################################################
   3 #
   4 # Usage: qp2ps.pl [options] <max-x> <prg> <date>
   5 #
   6 # Filter that transforms a quasi-parallel profile (a .qp file) at stdin to
   7 # a PostScript file at stdout, showing essentially the total number of running,
   8 # runnable and blocked tasks.
   9 #
  10 # Options:
  11 #  -o <file> ... write PS file to <file>
  12 #  -m        ... create mono PostScript file instead a color one.
  13 #  -O        ... compress i.e. try to minimize the size of the .ps file
  14 #  -s <str>  ... print <str> in the top right corner of the generated graph
  15 #  -i <int>  ... info level from 1 to 7; number of queues to display
  16 #  -v        ... be talkative.
  17 #  -h        ... print help message (this header).
  18 #
  19 ##############################################################################
  20
  21 require "getopts.pl";
  22
  23 &Getopts('hvDOmSs:i:I:');
  24
  25 do process_options();
  26
  27 if ( $opt_v ) {
  28     do print_verbose_message();
  29 }
  30
  31 # ---------------------------------------------------------------------------
  32 # Init
  33 # ---------------------------------------------------------------------------
  34
  35 $xmin = 100;
  36 $xmax = 790;
  37
  38 $scalex = $xmin;
  39 $labelx = $scalex - 45;
  40 $markx =  $scalex - 30;
  41 $major = $scalex - 5;
  42 $majorticks = 10;
  43
  44 $pmax = 1;
  45 $amax = 0;
  46 $ymin = 50;
  47 $ymax = 500;
  48
  49 $active = 0;
  50 $runnable = 0;
  51 $blocked = 0;
  52 $sparks = 0;
  53 $fetching = 0;
  54
  55 $lines_per_flush = 100;            # depends on the PS implementation you use
  56
  57 %color = ( "a", "green",
  58            "r", "amber",
  59            "b", "red",
  60            "f", "cyan",
  61            "m", "blue",
  62            "s", "crimson" );
  63
  64 # ---------------------------------------------------------------------------
  65
  66 do print_prolog();
  67
  68 $otime = -1;
  69 $last_x = -1;
  70 $last_y = -1;
  71 $in_seq = 0;
  72 $time_of_second_event = 0;
  73
  74 while(<STDIN>) {
  75     chop;
  76     ($time, $event, $tid, $addr, $tid2, $addr2) = split;
  77     $time_of_second_event = $time         if $time_of_second_event == 0;
  78
  79     if($time != $otime) {
  80         $tottime += $G[$samples] * ($time-$T[$samples]);
  81
  82         if($active > $amax) {
  83             $amax = $active;
  84         }
  85
  86         if ( $opt_D ) {
  87             if($G[$samples] < $amax && $A[$samples] > 0) {
  88                 printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " .
  89                               "R $R[$samples], B $B[$samples], " .
  90                               "Y $Y[$samples]\n");
  91             }
  92         }
  93
  94         # Reality Check
  95        if($G[$samples] < 0 || $A[$samples] < 0 ||
  96           $R[$samples] < 0 || $B[$samples] < 0 ||
  97           $Y[$samples] < 0) {
  98            printf(stderr "Error: Impossible number of tasks at time " .
  99                          "$T[$samples] (G $G[$samples], A $A[$samples], ".
 100                          "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
 101        }
 102         $samples++;
 103         $otime = $time;
 104     }
 105
 106     $eventfrom = substr($event,0,1);
 107     $eventto = substr($event,1,1);
 108
 109     printf(stderr "$time $event $eventfrom $eventto\n")   if $opt_D;
 110
 111     if ($eventfrom eq '*') {
 112     }
 113
 114     elsif ($eventfrom eq 'G') {
 115         --$active;
 116     }
 117
 118     elsif ($eventfrom eq 'A') {
 119         --$runnable;
 120     }
 121
 122     elsif ($eventfrom eq 'R') {
 123         --$blocked;
 124     }
 125
 126     elsif ($eventfrom eq 'B') {
 127         --$sparks;
 128     }
 129
 130     elsif ($eventfrom eq 'C') {
 131         --$migrating;
 132     }
 133
 134     elsif ($eventfrom eq 'Y') {
 135         --$fetching;
 136     }
 137
 138     if ($eventto eq '*') {
 139     }
 140
 141     elsif ($eventto eq 'G') {
 142         ++$active;
 143     }
 144
 145     elsif ($eventto eq 'A') {
 146         ++$runnable;
 147         $somerunnable = 1;
 148     }
 149
 150     elsif ($eventto eq 'R') {
 151         ++$blocked;
 152         $someblocked = 1;
 153     }
 154
 155     elsif ($eventto eq 'B') {
 156         ++$sparks;
 157         $somesparks = 1;
 158     }
 159
 160     elsif ($eventto eq 'C') {
 161         ++$migrating;
 162         $somemigratory = 1;
 163     }
 164
 165     elsif ($eventto eq 'Y') {
 166         ++$fetching;
 167         $somefetching = 1;
 168     }
 169
 170    printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
 171                  "B $sparks, C $migrating\n")  if 0;
 172
 173    $T[$samples] = $time;
 174    $G[$samples] = &queue_on("a") ? $active : 0;
 175    $A[$samples] = &queue_on("r") ? $runnable : 0;
 176    $R[$samples] = &queue_on("b") ? $blocked : 0;
 177    $Y[$samples] = &queue_on("f") ? $fetching : 0;
 178    $B[$samples] = &queue_on("s") ? $sparks : 0;
 179    $C[$samples] = &queue_on("m") ? $migrating : 0;
 180
 181     $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
 182            $B[$samples] + $C[$samples] ;
 183
 184     if($all > $pmax) {
 185         $pmax = $all;
 186     }
 187 }
 188
 189 if($time != $tmax) {
 190     die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
 191 }
 192
 193 # Print optional str
 194     if ( $opt_s ) {
 195         print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
 196     }
 197
 198 # Average Parallelism
 199 if($time > 0) {
 200     if ( 0 ) {        #  HACK warning; is this *always* correct -- HWL
 201         $avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
 202     } else {
 203         $avg = $tottime/$time;
 204     }
 205     $avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
 206     print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 525 moveto show\n");
 207     $rt_str=sprintf("Runtime = %0.0f\n",$tmax);
 208     print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 30 moveto show\n");
 209 }
 210
 211 # -----------------------------------------------------------------------------
 212 # Draw axes lines etc
 213 # -----------------------------------------------------------------------------
 214
 215 do print_y_axis();
 216
 217 # if ( ! $opt_S ) {
 218
 219 # Draw dashed line for orientation (startup time)   -- HWL
 220
 221 if ( $draw_lines ) {
 222     local($x, $y);
 223     $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
 224     $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
 225     $h = ($ymax-$ymin);
 226
 227     print "gsave\n" .
 228           "[1 3] 1 setdash\n" .
 229           "$x $y moveto 0 $h rlineto stroke\n" .
 230           "grestore\n";
 231 }
 232
 233 # and another one at the second event                        -- HWL
 234
 235 print STDERR "Time of second event is: $time_of_second_event"  if $opt_D;
 236
 237 if ( $draw_lines ) {
 238     local($x, $y);
 239     $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
 240     $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
 241     $h = ($ymax-$ymin);
 242
 243     print "gsave\n";
 244     if ( ! $opt_m ) {
 245         print "green setrgbcolor\n";
 246     }
 247     print "[3 5] 1 setdash\n" .
 248           "$x $y moveto 0 $h rlineto stroke\n" .
 249           "grestore\n";
 250 }
 251
 252 # }
 253
 254 # -----------------------------------------------------------------------------
 255 # Draw the different kinds of tasks
 256 # -----------------------------------------------------------------------------
 257
 258 $rshow = reverse($show);
 259 print STDERR "\nReversed info-mask is : $rshow"  if $opt_D;
 260 print STDERR "\nMaximal y value is $pmax"        if $opt_D;
 261 for ($j=0; $j<length($rshow); $j++) {
 262     $x = substr($rshow,$j,1);
 263     print STDERR "Queue = $x i.e. " . ($color{$x}) . "\n"  if $opt_D;
 264     print("$xmin $ymin moveto\n");
 265     for($i=1; $i <= $samples; $i++) {
 266         do psout($T[$i],&count($x,$i));
 267         if ($i % $lines_per_flush == 0) {
 268             print($color{$x} . " flush-it\n");
 269         }
 270     }
 271     # print("$xmax $ymin L\n");
 272
 273     if ( $opt_m ) {
 274         print "closepath " . ($color{$x}) . " setgray fill\n";
 275     } else {
 276         print "closepath " . ($color{$x}) . " setrgbcolor fill\n";
 277     }
 278 }
 279
 280 # -----------------------------------------------------------------------------
 281
 282
 283 # Logo
 284 print("HE14 setfont\n");
 285 if ( $opt_m ) {
 286     print("50 530 asciilogo\n");
 287 } else {
 288     print("50 530 logo\n");
 289 }
 290
 291 # Epilogue
 292 print("showpage\n");
 293
 294 exit 0;
 295
 296 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 297 # -----------------------------------------------------------------------------
 298 # Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the
 299 # x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
 300 # In case of optimization ($opt_O):
 301 #  If there is a sequence of (x,y) pairs with same x value, then just
 302 #  print the first and the last pair in the seqence. To do that, $last_x
 303 #  always contains the scaled x-val of the last point. $last_y contains
 304 #  the y-val of the last point in the current sequence (it is 0 outside a
 305 #  sequence!).
 306 # -----------------------------------------------------------------------------
 307
 308 sub psout {
 309     local($x, $y ) = @_;
 310     if ( $opt_S ) {
 311         $x = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
 312     } else {
 313         $x = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
 314     }
 315     $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
 316
 317     die "Error in psout: Neg x coordinate\n"  if ($x < 0) ;
 318
 319     if ( $opt_O ) {
 320         if ( $last_x == $x ) {      # If seq before $x that then print last pt
 321             if ( ! $in_seq ) {
 322                 $in_seq = 1;
 323                 $first_y = $last_y;
 324             }
 325         } else {                    # If seq with same $x val then ignore pts
 326             if ( $in_seq ) {        # Seq before that -> print last in seq
 327                 print("$last_x $last_y L\n")  if ($first_y != $last_y);
 328                 $in_seq = 0;
 329             }
 330             print("$x $y L\n");
 331         }
 332         $last_x = $x;
 333         $last_y = $y;
 334     } else {
 335         print("$x $y L\n");
 336     }
 337 }
 338
 339 # -----------------------------------------------------------------------------
 340
 341 sub queue_on {
 342     local ($queue) = @_;
 343
 344     return index($show,$queue)+1;
 345 }
 346
 347 # -----------------------------------------------------------------------------
 348
 349 sub count{
 350     local ($queue,$index) = @_;
 351     local ($res);
 352
 353     $where = &queue_on($queue);
 354     $res = ((&queue_on("a") && (&queue_on("a")<=$where))  ? $G[$index] : 0) +
 355            ((&queue_on("r") && (&queue_on("r")<=$where))  ? $A[$index] : 0) +
 356            ((&queue_on("b") && (&queue_on("b")<=$where))  ? $R[$index] : 0) +
 357            ((&queue_on("f") && (&queue_on("f")<=$where))  ? $Y[$index] : 0) +
 358            ((&queue_on("m") && (&queue_on("m")<=$where))  ? $B[$index] : 0) +
 359            ((&queue_on("s") && (&queue_on("s")<=$where))  ? $C[$index] : 0);
 360
 361     return $res;
 362 }
 363
 364 # -----------------------------------------------------------------------------
 365
 366 sub get_date {
 367     local ($date);
 368
 369     open (DATE,"date |") || die ("$!");
 370     while (<DATE>) {
 371         $date = $_;
 372     }
 373     close (DATE);
 374
 375     return ($date);
 376 }
 377
 378 # -----------------------------------------------------------------------------
 379
 380 sub print_prolog {
 381     local ($date);
 382
 383     $date = do get_date();
 384
 385     print("%!PS-Adobe-2.0\n");
 386     print("%%BoundingBox:    0 0 560 800\n");
 387     print("%%Title:          Activity Profile\n");
 388     print("%%Creator:        qp2ps.pl\n");
 389     print("%%CreationDate:   $date\n");
 390     print("%%EndComments\n");
 391     #print ("/greenlineto {1.0 setlinewidth lineto} def\n");
 392     #print ("/amberlineto {0.5 setlinewidth lineto} def\n");
 393     #print ("/redlineto {1.5 setlinewidth lineto} def\n");
 394     #print ("/G {newpath moveto greenlineto stroke} def\n");
 395     #print ("/A {newpath moveto amberlineto stroke} def\n");
 396     #print ("/R {newpath moveto redlineto stroke} def\n");
 397
 398     if ( $opt_m ) {
 399         print  "/red { 0.5 } def\n";
 400         print  "/green { 0 } def\n";
 401         print  "/blue { 0.7 } def\n";
 402         print  "/crimson { 0.8 } def\n";
 403         print  "/amber { 0.9 } def\n";
 404         print  "/cyan { 0.3 } def\n";
 405     } else {
 406         print  "/red { 0.8 0 0 } def\n";
 407         print  "/green { 0 0.9 0.1 } def\n";
 408         print  "/blue { 0 0.1 0.9 } def\n";
 409         print  "/crimson { 0.7 0.5 0 } def\n";
 410         print  "/amber { 0.9 0.7 0.2 } def\n";
 411         print  "/cyan { 0 0.6 0.9 } def\n";
 412     }
 413
 414     print  "/printText { 0 0 moveto (GrAnSim) show } def\n";
 415
 416     if ( $opt_m ) {
 417         print "/logo { gsave \n" .
 418             "        translate \n" .
 419             "        .95 -.05 0\n" .
 420             "          { setgray printText 1 -.5 translate } for \n" .
 421             "        1 setgray printText\n" .
 422             "        grestore } def\n";
 423     } else {
 424         print "/logo { gsave \n" .
 425               "        translate \n" .
 426               "        .95 -.05 0\n" .
 427               "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
 428               "        1 0 0 setrgbcolor printText\n" .
 429               "        grestore} def\n";
 430     }
 431
 432     print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
 433     print "/cmpx {pop exch pop eq} def             % compare x-coors of 2 points\n";
 434     print "/cmpy {exch pop 3 2 roll pop eq} def    % compare y-coors of 2 points\n";
 435     print "/cmp {2 index eq {exch pop eq}          % compare 2 points\n";
 436     print "                 {pop pop pop false} ifelse } def\n";
 437     print "%/L { lineto } def\n";
 438     print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n";
 439     print "/L {2 copy currentpoint cmpx not\n";
 440     print "     {2 copy pop currentpoint exch pop lineto} if\n";
 441     print "    2 copy currentpoint cmpy \n";
 442     print "     {pop pop} \n";
 443     print "     {lineto} ifelse\n";
 444     print "} def\n";
 445     print "/flush-it { % draw a segment of the overall area; Arg: color\n";
 446     print "            currentpoint \n";
 447     print "            1 index 50 lineto closepath\n";
 448     if ( $opt_m ) {
 449         print "            3 2 roll setgray fill \n";
 450     } else {
 451         print "            5 2 roll setrgbcolor fill \n";
 452     }
 453     print "            1 index 50 moveto lineto \n";
 454     print "} def\n";
 455     print "% For debugging PS uncomment this line and add the file behandler.ps\n";
 456     print "% $brkpage begin printonly endprint \n";
 457     print("/HE10 /Helvetica findfont 10 scalefont def\n");
 458     print("/HE12 /Helvetica findfont 12 scalefont def\n");
 459     print("/HE14 /Helvetica findfont 14 scalefont def\n");
 460     print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
 461     print "% " . "-" x 77 . "\n";
 462
 463     print("-90 rotate\n");
 464     print("-785 30 translate\n");
 465     print("newpath\n");
 466     print("0 8 moveto\n");
 467     print("0 525 760 525 8 arcto\n");
 468     print("4 {pop} repeat\n");
 469     print("760 525 760 0 8 arcto\n");
 470     print("4 {pop} repeat\n");
 471     print("760 0 0 0 8 arcto\n");
 472     print("4 {pop} repeat\n");
 473     print("0 0 0 525 8 arcto\n");
 474     print("4 {pop} repeat\n");
 475     print("0.500000 setlinewidth\n");
 476     print("stroke\n");
 477     print("newpath\n");
 478     print("4 505 moveto\n");
 479     print("4 521 752 521 4 arcto\n");
 480     print("4 {pop} repeat\n");
 481     print("752 521 752 501 4 arcto\n");
 482     print("4 {pop} repeat\n");
 483     print("752 501 4 501 4 arcto\n");
 484     print("4 {pop} repeat\n");
 485     print("4 501 4 521 4 arcto\n");
 486     print("4 {pop} repeat\n");
 487     print("0.500000 setlinewidth\n");
 488     print("stroke\n");
 489
 490     print("HE14 setfont\n");
 491     print("100 505 moveto\n");
 492     print("($pname ) show\n");
 493
 494     # print("($date) dup stringwidth pop 750 exch sub 505 moveto show\n");
 495
 496     print("4 8 moveto\n");
 497     print("4 24 756 24 4 arcto\n");
 498     print("4 {pop} repeat\n");
 499     print("756 24 756 4 4 arcto\n");
 500     print("4 {pop} repeat\n");
 501     print("756 4 4 4 4 arcto\n");
 502     print("4 {pop} repeat\n");
 503     print("4 4 4 24 4 arcto\n");
 504     print("4 {pop} repeat\n");
 505     print("0.500000 setlinewidth\n");
 506     print("stroke\n");
 507
 508 # Labels
 509
 510 # x-range: 100 - 600
 511 # y-value:
 512
 513     $x_begin = 100;
 514     $x_end = 600;
 515     $y_label = 10;
 516
 517     $no_of_labels = length($show);  # $info_level;
 518
 519     $step = ($x_end-$x_begin)/($no_of_labels);
 520
 521     $x_now = $x_begin;
 522
 523     if ( &queue_on("a") ) {
 524         do print_box_and_label($x_now,$y_label,"green","running");
 525     }
 526
 527     if ( &queue_on("r")  ) {
 528         $x_now += $step;
 529         do print_box_and_label($x_now,$y_label,"amber","runnable");
 530     }
 531
 532     if ( &queue_on("f") ) {
 533         $x_now += $step;
 534         do print_box_and_label($x_now,$y_label,"cyan","fetching");
 535     }
 536
 537     if ( &queue_on("b") ) {
 538         $x_now += $step;
 539         do print_box_and_label($x_now,$y_label,"red","blocked");
 540     }
 541
 542     if ( &queue_on("m") ) {
 543         $x_now += $step;
 544         do print_box_and_label($x_now,$y_label,"blue","migrating");
 545     }
 546
 547     if ( &queue_on("s") ) {
 548         $x_now += $step;
 549         do print_box_and_label($x_now,$y_label,"crimson","sparked");
 550     }
 551
 552     # Print runtime of prg; this is jus a crude HACK; better: x-axis!  -- HWL
 553     #print("HE10 setfont\n");
 554     #print("680 10 moveto\n");
 555     #print("(RT: $tmax) show\n");
 556
 557     print("-40 -20 translate\n");
 558 }
 559
 560 # -----------------------------------------------------------------------------
 561
 562 sub print_box_and_label {
 563     local ($x,$y,$color,$label) = @_;
 564     local ($z) = (15);
 565
 566     print("$x 10 moveto\n");
 567     print("0 10 rlineto\n");
 568     print("10 0 rlineto\n");
 569     print("0 -10 rlineto\n");
 570     print("closepath\n");
 571     print("gsave\n");
 572     if ( $opt_m ) {
 573         print("$color setgray\n");
 574     } else {
 575         print("$color setrgbcolor\n");
 576     }
 577     print("fill\n");
 578     print("grestore\n");
 579     print("stroke\n");
 580     print("HE14 setfont\n");
 581     print(($x+$z) . " 10 moveto\n");
 582     print("($label) show\n");
 583
 584 }
 585
 586 # -----------------------------------------------------------------------------
 587
 588 sub print_y_axis {
 589     local ($i);
 590
 591 # Y-axis label
 592
 593     print("gsave\n");
 594     print("HE12 setfont\n");
 595     print("(tasks)\n");
 596     print("dup stringwidth pop\n");
 597     print("$ymax\n");
 598     print("exch sub\n");
 599     print("$labelx exch\n");
 600     print("translate\n");
 601     print("90 rotate\n");
 602     print("0 0 moveto\n");
 603     print("show\n");
 604     print("grestore\n");
 605
 606 # Scale
 607
 608     if ( $opt_m ) {
 609         print "0 setgray\n";
 610     } else {
 611         print "0 0 0 setrgbcolor\n";
 612     }
 613
 614     print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
 615
 616     if ($pmax < $majorticks) {
 617         $majorticks = $pmax;
 618     }
 619
 620     $majormax = int($pmax/$majorticks)*$majorticks;
 621     $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
 622     $majorint = $majormax/$majorticks;
 623
 624     for($i=0; $i <= $majorticks; ++$i) {
 625         $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
 626         $majorval = int($majorint * ($majormax/$majorint-$i));
 627         print("$scalex $y moveto\n$major $y lineto\n");
 628         print("$markx $y moveto\n($majorval) show\n");
 629     }
 630
 631     # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
 632     print " stroke\n";
 633 }
 634
 635 # -----------------------------------------------------------------------------
 636
 637 sub print_verbose_message {
 638
 639     print "Prg Name: $pname  Date: $date  Info-str: $show\n";
 640     print "Input: stdin  Output: stdout\n";
 641 }
 642
 643 # ----------------------------------------------------------------------------
 644
 645 sub process_options {
 646
 647     if ( $opt_h ) {
 648         open(ME,$0) || die "Can't open myself ($0): $!\n";
 649         $n = 0;
 650         while (<ME>) {
 651             last if $_ =~ /^$/;
 652             print $_;
 653             $n++;
 654         }
 655         close(ME);
 656         exit ;
 657     }
 658
 659     if ( $#ARGV != 2 ) {
 660         print "Usage: $0 [options] <max y value> <prg name> <date> \n";
 661         print "Use -h option to get details\n";
 662         exit 1;
 663     }
 664
 665     $tmax = $ARGV[0];
 666     $pname = $ARGV[1];
 667     $date = $ARGV[2];
 668
 669     $show = "armfb";
 670
 671     if ( $opt_S ) {
 672         $draw_lines = 1;
 673     } else {
 674         $draw_lines = 0;
 675     }
 676
 677     if ( $opt_i ) {
 678         $show = "a"             if info_level == 1;
 679         $show = "ar"            if info_level == 2;
 680         $show = "arb"           if info_level == 3;
 681         $show = "arfb"          if info_level == 4;
 682         $show = "armfb"         if info_level == 5;
 683         $show = "armfbs"        if info_level == 6;
 684     }
 685
 686     if ( $opt_I ) {
 687         $show = $opt_I;
 688     }
 689
 690     if ( $opt_v ){
 691         $verbose = 1;
 692     }
 693
 694 # if ($#ARGV == 0) {
 695 #     printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
 696 #     exit 1;
 697 # }
 698 }
 699
 700 # -----------------------------------------------------------------------------
 701 # Old way of drawing areas
 702 # -----------------------------------------------------------------------------
 703
 704 exit 0;
 705
 706 # Blocked Tasks
 707 if ($someblocked && ($info_level >= 3)) {
 708     print("$xmin $ymin moveto\n");
 709     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 710         do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]+$R[$i]);
 711         if ($i % $lines_per_flush == 0) {
 712             print("red flush-it\n");
 713         }
 714     }
 715     # print("$xmax $ymin L\n");
 716
 717     if ( $opt_m ) {
 718         print "closepath red setgray fill\n";
 719     } else {
 720         print "closepath red setrgbcolor fill\n";
 721     }
 722 }
 723
 724 # Fetching Tasks
 725 if ($somefetching && ($info_level >= 4)) {
 726     print("$xmin $ymin moveto\n");
 727     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 728         do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]);
 729         if ($i % $lines_per_flush == 0) {
 730             print("cyan flush-it\n");
 731         }
 732     }
 733     # print("$xmax $ymin L\n");
 734
 735     if ( $opt_m ) {
 736         print "closepath cyan setgray fill\n";
 737     } else {
 738         print "closepath cyan setrgbcolor fill\n";
 739     }
 740 }
 741
 742 # Sparks
 743 if ($somesparks && ($info_level >= 6)) {
 744     print("$xmin $ymin moveto\n");
 745     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 746         do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]);
 747         if ($i % $lines_per_flush == 0) {
 748             print("crimson flush-it\n");
 749         }
 750     }
 751     # print("$xmax $ymin L\n");
 752
 753     if ( $opt_m ) {
 754         print "closepath crimson setgray fill\n";
 755     } else {
 756         print "closepath crimson setrgbcolor fill\n";
 757     }
 758 }
 759
 760 # Migrating Threads
 761 if ($somemigratory && ($info_level >= 5)) {
 762     print("$xmin $ymin moveto\n");
 763     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 764         do psout($T[$i],$G[$i]+$A[$i]+$C[$i]);
 765         if ($i % $lines_per_flush == 0) {
 766             print("blue flush-it\n");
 767         }
 768     }
 769     # print("$xmax $ymin L\n");
 770     # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
 771     if ( $opt_m ) {
 772         print "closepath blue setgray fill\n";
 773     } else {
 774         print "closepath blue setrgbcolor fill\n";
 775     }
 776 }
 777
 778 # Runnable Tasks
 779 if($somerunnable && ($info_level >= 2)) {
 780     print("$xmin $ymin moveto\n");
 781     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 782         do psout($T[$i],$G[$i]+$A[$i]);
 783         if ($i % $lines_per_flush == 0) {
 784             print("amber flush-it\n");
 785         }
 786     }
 787     # print("$xmax $ymin L\n");
 788     # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
 789     if ( $opt_m ) {
 790         print "closepath amber setgray fill\n";
 791     } else {
 792         print "closepath amber setrgbcolor fill\n";
 793     }
 794 }
 795
 796 # Active Tasks
 797 if ($info_level >= 1) {
 798     print("$xmin $ymin moveto\n");
 799     for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
 800         do psout($T[$i],$G[$i]);
 801         if ($i % $lines_per_flush == 0) {
 802             print("green flush-it\n");
 803         }
 804     }
 805     # print("$xmax $ymin L\n");
 806     # print("closepath\ngsave\n0.5 setgray\nfill\ngrestore\nstroke\n");
 807     if ( $opt_m ) {
 808         print "closepath green setgray fill\n";
 809     } else {
 810         print "closepath green setrgbcolor fill\n";
 811     }
 812 }
 813