ghc/utils/parallel/gr2pe.pl

   1 #!/usr/local/bin/perl
   2 #                                       (C) Hans Wolfgang Loidl, November 1994
   3 # ############################################################################
   4 # Time-stamp: <Fri Jun 14 1996 20:21:17 Stardate: [-31]7659.03 hwloidl>
   5 #
   6 # Usage: gr2pe [options] <gr-file>
   7 #
   8 # Create per processor activity profile (as ps-file) from a given gr-file.
   9 #
  10 # Options:
  11 #  -o <file> ... output file (ps file) has name <file>
  12 #  -m        ... produce monochrome output
  13 #  -M        ... produce a migration graph
  14 #  -S        ... produce a spark graph in a separate file (based on the no. of
  15 #                sparks rather than the no. of runnable threads)
  16 #  -t        ... produce trace of runnable, blocked, fetching threads
  17 #  -i <n>    ... ``infinity'' for number of blocked tasks (default: 20)
  18 #                all values larger than that are shown with the same width
  19 #  -C        ... do consistency check at each event (mainly for debugging)
  20 #  -h        ... print help message (this text)
  21 #  -v        ... be talkative
  22 #
  23 # ############################################################################
  24
  25 # die "This script is still under development -- HWL\n";
  26
  27 # ----------------------------------------------------------------------------
  28 # Command line processing and initialization
  29 # ----------------------------------------------------------------------------
  30
  31 require "getopts.pl";
  32
  33 &Getopts('hvDCMNmSGti:o:l:p:');
  34
  35 do process_options();
  36
  37 if ( $opt_v ) {
  38     do print_verbose_message();
  39 }
  40
  41 # ----------------------------------------------------------------------------
  42 # Global Variables
  43 # ----------------------------------------------------------------------------
  44
  45 $RUNNING = "RUNNING";
  46 $RUNNABLE = "RUNNABLE";
  47 $BLOCKED = "BLOCKED";
  48 $START = "START";
  49 $END = "END";
  50
  51 # Modes for hline
  52 #$LITERATE = 1;
  53 #$NORMALIZING = 2;
  54
  55 %GRAY = (
  56          $RUNNING, 0.6,
  57          $RUNNABLE, 0.3,
  58          $BLOCKED, 0,
  59          $START, 0,
  60          $END, 0.5);
  61
  62 # Special value showing that no task is running on $pe if in $running[$pe]
  63 $NO_ID = -1;
  64 $NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;
  65
  66 # The number of PEs we have
  67 $nPEs = 32;
  68
  69 # Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
  70 $width_unit = 1;
  71
  72 # Width of line for RUNNING
  73 $running_width = 1;
  74
  75 # Offset of BLOCKED and RUNNABLE lines from the center line
  76 $offset = 10;
  77
  78 # Left and right border of the picture; Width of the picture
  79 $left_border = 0;
  80 $right_border = 700;
  81 $total_width = $right_border - $left_border;
  82 $x_scale = 1;
  83
  84 # Height of the picture measured from y-val of first to y-val of last PE
  85 $lower_border = 10;
  86 $upper_border = 490;
  87 $total_height = $upper_border - $lower_border;
  88 $y_scale = 1;
  89
  90 # Constant from where shrinking of x-values (+scaling as usual) is enabled
  91 $very_big = 1E8;
  92
  93 # Factor by which the x values are shrunk (if very big)
  94 $shrink_x = 10000;
  95
  96 # Set format of output of numbers
  97 $# = "%.2g";
  98
  99 # Width of stripes in migration graph
 100 $tic_width = 2;
 101
 102 # If no spark profile should be generate we count the number of spark events
 103 # in the profile to inform the user about existing spark information
 104 if ( !$opt_S ) {
 105     $spark_events = 0;
 106 }
 107
 108 # ----------------------------------------------------------------------------
 109 # The real thing starts here
 110 # ----------------------------------------------------------------------------
 111
 112 open (IN,"<$input") || die "$input: $!\n";
 113 open (OUT,">$output") || die "$output: $!\n";
 114 open (OUT_MIG,">$output_mig") || die "$output_mig: $!\n"  if $opt_M;
 115 open (OUT_SP,">$output_sp") || die "$output_sp: $!\n"  if $opt_S;
 116 # open (OUT_B,">$output_b") || die "$output_b: $!\n";
 117 # open (OUT_R,">$output_r") || die "$output_r: $!\n";
 118
 119 open(OUT_RA, ">$RUNNABLE_file") || die "$RUNNABLE_file: $!\n"  if $opt_t;
 120 print OUT_RA "# Number of Runnable tasks on all PEs $i\n"      if $opt_t;
 121 open(OUT_BA, ">$BLOCKED_file") || die "$BLOCKED_file: $!\n"    if $opt_t;
 122 print OUT_BA "# Number of Blocked tasks on all PEs $i\n"       if $opt_t;
 123 open(OUT_FA, ">$FETCHING_file") || die "$FETCHING_file: $!\n"  if $opt_t;
 124 print OUT_FA "# Number of Fetching tasks on all PEs $i\n"      if $opt_t;
 125
 126 ($pname,$pars,$nPEs,$lat) = &skip_header(IN);
 127
 128
 129 # Fill in the y_val table for all PEs
 130 $offset = (&generate_y_val_table($nPEs)/2);
 131
 132 $x_min = 0;
 133 $x_max = &get_x_max($input);
 134 $y_max = $total_height;
 135 #$y_max = $y_val[$nPEs-1] + offset;
 136
 137 $is_very_big = $x_max > $very_big;
 138
 139 # Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
 140 $max_width = $offset;
 141
 142 # General init
 143 do init($nPEs);
 144
 145 do write_prolog(OUT,$x_max,$y_max);
 146 do write_prolog(OUT_MIG,$x_max,$y_max)  if $opt_M;
 147 do write_prolog(OUT_SP,$x_max,$y_max)  if $opt_S;
 148 # do write_prolog(OUT_B,$x_max,$y_max);
 149 # do write_prolog(OUT_R,$x_max,$y_max);
 150
 151 while (<IN>) {
 152     next  if /^$/;                                # Omit empty lines;
 153     next  if /^--/;                               # Omit comment lines;
 154
 155     ($event, $time, $id, $pe) = &get_line($_);
 156     $x_max_ = $time  if $time > $x_max_;
 157
 158     print OUT_RA "TIME: $time  PEs: " . join(", ",@runnable) .
 159                  "  SUM: " . &list_sum(@runnable) . "\n"      if $opt_t;
 160     print OUT_BA "TIME: $time  PEs: " . join(", ",@blocked) .
 161                  "  SUM: " . &list_sum(@blocked) . "\n"       if $opt_t;
 162     print OUT_FA "TIME: $time  PEs: " . join(", ",@fetching) .
 163                  "  SUM: " . &list_sum(@fetching) . "\n"      if $opt_t;
 164
 165     foo : {
 166         ($event eq "START") && do {
 167             # do draw_tic($pe, $time, $START);
 168             do draw_bg($pe, $time);
 169             $last_bg[$pe] = $time;
 170             $running[$pe] = $id;
 171             # $where{$id} = $pe + 1;
 172             last foo;
 173         };
 174         ($event eq "START(Q)") && do {
 175             #do draw_segment($pe, $time, $RUNNABLE);
 176             do draw_bg($pe, $time);
 177             $last_bg[$pe] = $time;
 178             #$last_runnable[$pe] = $time;
 179             $runnable[$pe]++;
 180             # $where{$id} = $pe + 1;
 181             last foo;
 182         };
 183         ($event eq "STEALING") && do {
 184             do draw_bg($pe, $time);
 185             $last_bg[$pe] = $time;
 186             $runnable[$pe]--;
 187             $where{$id} = $pe + 1;
 188             if ( $opt_M ) {
 189                 $when{$id} = $time;
 190                 do draw_tic($pe, $time, $event);
 191             }
 192             last foo;
 193         };
 194         ($event eq "STOLEN") && do {
 195             # do draw_tic($pe, $time, $START);
 196             do draw_bg($pe, $time);
 197             $last_bg[$pe] = $time;
 198             $running[$pe] = $id;
 199             if ( $where{$id} ) {
 200                 # Ok
 201             } else {
 202                 $warn++;
 203                 print "WARNING: No previous location for STOLEN task $id found!" .
 204                      " Check the gr file!\n";
 205             }
 206             if ( $opt_M ) {
 207                 do draw_tic($pe, $time, $event);
 208                 do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
 209             }
 210             last foo;
 211         };
 212         ($event eq "STOLEN(Q)") && do {
 213             #do draw_segment($pe, $time, $RUNNABLE);
 214             do draw_bg($pe, $time);
 215             $last_bg[$pe] = $time;
 216             #$last_runnable[$pe] = $time;
 217             $runnable[$pe]++;
 218             if ( $where{$id} ) {
 219                 # Ok
 220             } else {
 221                 $warn++;
 222                 print "WARNING: No previous location for STOLEN(Q) task $id found!" .
 223                     " Check the gr file!\n";
 224             }
 225             if ( $opt_M ) {
 226                 do draw_tic($pe, $time, $event);
 227                 do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
 228             }
 229             last foo;
 230         };
 231         ($event eq "BLOCK") && do {
 232             do draw_bg($pe, $time);
 233             $last_bg[$pe] = $time;
 234             do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
 235             $last_blocked[$pe] = $time;
 236             #do draw_segment($pe, $time, $RUNNING);
 237             $blocked[$pe]++;
 238             $running[$pe] = $NO_ID;
 239             last foo;
 240         };
 241         ($event eq "RESUME") && do {
 242             # do draw_tic($pe, $time, $START);
 243             do draw_bg($pe, $time);
 244             $last_bg[$pe] = $time;
 245             do draw_segment($pe, $time, $BLOCKED);
 246             $last_blocked[$pe] = $time;
 247             $blocked[$pe]--;
 248             $running[$pe] = $id;
 249             last foo;
 250         };
 251         ($event eq "RESUME(Q)") && do {
 252             #do draw_segment($pe, $time, $RUNNABLE);
 253             do draw_bg($pe, $time);
 254             $last_bg[$pe] = $time;
 255             do draw_segment($pe, $time, $BLOCKED);
 256             $last_blocked[$pe] = $time;
 257             #$last_runnable[$pe] = $time;
 258             $blocked[$pe]--;
 259             $runnable[$pe]++;
 260             last foo;
 261         };
 262         ($event eq "END") && do {
 263             # do draw_tic($pe, $time, $END);
 264             do draw_bg($pe, $time);
 265             $last_bg[$pe] = $time;
 266             $running[$pe] = $NO_ID;
 267             # do draw_segment($pe, $time, $RUNNING);
 268             # $last_blocked[$pe] = $time;
 269             last foo;
 270         };
 271         ($event eq "SCHEDULE") && do {
 272             # do draw_tic($pe, $time);
 273             $last_start[$pe] = $time;
 274             do draw_bg($pe, $time);
 275             $last_bg[$pe] = $time;
 276             $runnable[$pe]--;
 277             $running[$pe] = $id;
 278             last foo;
 279         };
 280         # NB: Check these; they are not yet tested
 281         ($event eq "FETCH") && do {
 282             # Similar to BLOCK; but don't draw a block segment
 283             do draw_bg($pe, $time);
 284             $last_bg[$pe] = $time;
 285             #do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
 286             #$last_blocked[$pe] = $time;
 287             #$blocked[$pe]++;
 288             $fetching[$pe]++;
 289             $running[$pe] = $NO_ID;
 290             last foo;
 291         };
 292         ($event eq "REPLY") && do {
 293             do draw_bg($pe, $time);
 294             $last_bg[$pe] = $time;
 295             #do draw_segment($pe, $time, $BLOCKED);
 296             #$last_blocked[$pe] = $time;
 297             #$blocked[$pe]--;
 298             $fetching[$pe]--;
 299             $blocked[$pe]++;
 300             last foo;
 301         };
 302         # These are only processed if a spark pofile is generated, too
 303         (($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
 304             if ( !opt_S ) {
 305                 $spark_events++;
 306                 last foo;
 307             }
 308             do draw_sp_bg($pe, $time);
 309             $last_sp_bg[$pe] = $time;
 310             $sparks[$pe]++;
 311             last foo;
 312         };
 313
 314         (($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
 315             if ( !opt_S ) {
 316                 $spark_events++;
 317                 last foo;
 318             }
 319             do draw_sp_bg($pe, $time);
 320             $last_sp_bg[$pe] = $time;
 321             $sparks[$pe]--;
 322             if ( $sparks[$pe]<0 ) {
 323                 print STDERR "Error: Neg. number of sparks @ $time\n";
 324             }
 325             last foo;
 326         };
 327
 328         $warn++;
 329         print "WARNING: Unknown event: $event\n";
 330     }
 331     do check_consistency()  if $opt_M;
 332 }
 333
 334 do write_epilog(OUT,$x_max,$y_max);
 335 do write_epilog(OUT_MIG,$x_max,$y_max)   if $opt_M;
 336 do write_epilog(OUT_SP,$x_max,$y_max)    if $opt_S;
 337 # do write_epilog(OUT_B,$x_max,$y_max);
 338 # do write_epilog(OUT_R,$x_max,$y_max);
 339
 340 close(IN);
 341 close(OUT);
 342 # close(OUT_B);
 343 # close(OUT_R);
 344
 345 close(OUT_MIG) if $opt_M;
 346 close(OUT_SP)  if $opt_S;
 347 close(OUT_BA)  if $opt_t;
 348 close(OUT_RA)  if $opt_t;
 349 close(OUT_FA)  if $opt_t;
 350
 351 #for ($i=0; $i<$nPEs; $i++) {
 352 #    close($OUT_BA[$i]);
 353 #    close($OUT_RA[$i]);
 354 #}
 355
 356 if ($x_max != $x_max_ ) {
 357     print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
 358 }
 359
 360 print "Number of suppressed warnings: $warn\n"  if $warn>0;
 361 print "FYI: The file $input contains $spark_events lines of spark information\n"  if !opt_S && ($spark_events>0);
 362
 363 system "gzip -f1 $RUNNABLE_file"  if $opt_t;
 364 system "gzip -f1 $BLOCKED_file"   if $opt_t;
 365 system "gzip -f1 $FETCHING_file"  if $opt_t;
 366
 367 system "fortune -s"  if $opt_v;
 368
 369 exit 0;
 370
 371 # ----------------------------------------------------------------------------
 372 # This translation is mainly taken from gr2qp.awk
 373 # This subroutine returns the event found on the current line together with
 374 # the relevant information for that event. The possible EVENTS are:
 375 #  START, STARTQ, STOLEN, BLOCK, RESUME, RESUMEQ, END, SCHEDULE
 376 # ----------------------------------------------------------------------------
 377
 378 sub get_line {
 379   local ($line) = @_;
 380   local ($f, @fs);
 381   local ($event, $time, $id, $pe);
 382
 383   @fs = split(/[:\[\]\s]+/,$line);
 384   $event = $fs[3];
 385   $time = $fs[2];
 386   $id = $fs[4];
 387   $pe = $fs[1];
 388
 389   print OUT "% > " . $_   if $opt_D;
 390   print OUT "%   EVENT = $event; TIME = $time; ID = $id; PE = $pe\n" if $opt_D;
 391   print OUT "%   --> this task comes from PE " . ($where{$id}-1) . "\n"  if $opt_D && $event eq "STOLEN";
 392
 393   return ($event, $time, $id, $pe);
 394
 395   # if ($fs[3] eq "START") {
 396   #     partprofile = 0;
 397   #     print (substr($3,2,length($3)-3))," *G 0 0x" $5;
 398   # }
 399   # if ($fs[3] eq "START(Q)") {
 400   #     print (substr($3,2,length($3)-3))," *A 0 0x" $5;
 401   # }
 402
 403  #  if ($fs[3] eq "STOLEN")    {
 404   #     print (substr($3,2,length($3)-3))," AG 0 0x" $5;
 405   # }
 406
 407  #  if ($fs[3] eq "BLOCK")     {
 408   #     print (substr($3,2,length($3)-3))," GR 0 0x" $5;
 409   # }
 410   # if ($fs[3] eq "RESUME")    {
 411   #     print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0";
 412   # }
 413   # if ($fs[3] eq "RESUME(Q)") {
 414   #     print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0";
 415   # }
 416   # if ($fs[3] eq "END")       {
 417   #   if (partprofile) {
 418   #     p rint (substr($9,1,length($9)-1))," *G 0 0x" (substr($5,1,length($5)-1));
 419   #     p rint (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
 420   #   } else {
 421   #       print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
 422   #   }
 423   # }
 424   # if ($fs[3] eq "SCHEDULE")  {
 425   #     print (substr($3,2,length($3)-3))," AG 0 0x" $5;
 426   # }
 427
 428 }
 429
 430 # ----------------------------------------------------------------------------
 431
 432 sub check_consistency {
 433     local ($i);
 434
 435     for ($i=0; $i<$nPEs; $i++) {
 436         if ( $runnable[$i] < 0 ) {
 437             print "INCONSISTENCY: PE $i: Size of runnable queue: $runnable[$i] at time $time\n";
 438             $runnable[$i] = 0 ;
 439         }
 440         if  ( $blocked[$i] < 0 ) {
 441             print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
 442             $blocked[$i] = 0 ;
 443         }
 444     }
 445 }
 446
 447 # ----------------------------------------------------------------------------
 448
 449 sub get_width {
 450     local ($n, $type) = @_;
 451
 452     $warn++   if $n <0;
 453     print "WARNING: Neg. number of tasks in $type queue: $n!!\n"  if $n <0;
 454     $n = 0  if $n <0;
 455     return ( ($type eq $RUNNING) ? ($running_width * $width_unit) :
 456             &min($max_width, $n * $width_unit) );
 457 }
 458
 459 # ----------------------------------------------------------------------------
 460 # Use an intensity between 0 (empty runnable queue) and 1 (`full' runnable
 461 # queue) to abstract from monchrome/color values
 462 # The concrete grayshade/color is computed via PS macros.
 463 # ----------------------------------------------------------------------------
 464
 465 sub get_intensity {
 466     local ($n) = @_;
 467
 468     print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n"  if $n<0;
 469
 470     if ($n >= $inf_block) {
 471         return 1.0;
 472     } else {
 473         return ($n+1)/$inf_block;
 474     }
 475 }
 476
 477 # ----------------------------------------------------------------------------
 478
 479 sub get_sp_intensity {
 480     local ($n) = @_;
 481
 482     print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n"  if $n<0;
 483
 484     if ($n >= $inf_block) {
 485         return 1.0;
 486     } else {
 487         return ($n+1)/$inf_block;
 488     }
 489 }
 490
 491 # ----------------------------------------------------------------------------
 492
 493 sub get_shade {
 494     local ($n) = @_;
 495
 496
 497     if ($n > $inf_block) {
 498         return 0.2;
 499     } else {
 500         return 0.8 - ($n/$inf_block);
 501     }
 502 }
 503
 504 # ----------------------------------------------------------------------------
 505
 506 sub max {
 507     local($x, $y) = @_;
 508
 509     return ($x>$y ? $x : $y);
 510 }
 511
 512 # ----------------------------------------------------------------------------
 513
 514 sub min {
 515     local($x, $y) = @_;
 516
 517     return ($x<$y ? $x : $y);
 518 }
 519
 520 # ----------------------------------------------------------------------------
 521
 522 sub list_sum {
 523     local (@list) = @_;
 524
 525     local ($sum);
 526
 527     foreach $x (@list) {
 528         $sum += $x;
 529     }
 530
 531     return ($sum);
 532 }
 533
 534 # ----------------------------------------------------------------------------
 535 # Drawing functions.
 536 # Put on top of funtions that directly generate PostScript.
 537 # ----------------------------------------------------------------------------
 538
 539 sub draw_segment {
 540     local ($pe, $time, $type) = @_;
 541     local ($x, $y, $width, $gray);
 542
 543     if ( $type eq $BLOCKED ) {
 544         if ( $last_blocked[$pe] == $NO_LAST_BLOCKED ) { return; };
 545         $width = &get_width($blocked[$pe], $type);
 546         if ( $width  == 0 ) { return; };
 547         $y = $stripes_low[$pe] + int($width/2 + 0.5);
 548         $x = $last_blocked[$pe];
 549
 550         if ( $is_very_big ) {
 551             $x = int($x/$shrink_x) + 1;   # rounded up
 552         }
 553
 554         #  $gray = 0.5;  # Ignoring gray level; doesn't change!
 555         do ps_draw_hline(OUT,$x,$y,$time,$width);
 556     } else {
 557         die "ERROR: Unknow type of line: $type in draw segment\n";
 558     }
 559
 560     if ($x < 0 || $y<0) {
 561         die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
 562     }
 563     if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
 564         die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
 565     }
 566 }
 567
 568 # ----------------------------------------------------------------------------
 569
 570 sub draw_tic {
 571     local ($pe, $time, $event) = @_;
 572     local ($x, $y, $lit);
 573
 574     $ystart = $stripes_low[$pe];
 575     $yend = $stripes_high[$pe];
 576     $x = $time;
 577     if ( $event eq "STEALING" ) {
 578         $lit = 0;  # i.e. FROM
 579     } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
 580         $lit = 1;  # i.e. TO
 581     } else {
 582         die "ERROR: Wrong event $event in draw_tic\n";
 583     }
 584
 585     if ( $is_very_big ) {
 586         $x = int($x/$shrink_x) + 1;   # rounded up
 587     }
 588
 589     if ($x < 0 || $ystart<0 || $yend<0) {
 590         die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
 591     }
 592     do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
 593 }
 594
 595 # ----------------------------------------------------------------------------
 596
 597 sub draw_bg {
 598     local ($pe,$time) = @_;
 599     local ($x_start, $x_end, $intensity, $secondary_intensity);
 600
 601     if ( $last_bg[$pe] == $NO_LAST_BG ) {
 602         print OUT "% Omitting BG: NO LAST BG\n" if $opt_D;
 603         return;
 604     }
 605     if ( $running[$pe] == $NO_ID ) {
 606         print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D;
 607         # return;
 608     }
 609     $x_start = $last_bg[$pe];
 610     $x_end = $time;
 611     $intensity = ( $running[$pe] == $NO_ID ?
 612                       0 :
 613                       &get_intensity($runnable[$pe]) );
 614     $secondary_intensity = ( $running[$pe] == $NO_ID ?
 615                                 0 :
 616                                 &get_intensity($fetching[$pe]) );
 617     do ps_draw_bg(OUT,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
 618                   $intensity,$secondary_intensity);
 619
 620     if ( $opt_M ) {
 621         do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end,
 622                          $mig_width);
 623     }
 624
 625 }
 626
 627 # ----------------------------------------------------------------------------
 628 # Variant of draw_bg; used for spark profile
 629 # ----------------------------------------------------------------------------
 630
 631 sub draw_sp_bg {
 632     local ($pe,$time) = @_;
 633     local ($x_start, $x_end, $intensity, $secondary_intensity);
 634
 635     if ( $last_sp_bg[$pe] == $NO_LAST_BG ) {
 636         print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D;
 637         return;
 638     }
 639     $x_start = $last_sp_bg[$pe];
 640     $x_end = $time;
 641     $intensity = ( $sparks[$pe] <= 0 ?
 642                       0 :
 643                       &get_sp_intensity($sparks[$pe]) );
 644     $secondary_intensity = 0;
 645     do ps_draw_bg(OUT_SP,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
 646                   $intensity,$secondary_intensity);
 647
 648 }
 649
 650 # ----------------------------------------------------------------------------
 651
 652 sub draw_arrow {
 653     local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
 654     local ($ystart,$yend);
 655
 656     $ystart = $stripes_high[$from_pe];
 657     $yend = $stripes_low[$to_pe];
 658     do ps_draw_arrow(OUT_MIG,$send_time,$arrive_time,$ystart,$yend);
 659 }
 660
 661 # ----------------------------------------------------------------------------
 662 # Normalize the x value s.t. it fits onto the page without scaling.
 663 # The global values $left_border and $right_border and $total_width
 664 # determine the borders
 665 # of the graph.
 666 # This fct is only called from within ps_... fcts. Before that the $x values
 667 # are always times.
 668 # ----------------------------------------------------------------------------
 669
 670 sub normalize {
 671     local ($x) = @_;
 672
 673     return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
 674 }
 675
 676 # ----------------------------------------------------------------------------
 677 # PostScript generation functions.
 678 # Lowest level of writing output file.
 679 # Now there is only normalizing mode supported.
 680 # The following is out of date:
 681 # $mode can be $LITERATE i.e. assuming scaling has been done
 682 #           or $NORMALIZING i.e. no scaling has been done so far (do it in
 683 #                                macros for drawing)
 684 # ----------------------------------------------------------------------------
 685
 686 sub ps_draw_hline {
 687     local ($OUT,$xstart,$y,$xend,$width) = @_;
 688     local ($xlen);
 689
 690     print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D;
 691
 692     if ( ! $opt_N ) {
 693         $xstart = &normalize($xstart);
 694         $xend = &normalize($xend);
 695     }
 696
 697     $xlen = $xend - $xstart;
 698
 699     printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
 700     #           ( $mode == $LITERATE ? " L\n" : " N\n");
 701
 702     # Old version:
 703     # print $OUT "newpath\n";
 704     # print $OUT "$GRAY{$type} setgray\n";
 705     # print $OUT $xend . "  " . $y . " " . $xstart . " " . $y . " " . $width .
 706     #    " line\n";
 707     # print $OUT "stroke\n";
 708 }
 709
 710 # ----------------------------------------------------------------------------
 711
 712 sub ps_draw_vline {
 713     local ($OUT,$x,$ystart,$yend,$width) = @_;
 714
 715     print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D;
 716
 717     if ( ! $opt_N ) {
 718         $x = &normalize($x);
 719     }
 720
 721     print $OUT "newpath\n";
 722     print $OUT "0 setgray\n";                             # constant gray level
 723     printf $OUT ("%d %d %d %d %.1g line\n",
 724                  $x,$yend ,$x,$ystart,$width);
 725     print $OUT "stroke\n";
 726 }
 727
 728 # ----------------------------------------------------------------------------
 729
 730 sub ps_draw_tic {
 731     local ($OUT,$x,$ystart,$yend,$lit) = @_;
 732
 733     print $OUT "% TIC at ($x,$ystart-$yend)\n"   if $opt_D;
 734
 735     if ( ! $opt_N ) {
 736         $x = &normalize($x);
 737     }
 738
 739     printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);
 740
 741     # Old version without PostScript macro /tic:
 742     # print $OUT "newpath\n";
 743     # print $OUT "ticwidth setlinewidth\n" .
 744     #         $x . " " . $y . " ticlen sub moveto\n" .
 745     #         $x . " " . $y . " ticlen add lineto\n";
 746     #print $OUT "stroke\n";
 747 }
 748
 749 # ----------------------------------------------------------------------------
 750
 751 sub ps_draw_arrow {
 752     local ($OUT,$xstart,$xend,$ystart,$yend) = @_;
 753
 754     print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n"   if $opt_D;
 755
 756     if ( ! $opt_N ) {
 757         $xstart = &normalize($xstart);
 758         $xend = &normalize($xend);
 759     }
 760
 761     printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
 762 }
 763
 764 # ----------------------------------------------------------------------------
 765
 766 sub ps_draw_bg {
 767     local ($OUT,$xstart, $xend, $ystart, $yend,
 768            $intensity, $secondary_intensity) = @_;
 769     local ($xlen, $ylen);
 770
 771     print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
 772                "  (intensity: $intensity, $secondary_intensity)\n"  if $opt_D;
 773
 774     if ( ! $opt_N ) {
 775         $xstart = &normalize($xstart);
 776         $xend = &normalize($xend);
 777     }
 778
 779     $xlen = $xend - $xstart;
 780     $ylen = $yend - $ystart;
 781
 782     printf $OUT ("%d %d %d %d %.2g %.2g R\n",
 783                  $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);
 784
 785     # Old version without PostScript macro /rect:
 786     #print $OUT "newpath\n";
 787     #print $OUT " $x_start $y_start moveto\n";
 788     #print $OUT " $x_end $y_start lineto\n";
 789     #print $OUT " $x_end $y_end lineto\n";
 790     #print $OUT " $x_start $y_end lineto\n";
 791     #print $OUT "closepath\n";
 792     #print $OUT "$gray setgray\n";
 793     #print $OUT "fill\n";
 794 }
 795
 796 # ----------------------------------------------------------------------------
 797 # Initialization and such
 798 # ----------------------------------------------------------------------------
 799
 800 sub write_prolog {
 801     local ($OUT, $x_max, $y_max) = @_;
 802     local ($date, $dist, $y, $i);
 803
 804     $date = &get_date();
 805
 806     if ( $opt_N ) {
 807       $x_scale = $total_width/$x_max;
 808       $y_scale = $total_height/$y_max;
 809     }
 810
 811     # $tic_width = 2 * $x_max/$total_width;    constant now
 812     # $tic_len = 4 * $y_max/$total_height;
 813
 814     print $OUT "%!PS-Adobe-2.0\n";
 815     print $OUT "%%BoundingBox:   \t0 0 560 800\n";
 816     print $OUT "%%Title: \t$pname  $pars\n";
 817     print $OUT "%%Creator: \tgr2pe\n";
 818     print $OUT "%%CreationDate: \t$date\n";
 819     # print $OUT "%%Orientation: \tSeascape\n";
 820     print $OUT "%%EndComments\n";
 821
 822     # print $OUT "%%BeginSetup\n";
 823     # print $OUT "%%PageOrientation: \tSeascape\n";
 824     # print $OUT "%%EndSetup\n";
 825
 826     print $OUT "%/runlineto {1.5 setlinewidth lineto} def\n";
 827     print $OUT "%/suspendlineto {0.5 setlinewidth lineto} def\n";
 828     print $OUT "%/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n";
 829     print $OUT "%/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n";
 830     print $OUT "\n";
 831     print $OUT "/total-len $x_max def\n";
 832     print $OUT "/show-len $total_width def\n";
 833     print $OUT "/normalize { show-len mul total-len div } def\n";
 834     print $OUT "/x-normalize { exch show-len mul total-len div exch } def\n";
 835     print $OUT "/str-len 12 def\n";
 836     #print $OUT "/prt-n { str-len string cvs show } def" .
 837     #          "     % print top-of-stack integer\n";
 838     print $OUT "/prt-n { cvi str-len string cvs \n" .
 839                "         dup stringwidth pop \n" .
 840                "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
 841                "         neg 0 rmoveto \n" .
 842                "         show  } def \n" .
 843                "        % print top-of-stack integer centered at the current point\n";
 844     print $OUT "/ticwidth $tic_width def\n";
 845     print $OUT "%/ticlen $tic_len def     % actually half of the tic-length\n";
 846     print $OUT "/T    % Draw a tic mark\n" .
 847                " {    % Operands: x, y-start, y-end of tic, from/to flag \n" .
 848                "   newpath\n" .
 849                "   0 eq { " . ( $opt_m ? " 0.2 setgray }"
 850                                        : " 0 0.7 0.2 setrgbcolor }" ) .
 851                "        { " . ( $opt_m ? " 0.8 setgray }"
 852                                        : " 0.7 0 0.2 setrgbcolor }" ) . " ifelse\n" .
 853                "   ticwidth setlinewidth\n" .
 854                "   3 copy pop moveto\n" .
 855                "   exch pop lineto\n" .
 856                "   stroke\n" .
 857                " } def\n";
 858     #          "   3 copy pop x-normalize moveto\n" .
 859     #          "   exch pop x-normalize lineto\n" .
 860     #          "   stroke\n" .
 861     #          " } def\n";
 862     print $OUT "/blocked-gray 0 def\n";
 863     print $OUT "/idle-gray 1 def\n";
 864     print $OUT "/blocked-color { 0.2 0.1 0.8 } def\n";
 865     print $OUT "/idle-color { 0.8 0.1 0.2 } def\n";
 866     print $OUT "/idle-color-fetch { 0.5 0.6 0.4 } def\n";
 867     print $OUT "/L              % Draw a line (for blocked tasks)\n" .
 868                " {              % Operands: (x,y)-start xlen width\n" .
 869                "  newpath \n" .
 870                ( $opt_m ? "  blocked-gray setgray\n" :
 871                           "  blocked-color setrgbcolor\n") .
 872                "         setlinewidth 3 copy pop moveto 0 rlineto pop pop stroke} def\n";
 873     print $OUT "/N              % Draw a normalized line\n" .
 874                " {              % Operands: (x,y)-start xlen width\n" .
 875                "  newpath \n" .
 876                ( $opt_m ? "  blocked-gray setgray\n" :
 877                           "  blocked-color setrgbcolor\n") .
 878                "         setlinewidth 3 copy pop x-normalize moveto normalize 0 rlineto pop pop stroke} def\n";
 879     print $OUT "% /L line def\n";
 880     print $OUT "/printText { 0 0 moveto (GrAnSim) show } def\n";
 881     if ( $opt_m ) {
 882         print $OUT "/logo { gsave \n" .
 883                    "        translate \n" .
 884                    "        .95 -.05 0  " .
 885                    "          { setgray printText 1 -.5 translate } for \n" .
 886                    "        1 setgray printText\n" .
 887                    "        grestore } def\n";
 888     } else {
 889         print $OUT "/logo { gsave \n" .
 890               "        translate \n" .
 891               "        .95 -.05 0\n" .
 892               "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
 893               "        1 0 0 setrgbcolor printText\n" .
 894               "        grestore} def\n";
 895     }
 896
 897     print $OUT "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
 898     print $OUT  "/starside \n" .
 899                 " {starlen 0 lineto currentpoint translate \n" .
 900                 "    -144 rotate } def\n";
 901
 902    print $OUT  "/star \n" .
 903                " { moveto \n" .
 904                "   currentpoint translate \n" .
 905                "   4 {starside} repeat \n" .
 906                "   closepath \n" .
 907                "   gsave \n" .
 908                "   .7 setgray fill \n" .
 909                "   grestore \n" .
 910                "   % stroke  \n" .
 911                "  } def \n";
 912     #print $OUT "/get-shade   % compute shade from intensity\n" .
 913     #              " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
 914     if ( $opt_m ) {
 915         print $OUT "/from 0.2 def\n";
 916         print $OUT "/to 0.8 def\n";
 917         print $OUT "/get-shade   % compute shade from intensity\n" .
 918                    "  { pop dup 0 eq { pop idle-gray }\n " .
 919                    "                 { 1 exch sub to from sub mul from add } ifelse } def\n";
 920                    " { pop 1 exch sub to from sub mul from add } def\n";
 921     } else {
 922         print $OUT "/from 0.5 def\n";
 923         print $OUT "/to 0.9 def\n";
 924     }
 925     print $OUT "/epsilon 0.01 def\n";
 926     print $OUT "/from-blue 0.7 def\n";
 927     print $OUT "/to-blue   0.95 def\n";
 928     print $OUT "/m 1 def\n";
 929     print $OUT "/magnify { m mul dup 1 gt { pop 1 } if } def\n";
 930     print $OUT "%\n" .
 931                "% show no. of runnable threads and the current degree of fetching\n" .
 932                "%\n" .
 933                "/get-color        % compute color from intensity\n" .
 934                " { 4 mul dup      % give more weight to second intensity\n" .
 935                "   0 eq { pop 0 exch } \n" .
 936                "        { from-blue to-blue sub mul from-blue add dup \n" .
 937                "          1 gt { pop 1 } if  exch } ifelse \n" .
 938                "   dup 0 eq { pop pop idle-color }\n" .
 939                "            { 1 exch sub to from sub mul from add        % green val is top of stack\n" .
 940                "              exch 0 3 1 roll  } ifelse } def\n";
 941
 942     print $OUT "%\n";
 943     print $OUT "% show no. of runable threads only\n";
 944     print $OUT "%\n";
 945     print $OUT "/get-color-runnable                     % compute color from intensity\n";
 946     print $OUT "{ pop dup 0 eq { pop idle-color }\n";
 947     print $OUT "               { 1 exch sub to from sub mul from add   % green val is top of stack\n";
 948     print $OUT "                 0.2 0 3 1 roll  } ifelse } def\n";
 949
 950     print $OUT "%\n";
 951     print $OUT "% show no. of fetching threads only\n";
 952     print $OUT "%\n";
 953     print $OUT "/get-color-fetch                        % compute color from intensity\n";
 954     print $OUT "{ exch pop dup 0 eq { pop idle-color-fetch }\n";
 955     print $OUT "                    { 1 exch sub to from sub mul from add   % blue val is top of stack\n";
 956     print $OUT "                      0.2 0.6 3 2 roll  } ifelse } def\n";
 957
 958     #print $OUT "/get-color    % compute color from intensity\n" .
 959     #           " { dup 0 eq { pop idle-color }\n" .
 960     #           "            { 1 exch sub to from sub mul from add 0 exch 0 } ifelse } def\n";
 961     #          " { dup 0.4 le { 0.4 exch sub 0.2 add 2 mul 0 0 setrgbcolor} " .
 962     #          "              { 1 exch sub 0.4 add 0 exch 0 setrgbcolor} ifelse \n" .
 963     print $OUT "/R          % Draw a rectangle \n" .
 964                " {             % Operands: x y xlen ylen i j \n" .
 965                "               %    (x,y) left lower start point of rectangle\n" .
 966                "               %    xlen  length of rec in x direction\n" .
 967                "               %    ylen  length of rec in y direction\n" .
 968                "               %    i     intensity of rectangle [0,1] \n" .
 969                "               %    j     intensity blue to indicate fetching\n" .
 970                "               %          (ignored in mono mode)\n" .
 971                ( $opt_m ? "  get-shade setgray\n"
 972                         : "  get-color-runnable setrgbcolor\n" ) .
 973                "  newpath\n" .
 974                "  4 copy pop pop moveto\n" .
 975                "  1 index  0 rlineto\n" .
 976                "  0 index  0 exch rlineto\n" .
 977                "  1 index  neg 0 rlineto\n" .
 978                "  0 index  neg 0 exch rlineto\n" .
 979                "  pop pop pop pop\n" .
 980                "  closepath\n" .
 981                "  fill             % Note: No stroke => no border\n" .
 982                " } def\n";
 983     print $OUT "% /R rect def\n";
 984     print $OUT "%/A         % Draw an arrow (for migration graph)\n" .
 985                "% {         % Operands: x y x' y' \n" .
 986                "%           %  (x,y)    start point \n" .
 987                "%           %  (x',y')  end point \n" .
 988                ( $opt_m ? "%    0 setgray\n" : "%     0 0 0 setrgbcolor\n" ) .
 989                "%  1 setlinewidth\n" .
 990                "%  newpath 4 2 roll x-normalize moveto x-normalize lineto stroke } def\n";
 991
 992     print $OUT "/A         % No arrows \n" .
 993                " { pop pop pop pop } def\n";
 994     print $OUT "-90 rotate\n";
 995
 996     print $OUT "-785 30 translate\n";
 997     print $OUT "/HE10 /Helvetica findfont 10 scalefont def\n";
 998     print $OUT "/HE12 /Helvetica findfont 12 scalefont def\n";
 999     print $OUT "/HE14 /Helvetica findfont 14 scalefont def\n";
1000     print $OUT "/TI16 /Times-Italic findfont 16 scalefont def\n";
1001     print $OUT "/HB16 /Helvetica-Bold findfont 16 scalefont def\n";
1002     print $OUT "% " . "-" x 77 . "\n";
1003
1004     print $OUT "newpath\n";
1005     print $OUT "0 8.000000 moveto\n";
1006     print $OUT "0 525.000000 760.000000 525.000000 8.000000 arcto\n";
1007     print $OUT "4 {pop} repeat\n";
1008     print $OUT "760.000000 525.000000 760.000000 0 8.000000 arcto\n";
1009     print $OUT "4 {pop} repeat\n";
1010     print $OUT "760.000000 0 0 0 8.000000 arcto\n";
1011     print $OUT "4 {pop} repeat\n";
1012     print $OUT "0 0 0 525.000000 8.000000 arcto\n";
1013     print $OUT "4 {pop} repeat\n";
1014     print $OUT "0.500000 setlinewidth\n";
1015     print $OUT "stroke\n";
1016     print $OUT "newpath\n";
1017     print $OUT "4.000000 505.000000 moveto\n";
1018     print $OUT "4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n";
1019     print $OUT "4 {pop} repeat\n";
1020     print $OUT "752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n";
1021     print $OUT "4 {pop} repeat\n";
1022     print $OUT "752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n";
1023     print $OUT "4 {pop} repeat\n";
1024     print $OUT "4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n";
1025     print $OUT "4 {pop} repeat\n";
1026     print $OUT "0.500000 setlinewidth\n";
1027     print $OUT "stroke\n";
1028
1029     print $OUT "% ----------------------------------------------------------\n";
1030     print $OUT "% Print pallet\n";
1031     print $OUT "% NOTE: the values for the tics must correspond to start and\n";
1032     print $OUT "%       end values in /get-color\n";
1033     print $OUT "gsave \n";
1034     print $OUT "340 508 translate\n";
1035     print $OUT "0.0 0.05 1.00 \n";
1036     print $OUT " { \n";
1037     print $OUT "  dup dup \n";
1038     print $OUT "    from epsilon sub gt exch \n";
1039     print $OUT "    from epsilon add lt \n";
1040     print $OUT "   and\n";
1041     print $OUT "    { newpath " .
1042                ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
1043                "0 0 moveto 0 -3 rlineto stroke } if\n";
1044     print $OUT "  dup dup \n";
1045     print $OUT "    to epsilon 2 mul sub gt exch \n";
1046     print $OUT "    to epsilon 2 mul add lt \n";
1047     print $OUT "   and\n";
1048     print $OUT "    { newpath " .
1049                ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
1050                "10 0 moveto 0 -3 rlineto stroke } if\n";
1051     print $OUT ($opt_m ? " setgray\n" : "  0 exch 0 setrgbcolor\n");
1052     print $OUT "  newpath\n";
1053     print $OUT "  0 0 moveto\n";
1054     print $OUT "  10 0 rlineto\n";
1055     print $OUT "  0 10  rlineto\n";
1056     print $OUT "  -10 0 rlineto\n";
1057     print $OUT "  closepath\n";
1058     print $OUT "  fill\n";
1059     print $OUT "  10 0 translate \n";
1060     print $OUT " } for\n";
1061     print $OUT "grestore\n";
1062
1063     print $OUT "% Print pallet for showing fetch\n";
1064     print $OUT "% NOTE: the values for the tics must correspond to start and\n";
1065     print $OUT "%       end values in /get-color\n";
1066     print $OUT "%gsave \n";
1067     print $OUT "%340 508 translate\n";
1068     print $OUT "%0.0 0.05 1.00 \n";
1069     print $OUT "%{ \n";
1070     print $OUT "%  dup dup \n";
1071     print $OUT "%    from epsilon sub gt exch \n";
1072     print $OUT "%    from epsilon add lt \n";
1073     print $OUT "%   and\n";
1074     print $OUT "%   { newpath 0 0 0 setrgbcolor 0 0 moveto 0 -3 rlineto stroke } if\n";
1075     print $OUT "%  dup dup \n";
1076     print $OUT "%    to epsilon 2 mul sub gt exch \n";
1077     print $OUT "%    to epsilon 2 mul add lt \n";
1078     print $OUT "%   and\n";
1079     print $OUT "%   { newpath 0 0 0 setrgbcolor 10 0 moveto 0 -3 rlineto stroke } if\n";
1080     print $OUT "%  0.2 exch 0.6 exch setrgbcolor   \n";
1081     print $OUT "%  newpath\n";
1082     print $OUT "%  0 0 moveto\n";
1083     print $OUT "%  10 0 rlineto\n";
1084     print $OUT "%  0 10  rlineto\n";
1085     print $OUT "%  -10 0 rlineto\n";
1086     print $OUT "%  closepath\n";
1087     print $OUT "%  fill\n";
1088     print $OUT "%  10 0 translate \n";
1089     print $OUT "% } for\n";
1090     print $OUT "% grestore\n";
1091
1092     print $OUT "% Print double pallet\n";
1093     print $OUT "% NOTE: the values for the tics must correspond to start and\n";
1094     print $OUT "%       end values in /get-color\n";
1095     print $OUT "% gsave \n";
1096     print $OUT "% 340 500 translate\n";
1097     print $OUT "% 0.0 0.05 1.00 \n";
1098     print $OUT "% { \n";
1099     print $OUT "%   0 exch 0 setrgbcolor   \n";
1100     print $OUT "%   newpath\n";
1101     print $OUT "%   0 0 moveto\n";
1102     print $OUT "%   10 0 rlineto\n";
1103     print $OUT "%   0 10  rlineto\n";
1104     print $OUT "%   -10 0 rlineto\n";
1105     print $OUT "%   closepath\n";
1106     print $OUT "%   fill\n";
1107     print $OUT "%   10 0 translate \n";
1108     print $OUT "% } for\n";
1109     print $OUT "% grestore\n";
1110     print $OUT "% gsave \n";
1111     print $OUT "% 340 510 translate\n";
1112     print $OUT "% 0.0 0.05 1.00 \n";
1113     print $OUT "% { \n";
1114     print $OUT "%   dup dup \n";
1115     print $OUT "%     from epsilon sub gt exch \n";
1116     print $OUT "%     from epsilon add lt \n";
1117     print $OUT "%    and\n";
1118     print $OUT "%    { newpath 0 0 0 setrgbcolor 0 3 moveto 0 -6 rlineto stroke } if\n";
1119     print $OUT "%   dup dup \n";
1120     print $OUT "%     to epsilon 2 mul sub gt exch \n";
1121     print $OUT "%     to epsilon 2 mul add lt \n";
1122     print $OUT "%    and\n";
1123     print $OUT "%    { newpath 0 0 0 setrgbcolor 10 3 moveto 0 -6 rlineto stroke } if\n";
1124     print $OUT "%    0.7 exch 0 setrgbcolor   \n";
1125     print $OUT "%    newpath\n";
1126     print $OUT "%    0 0 moveto\n";
1127     print $OUT "%    10 0 rlineto\n";
1128     print $OUT "%    0 10  rlineto\n";
1129     print $OUT "%    -10 0 rlineto\n";
1130     print $OUT "%    closepath\n";
1131     print $OUT "%    fill\n";
1132     print $OUT "%    10 0 translate \n";
1133     print $OUT "% } for\n";
1134     print $OUT "% grestore\n";
1135     print $OUT "% ----------------------------------------------------------\n";
1136     print $OUT "HE14 setfont\n";
1137     print $OUT "100.000000 508.000000 moveto\n";
1138     print $OUT "($pname  PEs: $nPEs  Lat.: $lat ) show\n";
1139
1140     print $OUT "($date) dup stringwidth pop 750.000000 exch sub 508.000000 moveto show\n";
1141     print $OUT ( $opt_m ? "5 512 asciilogo\n" : "5 512 logo\n");
1142     print $OUT "% 100 500 moveto\n";
1143
1144     print $OUT "0 20 translate\n";
1145
1146     print $OUT "HE14 setfont\n";
1147     for ($i=0; $i<$nPEs; $i++) {
1148         $dist = $stripes_high[$i] - $stripes_low[$i];
1149         $y = $stripes_low[$i] + $dist/2;
1150         # print $OUT "/starlen $dist def\n";
1151         # print $OUT "gsave 2 $y star grestore\n";
1152         print $OUT "  2 " . ($stripes_low[$i]+1) . " moveto ($i) show\n";
1153     }
1154
1155     print $OUT "20 0 translate\n";
1156
1157     print $OUT "% Print x-axis:\n";
1158     print $OUT "1 setlinewidth\n";
1159     print $OUT "0 -5 moveto total-len normalize 0 rlineto stroke\n";
1160     print $OUT "gsave\n" .
1161                "[2 4] 1 setdash\n" .
1162                "0 0 moveto 0 $total_height rlineto stroke\n" .
1163                "% $x_max 0 moveto 0 $total_height rlineto stroke\n" .
1164                "grestore\n";
1165     print $OUT "0 total-len 10 div total-len\n" .
1166                " { dup normalize dup -5 moveto 0 -2 rlineto stroke  % tic\n" .
1167                "   -17 moveto HE10 setfont round prt-n  % print label \n" .
1168                " } for \n";
1169
1170
1171     print $OUT "$x_scale  $y_scale  scale\n";
1172
1173     print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
1174
1175     if ( $opt_D ) {
1176         print $OUT "% Debugging info : \n";
1177
1178         print $OUT "% Offset is: $offset\n";
1179
1180         print $OUT "% y_val table: \n";
1181         for ($i=0; $i<$nPEs; $i++) {
1182             print $OUT "% y_val of $i: $y_val[$i]\n";
1183         }
1184
1185         print $OUT "% x-max: $x_max; y-max: $y_max\n";
1186         print $OUT "% Info from header: Prg: $pname; PEs: $nPEs; Lat.: $lat\n";
1187
1188         print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
1189     }
1190 }
1191
1192 # ----------------------------------------------------------------------------
1193
1194 sub write_epilog {
1195     local ($OUT,$x_max, $y_max) = @_;
1196     local($x_scale,$y_scale);
1197
1198     print $OUT "showpage\n";
1199 }
1200
1201 # ----------------------------------------------------------------------------
1202
1203 sub get_x_max {
1204     local ($file) = @_;
1205     local ($last_line, @fs);
1206
1207     open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
1208     while (<TMP>) {
1209         $last_line = $_;
1210     }
1211     close(TMP);
1212
1213     @fs = split(/[:\[\]\s]+/,$last_line);
1214
1215     return $fs[2];
1216 }
1217
1218 # ----------------------------------------------------------------------------
1219 #
1220 #sub get_date {
1221 #    local ($now,$today,@lt);
1222 #
1223 #    @lt = localtime(time);
1224 #    $now = join(":",reverse(splice(@lt,0,3)));
1225 #    $today = join(".",splice(@lt,0,3));
1226 #
1227 #    return $now . " on " . $today;
1228 #}
1229 #
1230 # ----------------------------------------------------------------------------
1231
1232 sub get_date {
1233     local ($date);
1234
1235     open (DATE,"date |") || die ("$!");
1236     while (<DATE>) {
1237         $date = $_;
1238     }
1239     close (DATE);
1240
1241     return ($date);
1242 }
1243
1244 # -----------------------------------------------------------------------------
1245
1246 sub generate_y_val_table {
1247     local ($nPEs) = @_;
1248     local($i, $y, $dist);
1249
1250     $dist = int($total_height/$nPEs);
1251     for ($i=0, $y=1; $i<$nPEs; $i++, $y+=$dist) {
1252         $y_val[$i] = $y + $lower_border;
1253         $stripes_low[$i] = $y;
1254         $stripes_high[$i] = $y+$dist-2;
1255     }
1256
1257     # print $OUT "10 5 translate\n";
1258
1259     return ($dist);
1260 }
1261
1262 # ----------------------------------------------------------------------------
1263
1264 sub init {
1265     local ($nPEs) = @_;
1266     local($i);
1267
1268     for ($i=0; $i<$nPEs; $i++) {
1269         if ( $opt_S ) {
1270             $sparks[$i] = 0;
1271         }
1272         $blocked[$i] = 0;
1273         $runnable[$i] = 0;
1274         $fetching[$i] = 0;
1275         $running[$i] = $NO_ID;
1276         if ( $opt_S ) {
1277             $last_sp_bg[$i] = $NO_LAST_BG;
1278         }
1279         $last_bg[$i] = $NO_LAST_BG;
1280         $last_start[$i] = $NO_LAST_START;
1281         $last_blocked[$i] = $NO_LAST_BLOCKED;
1282         $last_runnable[$i] = 0;
1283         #open($OUT_RA[$i], "PE". $i . ".dat") || die "PE".$i."-R.dat: $!\n";
1284         #print $OUT_RA[$i] "# Number of Runnable tasks on PE $i\n";
1285         #open($OUT_BA[$i], "PE". $i . ".dat") || die "PE".$i."-B.dat: $!\n";
1286         #print $OUT_BA[$i] "# Number of Blocked tasks on PE $i\n";
1287     }
1288
1289 }
1290
1291
1292 # ----------------------------------------------------------------------------
1293
1294 sub skip_header {
1295     local ($FILE) = @_;
1296     local($prg, $pars, $nPEs, $lat, $fetch, $in_header);
1297
1298     $in_header = 9;
1299     while (<$FILE>) {
1300         if ( $in_header = 9 ) {
1301             if (/^=/) {
1302                 $gum_style_gr = 1;
1303                 $in_header = 0;
1304                 $prg = "????";          #
1305                 $pars = "-b??????";             #
1306                 $nPEs = $opt_p ? $opt_p : 1; #
1307                 $lat = $opt_l ? $opt_l : 1;
1308                 return ($prg, $pars, $nPEs, $lat);
1309             } else {
1310                 $gum_style_gr = 0;
1311                 $in_header = 1;
1312             }
1313
1314         }
1315         $prg = $1, $pars = $2   if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
1316         $nPEs = $1              if /^PEs\s+(\d+)/;
1317         $lat = $1, $fetch = $2  if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
1318         die "Can't process GranSim-Light profiles!\n"  if /^GrAnSim-Light$/i;
1319
1320         last             if /^\+\+\+\+\+/;
1321     }
1322
1323     return ($prg, $pars, $nPEs, $lat);
1324 }
1325
1326 # ----------------------------------------------------------------------------
1327
1328 sub process_options {
1329
1330     if ( $opt_h ) {
1331         open(ME,$0) || die "Can't open myself ($0): $!\n";
1332         $n = 0;
1333         while (<ME>) {
1334             last if $_ =~ /^$/;
1335             print $_;
1336             $n++;
1337         }
1338         close(ME);
1339         exit ;
1340     }
1341
1342     if ( $#ARGV != 0 ) {
1343         print "Usage: $0 [options] <gr-file>\n";
1344         print "Use -h option to get details\n";
1345         exit 1;
1346     }
1347
1348     $input = $ARGV[0] ;
1349     $input =~ s/\.gr//;
1350     $input .= ".gr";
1351
1352     if ( $opt_o ) {
1353         ($output   = $opt_o) =~ s/\.ps// ;
1354         $output_b = $output . "_peb.ps";
1355         $output_r = $output . "_per.ps";
1356         $output_mig = $output . "_mig.ps" if $opt_M;
1357         $output_sp = $output . "_sp.ps"   if $opt_S;
1358         $output   = $output . "_pe.ps";
1359         #($output_b = $opt_o) =~ s/\./-b./ ;
1360         #($output_r = $opt_o) =~ s/\./-r./ ;
1361         #($output_mig = $opt_o) =~ s/\./-mig./  if $opt_M;
1362         #($output_sp = $opt_o) =~ s/\./-sp./  if $opt_S;
1363     } else {
1364         ($output = $input) =~ s/\.gr// ;
1365         $output_b = $output . "_peb.ps";
1366         $output_r = $output . "_per.ps";
1367         $output_mig = $output . "_mig.ps" if $opt_M;
1368         $output_sp = $output . "_sp.ps"   if $opt_S;
1369         $output   = $output . "_pe.ps";
1370     }
1371
1372     if ( $opt_v ){
1373         $verbose = 1;
1374     }
1375
1376     if ( $opt_i ) {
1377         $inf_block = $opt_i;
1378     } else {
1379         $inf_block = 20;
1380     }
1381
1382     $RUNNABLE_file = $input;
1383     $RUNNABLE_file =~ s/\.gr//;
1384     $RUNNABLE_file .= "-R";
1385
1386     $BLOCKED_file = $input;
1387     $BLOCKED_file =~ s/\.gr//;
1388     $BLOCKED_file .= "-B";
1389
1390     $FETCHING_file = $input;
1391     $FETCHING_file =~ s/\.gr//;
1392     $FETCHING_file .= "-F";
1393 }
1394
1395 # ----------------------------------------------------------------------------
1396
1397 sub print_verbose_message {
1398
1399     print "Input file: $input\n";
1400     print "Output files: $output, $output_b, $output_r; ".
1401           ($opt_M ? "Migration: $output_mig" : "") .
1402           ($opt_S ? "Sparks: $output_sp" : "") .
1403           "\n";
1404 }
1405
1406 # ----------------------------------------------------------------------------
1407 # Junk from draw_segment:
1408 #
1409 #    if ( $type eq $RUNNING ) {
1410 #       die "ERROR: This version should never draw a RUNNING segment!";
1411 #       $y = $y_val[$pe];
1412 #       $x = $last_start[$pe];
1413 #       $width = &get_width(0, $type);
1414 #       # $gray = 0;
1415 #
1416 #       if ( $is_very_big ) {
1417 #           $x = int($x/$shrink_x) + 1;   # rounded up
1418 #       }
1419 #
1420 #       do ps_draw_hline(OUT_B,$x,$y,$time,$width);
1421 #       do ps_draw_hline(OUT_R,$x,$y,$time,$width);
1422 #
1423 #    } elsif ( $type eq $RUNNABLE ) {
1424 #       die "ERROR: This version should never draw a RUNNABLE segment (shades are used instead)!";
1425 #       $y = $y_val[$pe] + $offset;
1426 #       $x = $last_runnable[$pe];
1427 #       $width = &get_width($runnable[$pe], $type);
1428 #
1429 #       if ( $is_very_big ) {
1430 #           $x = int($x/$shrink_x) + 1;   # rounded up
1431 #       }
1432 #
1433 #       # $gray = 0.5;
1434 #       do ps_draw_hline(OUT_R,$x,$y,$time,$width);