ghc/utils/parallel/qp2ps.pl

   1 #! /usr/local/bin/perl
   2 ##############################################################################
   3 # Time-stamp: <Wed Jul 24 1996 22:04:50 Stardate: [-31]7859.39 hwloidl>
   4 #
   5 # Usage: qp2ps [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 essentially the total number of running,
   9 # runnable and blocked tasks.
  10 #
  11 # Options:
  12 #  -o <file> ... write .ps file to <file>
  13 #  -m        ... create mono PostScript file instead a color one.
  14 #  -O        ... compress i.e. try to minimize the size of the .ps file
  15 #  -s <str>  ... print <str> in the top right corner of the generated graph
  16 #  -i <int>  ... info level from 1 to 7; number of queues to display
  17 #  -I <str>  ... queues to be displayed (in the given order) with the encoding
  18 #                 'a' ... active (running)
  19 #                 'r' ... runnable
  20 #                 'b' ... blocked
  21 #                 'f' ... fetching
  22 #                 'm' ... migrating
  23 #                 's' ... sparks
  24 #                (e.g. -I "arb" shows active, runnable, blocked tasks)
  25 #  -l <int>  ... length of a slice in the .ps file; (default: 100)
  26 #                small value => less memory consumption of .ps file & script
  27 #                but slower in generating the .ps file
  28 #  -d        ... Print date instead of average parallelism
  29 #  -v        ... be talkative.
  30 #  -h        ... print help message (this header).
  31 #
  32 ##############################################################################
  33
  34 require "getopts.pl";
  35
  36 &Getopts('hvDCOmdl:s:i:I:H');
  37
  38 do process_options();
  39
  40 if ( $opt_v ) {
  41     do print_verbose_message();
  42 }
  43
  44 # ---------------------------------------------------------------------------
  45 # Init
  46 # ---------------------------------------------------------------------------
  47
  48 $y_scaling = 1.0;
  49
  50 $xmin = 100;
  51 $xmax = 790;
  52
  53 $scalex = $xmin;
  54 $labelx = $scalex - 45;
  55 $markx =  $scalex - 30;
  56 $major = $scalex - 5;
  57 $majorticks = 10;
  58
  59 $mmax = 1;
  60
  61 $amax = 0;
  62 $ymin = 50;
  63 $ymax = 500;
  64
  65 $active = 0;
  66 $runnable = 0;
  67 $blocked = 0;
  68 $fetching = 0;
  69 $migrating = 0;
  70 $sparks = 0;
  71
  72 #$lines_per_flush = 100;            # depends on the PS implementation you use
  73
  74 %color = ( "a", "green",        # active
  75            "r", "amber",        # runnable
  76            "b", "red",          # blocked
  77            "f", "cyan",         # fetching
  78            "m", "blue",         # migrating
  79            "s", "crimson" );    # sparks
  80
  81 # ---------------------------------------------------------------------------
  82
  83 do print_prolog();
  84
  85 $otime = -1;
  86 $time_of_second_event = 0;
  87 $samples = 0;
  88
  89 $T[0] = 0;
  90 $G[0] = 0;
  91 $A[0] = 0;
  92 $R[0] = 0;
  93 $B[0] = 0;
  94 $Y[0] = 0;
  95
  96 while(<STDIN>) {
  97     next if /^[^0-9]/;   # ignore lines not beginning with a digit (esp. last)
  98     chop;
  99     ($time, $event, $tid, $addr, $tid2, $addr2) = split;
 100     $time_of_second_event = $time         if $time_of_second_event == 0;
 101
 102     if($time != $otime) {
 103         $tottime += $G[$samples] * ($time-$T[$samples]);
 104         $otime = $time;
 105     }
 106
 107     if($active > $amax) {
 108         $amax = $active;
 109     }
 110
 111     if ( $opt_D ) {
 112         if($G[$samples] < $amax && $A[$samples] > 0) {
 113             printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " .
 114                    "R $R[$samples], B $B[$samples], " .
 115                    "Y $Y[$samples]\n");
 116         }
 117     }
 118
 119     # Reality Check
 120     if($G[$samples] < 0 || $A[$samples] < 0 ||
 121        $R[$samples] < 0 || $B[$samples] < 0 ||
 122        $Y[$samples] < 0) {
 123         printf(stderr "Error: Impossible number of tasks at time " .
 124                "$T[$samples] (G $G[$samples], A $A[$samples], ".
 125                "R $R[$samples], B $B[$samples], Y $Y[$samples])\n") if $opt_v || $opt_D;
 126         if ( $opt_H ) {  # HACK
 127             $G[$samples] = 0  if $G[$samples] < 0;
 128             $A[$samples] = 0  if $A[$samples] < 0;
 129             $R[$samples] = 0  if $R[$samples] < 0;
 130             $B[$samples] = 0  if $B[$samples] < 0;
 131             $Y[$samples] = 0  if $Y[$samples] < 0;
 132         }
 133     }
 134     $samples++;
 135
 136     $eventfrom = substr($event,0,1);
 137     $eventto = substr($event,1,1);
 138
 139     printf(stderr "$time $event $eventfrom $eventto\n")   if 0 && $opt_D;
 140
 141     if ($eventfrom eq '*') {
 142     }
 143
 144     elsif ($eventfrom eq 'G') {
 145         --$active;
 146     }
 147
 148     elsif ($eventfrom eq 'A') {
 149         --$runnable;
 150     }
 151
 152     elsif ($eventfrom eq 'R') {
 153         --$blocked;
 154     }
 155
 156     elsif ($eventfrom eq 'B') {
 157         --$sparks;
 158     }
 159
 160     elsif ($eventfrom eq 'C') {
 161         --$migrating;
 162     }
 163
 164     elsif ($eventfrom eq 'Y') {
 165         --$fetching;
 166     }
 167
 168     if ($eventto eq '*') {
 169     }
 170
 171     elsif ($eventto eq 'G') {
 172         ++$active;
 173     }
 174
 175     elsif ($eventto eq 'A') {
 176         ++$runnable;
 177         $somerunnable = 1;
 178     }
 179
 180     elsif ($eventto eq 'R') {
 181         ++$blocked;
 182         $someblocked = 1;
 183     }
 184
 185     elsif ($eventto eq 'B') {
 186         ++$sparks;
 187         $somesparks = 1;
 188     }
 189
 190     elsif ($eventto eq 'C') {
 191         ++$migrating;
 192         $somemigratory = 1;
 193     }
 194
 195     elsif ($eventto eq 'Y') {
 196         ++$fetching;
 197         $somefetching = 1;
 198     }
 199
 200
 201     #printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
 202     #      "B $sparks, C $migrating\n")  if 1;
 203
 204     printf(stderr "Error: Trying to write at index 0!\n")  if $samples == 0;
 205     $T[$samples] = $time;
 206     do set_values($samples,
 207                   $active,$runnable,$blocked,$fetching,$sparks,$migrating);
 208
 209    #$G[$samples] = queue_on_a ? $active : 0;
 210    #$A[$samples] = queue_on_r ? $runnable : 0;
 211    #$R[$samples] = queue_on_b ? $blocked : 0;
 212    #$Y[$samples] = queue_on_f ? $fetching : 0;
 213    #$B[$samples] = queue_on_s ? $sparks : 0;
 214    #$C[$samples] = queue_on_m ? $migrating : 0;
 215
 216     $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
 217            $B[$samples] + $C[$samples] ;
 218
 219     if($all > $mmax) {
 220         $mmax = $all;
 221     }
 222
 223     if ( 0 ) {
 224         print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
 225             "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
 226                 " max = $all\n" ;
 227     }
 228
 229     #print STDERR "Sparks @ $time: $sparks \tAll: $all \tMMax: $mmax\n"  if $opt_D;
 230
 231     if ( $samples >= $slice_width ) {
 232         do flush_queues();
 233         $samples = 0;
 234     }
 235
 236 } # <STDIN>
 237
 238 do flush_queues();
 239 print "%% End\n"  if $opt_C;
 240
 241 # For debugging only
 242 if ($opt_D) {
 243     printf(stderr "Queue values after last event: " .
 244            "$T[$samples] (G $G[$samples], A $A[$samples], ".
 245            "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
 246 }
 247
 248 if($time != $tmax) {
 249     if ( $pedantic ) {
 250         die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
 251     } else {                    #
 252         print STDERR "Warning: Calculated time ($time) does not agree with stated max. time ($tmax)\n" if $opt_v;
 253     }
 254 }
 255
 256 # HACK warning:
 257 # The real max-y value ($mmax) might differ from the one that is the input
 258 # to this script ($pmax). If so, we post-process the generated ps-file
 259 # and place an appropriate scaling  fct into the header of the ps-file.
 260 # This is done by yet another perl-script:
 261 #                 ps-scale-y <y-scaling-factor> <ps-file>
 262
 263 if($pmax != $mmax) {
 264     if ( $pedantic ) {
 265         die "Error: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n";
 266     } else {
 267         print STDERR  "Warning: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n" if $opt_v;
 268         $y_scaling = $pmax/$mmax; #((float) $pmax)/((float) $mmax);
 269     }
 270 }
 271
 272 print "% " . ("-" x 75) . "\n";
 273
 274 if ( $opt_m ) {
 275         print "0 setgray\n";
 276 } else {
 277         print "0 0 0 setrgbcolor\n";
 278 }
 279
 280 # Print optional str
 281     if ( $opt_s ) {
 282         print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
 283     }
 284
 285     print("unscale-y\n");
 286
 287 # Average Parallelism
 288 if($time > 0) {
 289     if ( $opt_S ) {        #  HACK warning; is this *always* correct -- HWL
 290         $avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
 291     } else {
 292         $avg = $tottime/$time;
 293     }
 294     if ( $opt_d ) {        # Print date instead of average parallelism
 295         print("HE14 setfont ($date) dup stringwidth pop 790 exch sub 515 moveto show\n");
 296     } else {
 297         $avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
 298         print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 515 moveto show\n");
 299     }
 300     $rt_str=sprintf("Runtime = %0.0f\n",$tmax);
 301     print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 20 moveto show\n");
 302 }
 303
 304 # do print_y_axis();
 305
 306 # -----------------------------------------------------------------------------
 307 # Draw axes lines etc
 308 # -----------------------------------------------------------------------------
 309
 310 if ( ! $opt_S ) {
 311
 312 # Draw dashed line for orientation (startup time)   -- HWL
 313
 314 if ( $draw_lines ) {
 315     local($x, $y);
 316     $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
 317     $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
 318     $h = ($ymax-$ymin);
 319
 320     print "gsave\n" .
 321           "[1 3] 1 setdash\n" .
 322           "$x $y moveto 0 $h rlineto stroke\n" .
 323           "grestore\n";
 324 }
 325
 326 # and another one at the second event                        -- HWL
 327
 328 print STDERR "Time of second event is: $time_of_second_event"  if 0 && $opt_D;
 329
 330 if ( $draw_lines ) {
 331     local($x, $y);
 332     $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
 333     $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
 334     $h = ($ymax-$ymin);
 335
 336     print "gsave\n";
 337     if ( ! $opt_m ) {
 338         print "green setrgbcolor\n";
 339     }
 340     print "[3 5] 1 setdash\n" .
 341           "$x $y moveto 0 $h rlineto stroke\n" .
 342           "grestore\n";
 343 }
 344
 345 }
 346
 347 # -----------------------------------------------------------------------------
 348
 349 # Logo
 350 print("HE14 setfont\n");
 351 if ($opt_m) {
 352     print("50 520 asciilogo\n");
 353 } else {
 354     print("50 520 logo\n");
 355 }
 356
 357 # Epilogue
 358 print("showpage\n");
 359
 360 if ( $y_scaling != 1.0 ) {
 361     print "%% y_scaling: $y_scaling\t max: $mmax\n";
 362 }
 363
 364 exit 0 ;
 365
 366 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 367 # -----------------------------------------------------------------------------
 368 # Draw the current slice of the overall graph.
 369 # This routine is called if a slice of data is full (i.e. $T[0..$samples],
 370 # $G[0..$slice_width] etc with $samples==$slice_width contain data from the
 371 # input file) or if the end of the input has been reached (i.e. $samples<=
 372 # $slice_width). Note that the last value of the current slice is stored as
 373 # the first value for the next slice.
 374 # -----------------------------------------------------------------------------
 375
 376 sub flush_queues {
 377     local ($x_norm, $y_norm);
 378     local ($index);
 379     local ($last_x, $last_y, $in_seq) = (-1, -1, 0);
 380     local ($foo_x, $foo_y);
 381
 382     if ( $samples == 0 ) { return ; }
 383
 384     # print "% First sample: T $T[0] (G $G[0], A $A[0], ".
 385     #   " R $R[0], B $B[0], Y $Y[0])\n"   if $opt_C;
 386
 387     $rshow = reverse($show);
 388     print STDERR "\nReversed info-mask is : $rshow"  if 0 && $opt_D;
 389     print STDERR "\nMaximal y value is $pmax"        if 0 && $opt_D;
 390     for ($j=0; $j<length($rshow); $j++) {
 391         $q = substr($rshow,$j,1);
 392         # print  "% Queue = $q i.e. " . ($color{$q}) . " counts at first sample: " . &count($q,0) ."\n"  if $opt_C;
 393         do init_psout($q, $T[0], &count($q,0));
 394         for($i=1; $i <= $samples; $i++) {
 395             do psout($T[$i],&count($q,$i));
 396         }
 397         print $color{$q} . " F\n";
 398         ($foo_x, $foo_y) = &normalize($T[$samples],&count($q,$samples));
 399         print "%% Last " . ($color{$q}) . " is " . &get_queue_val($q,$samples) ."  (" . $T[$samples] . ", " . &count($q,$samples) . ") -> ($foo_x,$foo_y)\n"  if $opt_C;
 400         # print($color{$q} . " flush-it\n");
 401         # print("$xmax $ymin L\n");
 402     }
 403     do wrap($samples);
 404
 405     #print "% Last sample  T $T[$samples] (G $G[$samples], A $A[$samples], ".
 406     #      " R $R[$samples], B $B[$samples], Y $Y[$samples])\n"  if $opt_C;
 407 }
 408
 409 # -----------------------------------------------------------------------------
 410 # Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the
 411 # x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
 412 # In case of optimization ($opt_O):
 413 #  If there is a sequence of (x,y) pairs with same x value, then just
 414 #  print the first and the last pair in the seqence. To do that, $last_x
 415 #  always contains the scaled x-val of the last point. $last_y contains
 416 #  the y-val of the last point in the current sequence (it is 0 outside a
 417 #  sequence!).
 418 # -----------------------------------------------------------------------------
 419
 420 sub normalize {
 421     local($x, $y ) = @_;
 422     local($x_norm, $y_norm );
 423
 424     if ( $opt_S ) {
 425         $x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
 426     } else {
 427         $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
 428     }
 429     $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
 430
 431     return (($x_norm, $y_norm));
 432 }
 433
 434 # -----------------------------------------------------------------------------
 435
 436 sub init_psout {
 437     local ($q, $x, $y) = @_;
 438     local ($x_norm, $y_norm);
 439
 440     ($last_x, $last_y, $in_seq) = (-1, -1, 0);
 441     ($x_norm, $y_norm) =  &normalize($T[0],&count($q,0));
 442     $last_x = $x_norm;
 443     $last_y = $y_norm;
 444     print "%% Begin " . ($color{$q}) . "  (" . $T[0] . ", " . &count($q,0) . ") -> ($x_norm,$y_norm)\n" if $opt_C;
 445     print $x_norm, " ", $y_norm, " M\n";
 446
 447 }
 448
 449 # ----------------------------------------------------------------------------
 450
 451 sub psout {
 452     local($x_in, $y_in ) = @_;
 453     local($x, $y );
 454
 455     ($x, $y) = &normalize($x_in, $y_in);
 456     die "Error in psout: Neg x coordinate\n"  if ($x < 0) ;
 457
 458     if ( $opt_O ) {
 459         if ( $last_x == $x ) {      # If seq before $x that then print last pt
 460             if ( ! $in_seq ) {
 461                 $in_seq = 1;
 462                 $first_y = $last_y;
 463             }
 464         } else {                    # If seq with same $x val then ignore pts
 465             if ( $in_seq ) {        # Seq before that -> print last in seq
 466                 print("$last_x $last_y L\n")  if ($first_y != $last_y);
 467                 $in_seq = 0;
 468             }
 469             print("$x $y L\n");
 470         }
 471         $last_x = $x;
 472         $last_y = $y;
 473     } else {
 474         print("$x $y L\n");
 475     }
 476 }
 477
 478 # -----------------------------------------------------------------------------
 479
 480 sub queue_on {
 481     local ($queue) = @_;
 482
 483     return index($show,$queue)+1;
 484 }
 485
 486 # -----------------------------------------------------------------------------
 487
 488 sub count {
 489     local ($queue,$index) = @_;
 490     local ($res);
 491
 492     $where = &queue_on($queue);
 493     $res = (($queue_on_a && ($queue_on_a<=$where))  ? $G[$index] : 0) +
 494            (($queue_on_r && ($queue_on_r<=$where))  ? $A[$index] : 0) +
 495            (($queue_on_b && ($queue_on_b<=$where))  ? $R[$index] : 0) +
 496            (($queue_on_f && ($queue_on_f<=$where))  ? $Y[$index] : 0) +
 497            (($queue_on_m && ($queue_on_m<=$where))  ? $C[$index] : 0) +
 498            (($queue_on_s && ($queue_on_s<=$where))  ? $B[$index] : 0);
 499
 500     return $res;
 501 }
 502
 503 # -----------------------------------------------------------------------------
 504
 505 sub set_values {
 506     local ($samples,
 507            $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
 508
 509     $G[$samples] = $queue_on_a ? $active : 0;
 510     $A[$samples] = $queue_on_r ? $runnable : 0;
 511     $R[$samples] = $queue_on_b ? $blocked : 0;
 512     $Y[$samples] = $queue_on_f ? $fetching : 0;
 513     $B[$samples] = $queue_on_s ? $sparks : 0;
 514     $C[$samples] = $queue_on_m ? $migrating : 0;
 515 }
 516
 517 # -----------------------------------------------------------------------------
 518
 519 sub set_queue_val {
 520     local ($queue,$index,$val) = @_;
 521
 522     if    ( $queue == "a" ) { $G[$index] = $val; }
 523     elsif ( $queue == "r" ) { $A[$index] = $val; }
 524     elsif ( $queue == "b" ) { $R[$index] = $val; }
 525     elsif ( $queue == "f" ) { $Y[$index] = $val; }
 526     elsif ( $queue == "m" ) { $C[$index] = $val; }
 527     elsif ( $queue == "s" ) { $B[$index] = $val; }
 528 }
 529
 530 # -----------------------------------------------------------------------------
 531
 532 sub wrap {                # used in flush_queues at the end of a slice
 533     local ($index) = @_;
 534
 535     $T[0] = $T[$index];
 536
 537     $G[0] = $G[$index];
 538     $A[0] = $A[$index];
 539     $R[0] = $R[$index];
 540     $Y[0] = $Y[$index];
 541     $B[0] = $B[$index];
 542     $C[0] = $C[$index];
 543 }
 544
 545 # -----------------------------------------------------------------------------
 546
 547 sub get_queue_val {
 548     local ($queue,$index) = @_;
 549
 550     if ( $queue == "a" ) { return $G[$index]; }
 551     elsif ( $queue == "r" ) { return $A[$index]; }
 552     elsif ( $queue == "b" ) { return $R[$index]; }
 553     elsif ( $queue == "f" ) { return $Y[$index]; }
 554     elsif ( $queue == "m" ) { return $C[$index]; }
 555     elsif ( $queue == "s" ) { return $B[$index]; }
 556 }
 557
 558 # -----------------------------------------------------------------------------
 559
 560 sub get_date {
 561     local ($date);
 562
 563     chop($date = `date`);
 564     return ($date);
 565 }
 566
 567 # -----------------------------------------------------------------------------
 568
 569 sub print_prolog {
 570     local ($now);
 571
 572     $now = do get_date();
 573
 574     print("%!PS-Adobe-2.0\n");
 575     print("%%BoundingBox:    0 0 560 800\n");
 576     print("%%Title:          Activity Profile\n");
 577     print("%%Creator:        qp2ps\n");
 578     print("%%StartTime:      $date\n");
 579     print("%%CreationDate:   $now\n");
 580     print("%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
 581     print("%%EndComments\n");
 582     #print ("/greenlineto {1.0 setlinewidth lineto} def\n");
 583     #print ("/amberlineto {0.5 setlinewidth lineto} def\n");
 584     #print ("/redlineto {1.5 setlinewidth lineto} def\n");
 585     #print ("/G {newpath moveto greenlineto stroke} def\n");
 586     #print ("/A {newpath moveto amberlineto stroke} def\n");
 587     #print ("/R {newpath moveto redlineto stroke} def\n");
 588
 589     if ( $opt_m ) {
 590         print  "/red { 0 } def\n";
 591         print  "/green { 0.5 } def\n";
 592         print  "/blue { 0.7 } def\n";
 593         print  "/crimson { 0.8 } def\n";
 594         print  "/amber { 0.9 } def\n";
 595         print  "/cyan { 0.3 } def\n";
 596     } else {
 597         print  "/red { 0.8 0 0 } def\n";
 598         print  "/green { 0 0.9 0.1 } def\n";
 599         print  "/blue { 0 0.1 0.9 } def\n";
 600         print  "/crimson { 0.7 0.5 0 } def\n";
 601         print  "/amber { 0.9 0.7 0.2 } def\n";
 602         print  "/cyan { 0 0.6 0.9 } def\n";
 603     }
 604
 605     print  "/printText { 0 0 moveto (GrAnSim) show } def\n";
 606
 607     if ( $opt_m ) {
 608         print "/logo { gsave \n" .
 609             "        translate \n" .
 610             "        .95 -.05 0\n" .
 611             "          { setgray printText 1 -.5 translate } for \n" .
 612             "        1 setgray printText\n" .
 613             "        grestore } def\n";
 614     } else {
 615         print "/logo { gsave \n" .
 616               "        translate \n" .
 617               "        .95 -.05 0\n" .
 618               "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
 619               "        1 0 0 setrgbcolor printText\n" .
 620               "        grestore} def\n";
 621     }
 622
 623     print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
 624     print "/cmpx {pop exch pop eq} def             % compare x-coors of 2 points\n";
 625     print "/cmpy {exch pop 3 2 roll pop eq} def    % compare y-coors of 2 points\n";
 626     print "/cmp {2 index eq {exch pop eq}          % compare 2 points\n";
 627     print "                 {pop pop pop false} ifelse } def\n";
 628
 629     # Hook for scaling just the graph and y-axis
 630     print "% " . "-" x 77 . "\n";
 631     print "/scale-y { } def\n";
 632     print "/unscale-y { } def\n";
 633
 634     print "% " . "-" x 77 . "\n";
 635     print "/str-len 12 def\n";
 636     print "/prt-n { cvi str-len string cvs \n" .
 637           "         dup stringwidth pop \n" .
 638           "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
 639           "         neg 0 rmoveto \n" .
 640           "         show  } def \n" .
 641           "        % print top-of-stack integer centered at the current point\n";
 642     # NB: These PostScript functions must correspond to the Perl fct `normalize'
 643     #  Currently normalize defines the following trafo on (x,y) values:
 644     #  $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
 645     #  $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
 646
 647     print "/total-len $tmax def\n";
 648     print "/show-len $xmax def\n";
 649     print "/x-offset $xmin def\n";
 650     print "/y-offset $ymin def\n";
 651     print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
 652     print "% " . "-" x 77 . "\n";
 653     print "%/L { lineto } def\n";
 654     print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n";
 655     print "/L {2 copy currentpoint cmpx not\n";
 656     print "     {2 copy pop currentpoint exch pop lineto} if\n";
 657     print "    2 copy currentpoint cmpy \n";
 658     print "     {pop pop} \n";
 659     print "     {lineto} ifelse\n";
 660     print "} def\n";
 661     print "/F { % flush a segment of the overall area; Arg: color\n";
 662     print "            currentpoint pop $ymin lineto closepath\n";
 663     if ( $opt_m ) {
 664         print "            setgray fill \n";
 665     } else {
 666         print "            setrgbcolor fill \n";
 667     }
 668     print "} def\n";
 669     print "/M {  % Start drawing a slice (vert. line and moveto startpoint)\n";
 670     print "      % Arg: x y\n";
 671     print "      newpath 1 index $ymin moveto lineto\n";
 672     print "} def\n";
 673     print "% For debugging PS uncomment this line and add the file behandler.ps\n";
 674     print "% $brkpage begin printonly endprint \n";
 675     print("/HE10 /Helvetica findfont 10 scalefont def\n");
 676     print("/HE12 /Helvetica findfont 12 scalefont def\n");
 677     print("/HE14 /Helvetica findfont 14 scalefont def\n");
 678     print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
 679     print "% " . "-" x 77 . "\n";
 680
 681     print("-90 rotate\n");
 682     print("-785 30 translate\n");
 683     print("newpath\n");
 684     print("0 8 moveto\n");
 685     print("0 525 760 525 8 arcto\n");
 686     print("4 {pop} repeat\n");
 687     print("760 525 760 0 8 arcto\n");
 688     print("4 {pop} repeat\n");
 689     print("760 0 0 0 8 arcto\n");
 690     print("4 {pop} repeat\n");
 691     print("0 0 0 525 8 arcto\n");
 692     print("4 {pop} repeat\n");
 693     print("0.500000 setlinewidth\n");
 694     print("stroke\n");
 695     print("newpath\n");
 696     print("4 505 moveto\n");
 697     print("4 521 752 521 4 arcto\n");
 698     print("4 {pop} repeat\n");
 699     print("752 521 752 501 4 arcto\n");
 700     print("4 {pop} repeat\n");
 701     print("752 501 4 501 4 arcto\n");
 702     print("4 {pop} repeat\n");
 703     print("4 501 4 521 4 arcto\n");
 704     print("4 {pop} repeat\n");
 705     print("0.500000 setlinewidth\n");
 706     print("stroke\n");
 707
 708     print("HE14 setfont\n");
 709     print("100 505 moveto\n");
 710     print("($pname ) show\n");
 711
 712     # print("($date) dup stringwidth pop 750 exch sub 505 moveto show\n");
 713
 714     print("4 8 moveto\n");
 715     print("4 24 756 24 4 arcto\n");
 716     print("4 {pop} repeat\n");
 717     print("756 24 756 4 4 arcto\n");
 718     print("4 {pop} repeat\n");
 719     print("756 4 4 4 4 arcto\n");
 720     print("4 {pop} repeat\n");
 721     print("4 4 4 24 4 arcto\n");
 722     print("4 {pop} repeat\n");
 723     print("0.500000 setlinewidth\n");
 724     print("stroke\n");
 725
 726 # Labels
 727
 728 # x-range: 100 - 600
 729 # y-value:
 730
 731     $x_begin = 100;
 732     $x_end = 600;
 733     $y_label = 10;
 734
 735     $no_of_labels = length($show);  # $info_level;
 736
 737     $step = ($x_end-$x_begin)/($no_of_labels);
 738
 739     $x_now = $x_begin;
 740
 741     if ( $queue_on_a ) {
 742         do print_box_and_label($x_now,$y_label,"green","running");
 743     }
 744
 745     if ( $queue_on_r  ) {
 746         $x_now += $step;
 747         do print_box_and_label($x_now,$y_label,"amber","runnable");
 748     }
 749
 750     if ( $queue_on_f ) {
 751         $x_now += $step;
 752         do print_box_and_label($x_now,$y_label,"cyan","fetching");
 753     }
 754
 755     if ( $queue_on_b ) {
 756         $x_now += $step;
 757         do print_box_and_label($x_now,$y_label,"red","blocked");
 758     }
 759
 760     if ( $queue_on_m ) {
 761         $x_now += $step;
 762         do print_box_and_label($x_now,$y_label,"blue","migrating");
 763     }
 764
 765     if ( $queue_on_s ) {
 766         $x_now += $step;
 767         do print_box_and_label($x_now,$y_label,"crimson","sparked");
 768     }
 769
 770     # Print runtime of prg; this is jus a crude HACK; better: x-axis!  -- HWL
 771     #print("HE10 setfont\n");
 772     #print("680 10 moveto\n");
 773     #print("(RT: $tmax) show\n");
 774
 775     print("-40 -10 translate\n");
 776
 777     do print_x_axis();
 778
 779     print("$xmin $ymin moveto\n");
 780     if ( $opt_m ) {
 781         print "0 setgray\n";
 782     } else {
 783         print "0 0 0 setrgbcolor\n";
 784     }
 785
 786     do print_y_axis();
 787
 788     print("scale-y\n");
 789
 790 }
 791
 792 # -----------------------------------------------------------------------------
 793
 794 sub print_box_and_label {
 795     local ($x,$y,$color,$label) = @_;
 796     local ($z) = (15);
 797
 798     print("$x 10 moveto\n");
 799     print("0 10 rlineto\n");
 800     print("10 0 rlineto\n");
 801     print("0 -10 rlineto\n");
 802     print("closepath\n");
 803     print("gsave\n");
 804     if ( $opt_m ) {
 805         print("$color setgray\n");
 806     } else {
 807         print("$color setrgbcolor\n");
 808     }
 809     print("fill\n");
 810     print("grestore\n");
 811     print("stroke\n");
 812     print("HE14 setfont\n");
 813     print(($x+$z) . " 10 moveto\n");
 814     print("($label) show\n");
 815
 816 }
 817
 818 # -----------------------------------------------------------------------------
 819
 820 sub print_x_axis {
 821
 822     print "% " . "-" x 77 . "\n";
 823     print "% X-Axis:\n";
 824     print "/y-val $ymin def\n";
 825     print "0.5 setlinewidth\n";
 826     print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
 827     print "0 total-len 10 div total-len\n" .
 828           " { dup normalize dup y-val moveto 0 -2 rlineto stroke  % tic\n" .
 829           "   y-val 10 sub moveto HE10 setfont round prt-n  % print label \n" .
 830           " } for \n";
 831     print "1 setlinewidth\n";
 832     print "% End X-Axis:\n";
 833     print "% " . "-" x 77 . "\n";
 834 }
 835
 836 # -----------------------------------------------------------------------------
 837
 838 sub print_y_axis {
 839     local ($i);
 840     local ($y, $smax,$majormax, $majorint);
 841
 842 # Y-axis label
 843
 844     print "% " . ("-" x 75) . "\n";
 845     print "% Y-Axis:\n";
 846     print "% " . ("-" x 75) . "\n";
 847
 848     print("%scale-y  % y-axis outside scaled area if ps-scale-y rebuilds it!\n");
 849
 850     print("gsave\n");
 851     print("HE12 setfont\n");
 852     print("(tasks)\n");
 853     print("dup stringwidth pop\n");
 854     print("$ymax\n");
 855     print("exch sub\n");
 856     print("$labelx exch\n");
 857     print("translate\n");
 858     print("90 rotate\n");
 859     print("0 0 moveto\n");
 860     print("show\n");
 861     print("grestore\n");
 862
 863 # Scale
 864
 865     if ($pmax < $majorticks) {
 866         $majorticks = $pmax;
 867     }
 868
 869     print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
 870     print("% Max number of tasks: $pmax\n");
 871     print("% Number of ticks: $majorticks\n");
 872
 873     print "0.5 setlinewidth\n";
 874
 875     $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
 876     print("$scalex $y moveto\n$major $y lineto\n");
 877     print("$markx $y moveto\n($pmax) show\n");
 878
 879     $majormax = int($pmax/$majorticks)*$majorticks;
 880     $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
 881     $majorint = $majormax/$majorticks;
 882
 883     for($i=1; $i <= $majorticks; ++$i) {
 884         $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
 885         $majorval = int($majorint * ($majormax/$majorint-$i));
 886         print("$scalex $y moveto\n$major $y lineto\n");
 887         print("$markx $y moveto\n($majorval) show\n");
 888     }
 889
 890     # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
 891     print " stroke\n";
 892     print "1 setlinewidth\n";
 893     print "%unscale-y\n";
 894     print "% End Y-Axis.\n";
 895     print "% " . ("-" x 75) . "\n";
 896 }
 897
 898 # -----------------------------------------------------------------------------
 899
 900 sub print_verbose_message {
 901
 902     print STDERR "Prg Name: $pname  \nDate: $date  \nInfo-str: $show\n";
 903     print STDERR "Input: stdin  Output: stdout\n";
 904     print STDERR "The following queues are turned on: " .
 905           ( $queue_on_a ? "active, " : "") .
 906           ( $queue_on_r ? "runnable, " : "") .
 907           ( $queue_on_b ? "blocked, " : "") .
 908           ( $queue_on_f ? "fetching, " : "") .
 909           ( $queue_on_m ? "migrating, " : "") .
 910           ( $queue_on_s ? "sparks" : "") .
 911           "\n";
 912     if ( $opt_C ) {
 913         print STDERR "Inserting check code into .ps file (for check-ps3 script)\n";
 914     }
 915     if ( $opt_D )  {
 916         print STDERR "Debugging is turned ON!\n";
 917     }
 918 }
 919
 920 # ----------------------------------------------------------------------------
 921
 922 sub process_options {
 923
 924     if ( $opt_h ) {
 925         open(ME,$0) || die "Can't open myself ($0): $!\n";
 926         $n = 0;
 927         while (<ME>) {
 928             last if $_ =~ /^$/;
 929             print $_;
 930             $n++;
 931         }
 932         close(ME);
 933         exit ;
 934     }
 935
 936     if ( $#ARGV != 3 ) {
 937         print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
 938         print "Use -h option to get details\n";
 939         exit 1;
 940     }
 941
 942     $tmax = $ARGV[0];
 943     $pmax = $ARGV[1];
 944     # GUM uses the absolute path (with '=' instead of '/') of the executed file
 945     # (for PVM reasons); if you want to have the full path in the generated
 946     # graph, too, eliminate the substitution below
 947     ($pname = $ARGV[2]) =~ s/.*=//;
 948     $date = $ARGV[3];
 949
 950     $show = "armfb";
 951     $draw_lines = 0;
 952
 953     if ( $opt_i ) {
 954         $show = "a"             if info_level == 1;
 955         $show = "ar"            if info_level == 2;
 956         $show = "arb"           if info_level == 3;
 957         $show = "arfb"          if info_level == 4;
 958         $show = "armfb"         if info_level == 5;
 959         $show = "armfbs"        if info_level == 6;
 960     }
 961
 962     if ( $opt_I ) {
 963         $show = $opt_I;
 964     }
 965
 966     if ( $opt_v ){
 967         $verbose = 1;
 968     }
 969
 970     if ( $opt_l ) {
 971         $slice_width = $opt_l;
 972     } else {
 973         $slice_width = 500;
 974     }
 975
 976     $queue_on_a = &queue_on("a");
 977     $queue_on_r = &queue_on("r");
 978     $queue_on_b = &queue_on("b");
 979     $queue_on_f = &queue_on("f");
 980     $queue_on_s = &queue_on("s");
 981     $queue_on_m = &queue_on("m");
 982
 983 # if ($#ARGV == 0) {
 984 #     printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
 985 #     exit 1;
 986 # }
 987 }
 988