#!/usr/bin/perl
#!/usr/bin/perl 
#                                       (C) Hans Wolfgang Loidl, November 1994
# ############################################################################
# Time-stamp: <Wed Nov 22 2000 03:37:23 Stardate: [-30]5765.75 hwloidl>
#
# Usage: gr2pe [options] <gr-file>
#
# Create per processor activity profile (as ps-file) from a given gr-file.
# 
# Options:
#  -o <file> ... output file (ps file) has name <file>
#  -m        ... produce monochrome output
#  -M        ... produce a migration graph
#  -S        ... produce a spark graph in a separate file (based on the no. of
#                sparks rather than the no. of runnable threads)
#  -t        ... produce trace of runnable, blocked, fetching threads 
#  -i <n>    ... ``infinity'' for number of blocked tasks (default: 20)
#                all values larger than that are shown with the same width
#  -C        ... do consistency check at each event (mainly for debugging)
#  -h        ... print help message (this text)
#  -v        ... be talkative
#  
# ############################################################################

# ----------------------------------------------------------------------------
# Command line processing and initialization
# ----------------------------------------------------------------------------

require "getopts.pl";

&Getopts('hvDCMNmSGti:o:l:p:');  

do process_options();

if ( $opt_v ) {
    do print_verbose_message();
}

if ( $opt_C ) {
  print STDERR "Consistency checking is enabled\n";
}

# ----------------------------------------------------------------------------
# Global Variables
# ----------------------------------------------------------------------------

$RUNNING = "RUNNING";
$RUNNABLE = "RUNNABLE";
$BLOCKED = "BLOCKED";
$START = "START";
$END = "END";

# Modes for hline
#$LITERATE = 1;
#$NORMALIZING = 2;

%GRAY = (
	 $RUNNING, 0.6,
	 $RUNNABLE, 0.3,
	 $BLOCKED, 0,
	 $START, 0,
	 $END, 0.5);

# Special value showing that no task is running on $pe if in $running[$pe] 
$NO_ID = -1;
$NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;

# The number of PEs we have
$nPEs = 32;

# Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
$width_unit = 1; 

# Width of line for RUNNING 
$running_width = 1;

# Offset of BLOCKED and RUNNABLE lines from the center line
$offset = 10;

# Left and right border of the picture; Width of the picture
$left_border = 0;
$right_border = 700;
$total_width = $right_border - $left_border;
$x_scale = 1;

# Height of the picture measured from y-val of first to y-val of last PE
$lower_border = 10;
$upper_border = 490;
$total_height = $upper_border - $lower_border;
$y_scale = 1;

# Constant from where shrinking of x-values (+scaling as usual) is enabled
$very_big = 1E8;

# Factor by which the x values are shrunk (if very big)
$shrink_x = 10000;

# Set format of output of numbers
$# = "%.2g";

# Width of stripes in migration graph
$tic_width = 2;

# If no spark profile should be generate we count the number of spark events
# in the profile to inform the user about existing spark information
if ( !$opt_S ) {
    $spark_events = 0;
}

# ----------------------------------------------------------------------------
# The real thing starts here
# ----------------------------------------------------------------------------

open (IN,"<$input") || die "$input: $!\n";
open (OUT,">$output") || die "$output: $!\n";
open (OUT_MIG,">$output_mig") || die "$output_mig: $!\n"  if $opt_M;
open (OUT_SP,">$output_sp") || die "$output_sp: $!\n"  if $opt_S;
# open (OUT_B,">$output_b") || die "$output_b: $!\n";
# open (OUT_R,">$output_r") || die "$output_r: $!\n";

open(OUT_RA, ">$RUNNABLE_file") || die "$RUNNABLE_file: $!\n"  if $opt_t;
print OUT_RA "# Number of Runnable tasks on all PEs $i\n"      if $opt_t;
open(OUT_BA, ">$BLOCKED_file") || die "$BLOCKED_file: $!\n"    if $opt_t;
print OUT_BA "# Number of Blocked tasks on all PEs $i\n"       if $opt_t;
open(OUT_FA, ">$FETCHING_file") || die "$FETCHING_file: $!\n"  if $opt_t;
print OUT_FA "# Number of Fetching tasks on all PEs $i\n"      if $opt_t;

($pname,$pars,$nPEs,$lat,$date) = &skip_header(IN);

print STDERR "nPEs: $nPEs, PName: $pname, pars: $pars, Lat: $lat, date: $date\n" if $opt_v;

# Fill in the y_val table for all PEs
$offset = (&generate_y_val_table($nPEs)/2);

$x_min = 0;
$x_max = &get_x_max($input);
$y_max = $total_height;
#$y_max = $y_val[$nPEs-1] + offset;

$is_very_big = $x_max > $very_big;

# Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
$max_width = $offset;

# General init
do init($nPEs);

do write_prolog(OUT,$x_max,$y_max);
do write_prolog(OUT_MIG,$x_max,$y_max)  if $opt_M;
do write_prolog(OUT_SP,$x_max,$y_max)  if $opt_S;
# do write_prolog(OUT_B,$x_max,$y_max);
# do write_prolog(OUT_R,$x_max,$y_max);

while (<IN>) {
    next  if /^$/;                                # Omit empty lines;
    next  if /^--/;                               # Omit comment lines;

    ($event, $time, $id, $pe) = &get_line($_);
    $x_max_ = $time  if $time > $x_max_;

    print OUT_RA "[$time]  PEs: " . join(", ",@runnable) .
	         "  SUM: " . &list_sum(@runnable) . "\n"      if $opt_t;
    print OUT_BA "[$time]  PEs: " . join(", ",@blocked) .
	         "  SUM: " . &list_sum(@blocked) . "\n"       if $opt_t;
    print OUT_FA "[$time]  PEs: " . join(", ",@fetching) .
	         "  SUM: " . &list_sum(@fetching) . "\n"      if $opt_t;

    foo : {
	($event eq "START") && do {
	    # do draw_tic($pe, $time, $START);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $running[$pe] = $id;
	    # $where{$id} = $pe + 1;
	    last foo;
	};
	($event eq "START(Q)") && do {
	    #do draw_segment($pe, $time, $RUNNABLE);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    #$last_runnable[$pe] = $time;
	    $runnable[$pe]++;
	    # $where{$id} = $pe + 1;
	    last foo;
	};
	($event eq "STEALING") && do {
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $runnable[$pe]--;
	    $where{$id} = $pe + 1;
	    if ( $opt_M ) {
		$when{$id} = $time;
		do draw_tic($pe, $time, $event);
	    }
	    last foo;
	};
	($event eq "STOLEN") && do {
	    # do draw_tic($pe, $time, $START);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $running[$pe] = $id;
	    if ( $where{$id} ) { 
		# Ok
	    } else {
		$warn++;
		print "WARNING: No previous location for STOLEN task $id found!" .
		     " Check the gr file!\n";
	    }
	    if ( $opt_M ) {
		do draw_tic($pe, $time, $event);
		do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
	    }
	    last foo;
	};
	($event eq "STOLEN(Q)") && do {
	    #do draw_segment($pe, $time, $RUNNABLE);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    #$last_runnable[$pe] = $time;
	    $runnable[$pe]++;
	    if ( $where{$id} ) { 
		# Ok
	    } else {
		$warn++;
		print "WARNING: No previous location for STOLEN(Q) task $id found!" .
		    " Check the gr file!\n";
	    }
	    if ( $opt_M ) {
		do draw_tic($pe, $time, $event);
		do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
	    }
	    last foo;
	};
	($event eq "BLOCK") && do {
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
	    $last_blocked[$pe] = $time;
	    #do draw_segment($pe, $time, $RUNNING);
	    $blocked[$pe]++;
	    $running[$pe] = $NO_ID;
	    last foo;
	};
	($event eq "RESUME") && do {
	    # do draw_tic($pe, $time, $START);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    do draw_segment($pe, $time, $BLOCKED);
	    $last_blocked[$pe] = $time;
	    $blocked[$pe]--;
	    $running[$pe] = $id;
	    last foo;
	};
	($event eq "RESUME(Q)") && do {
	    #do draw_segment($pe, $time, $RUNNABLE);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    do draw_segment($pe, $time, $BLOCKED);
	    $last_blocked[$pe] = $time;
	    #$last_runnable[$pe] = $time;
	    $blocked[$pe]--;
	    $runnable[$pe]++;
	    last foo;
	};
	($event eq "END") && do {
	    # do draw_tic($pe, $time, $END);
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $running[$pe] = $NO_ID;
	    # do draw_segment($pe, $time, $RUNNING);
	    # $last_blocked[$pe] = $time;
	    last foo;
	};
	($event eq "SCHEDULE") && do {
	    # do draw_tic($pe, $time);
	    $last_start[$pe] = $time;
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $runnable[$pe]--;
	    $running[$pe] = $id;
	    last foo;
	};
	# NB: only used in new RTS
	($event eq "DESCHEDULE") && do {
	    # do draw_tic($pe, $time);
	    $last_bg[$pe] = $time;
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    $runnable[$pe]++;
	    $running[$pe] = $NO_ID;
	    last foo;
	};
	# NB: Check these; they are not yet tested
	($event eq "FETCH") && do {
	    # Similar to BLOCK; but don't draw a block segment
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    #do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
	    #$last_blocked[$pe] = $time;
	    #$blocked[$pe]++;
	    $fetching[$pe]++;
	    $running[$pe] = $NO_ID;
	    last foo;
	};
	($event eq "REPLY") && do {
	    do draw_bg($pe, $time);
	    $last_bg[$pe] = $time;
	    #do draw_segment($pe, $time, $BLOCKED);
	    #$last_blocked[$pe] = $time;
	    #$blocked[$pe]--;
	    $fetching[$pe]--;
	    $blocked[$pe]++;
	    last foo;
	};
	# These are only processed if a spark pofile is generated, too
	(($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
	    if ( !opt_S ) {
		$spark_events++;
	        last foo;
	    }
	    do draw_sp_bg($pe, $time);
	    $last_sp_bg[$pe] = $time;
	    $sparks[$pe]++;
	    last foo;
	};

	(($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
	    if ( !opt_S ) {
		$spark_events++;
	        last foo;
	    }
	    do draw_sp_bg($pe, $time);
	    $last_sp_bg[$pe] = $time;
	    $sparks[$pe]--;
	    if ( $sparks[$pe]<0 ) {
		print STDERR "Error: Neg. number of sparks @ $time\n";
	    }
	    last foo;
	};

	$warn++;
	print "WARNING: Unknown event: $event\n";
    }
    do check_consistency()  if $opt_M;
    do sanity_check() if $opt_C;
}

do write_epilog(OUT,$x_max,$y_max);
do write_epilog(OUT_MIG,$x_max,$y_max)   if $opt_M;
do write_epilog(OUT_SP,$x_max,$y_max)    if $opt_S;
# do write_epilog(OUT_B,$x_max,$y_max);
# do write_epilog(OUT_R,$x_max,$y_max);

close(IN);
close(OUT);
# close(OUT_B);
# close(OUT_R);

close(OUT_MIG) if $opt_M;
close(OUT_SP)  if $opt_S;
close(OUT_BA)  if $opt_t;
close(OUT_RA)  if $opt_t;
close(OUT_FA)  if $opt_t;

#for ($i=0; $i<$nPEs; $i++) {
#    close($OUT_BA[$i]);
#    close($OUT_RA[$i]);
#}

if ($x_max != $x_max_ ) {
    print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
}

print "Number of suppressed warnings: $warn\n"  if $warn>0;
print "FYI: The file $input contains $spark_events lines of spark information\n"  if !opt_S && ($spark_events>0);

system "gzip -f1 $RUNNABLE_file"  if $opt_t;
system "gzip -f1 $BLOCKED_file"   if $opt_t;
system "gzip -f1 $FETCHING_file"  if $opt_t;

# system "fortune -s"  if $opt_v;

exit 0;

# ----------------------------------------------------------------------------
# This translation is mainly taken from gr2qp.awk
# This subroutine returns the event found on the current line together with
# the relevant information for that event. The possible EVENTS are:
#  START, STARTQ, STOLEN, BLOCK, RESUME, RESUMEQ, END, SCHEDULE
# ----------------------------------------------------------------------------

sub get_line {
  local ($line) = @_;
  local ($f, @fs);
  local ($event, $time, $id, $pe);

  @fs = split(/[:\[\]\s]+/,$line);
  $event = $fs[3];
  $time = $fs[2];
  $id = $fs[4];
  $pe = $fs[1];

  print OUT "% > " . $_   if $opt_D;
  print OUT "%   EVENT = $event; TIME = $time; ID = $id; PE = $pe\n" if $opt_D;
  print OUT "%   --> this task comes from PE " . ($where{$id}-1) . "\n"  if $opt_D && $event eq "STOLEN";

  return ($event, $time, $id, $pe);

  # if ($fs[3] eq "START") { 
  #     partprofile = 0; 
  #     print (substr($3,2,length($3)-3))," *G 0 0x" $5; 
  # }
  # if ($fs[3] eq "START(Q)") { 
  #     print (substr($3,2,length($3)-3))," *A 0 0x" $5; 
  # }

 #  if ($fs[3] eq "STOLEN")    { 
  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
  # }

 #  if ($fs[3] eq "BLOCK")     { 
  #     print (substr($3,2,length($3)-3))," GR 0 0x" $5; 
  # }
  # if ($fs[3] eq "RESUME")    { 
  #     print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0"; 
  # }
  # if ($fs[3] eq "RESUME(Q)") { 
  #     print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0"; 
  # }
  # if ($fs[3] eq "END")       { 
  #   if (partprofile) {
  #	p rint (substr($9,1,length($9)-1))," *G 0 0x" (substr($5,1,length($5)-1));
  #	p rint (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
  #   } else {
  #       print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1)); 
  #   }
  # }
  # if ($fs[3] eq "SCHEDULE")  { 
  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
  # }

}

# ----------------------------------------------------------------------------

sub check_consistency {
    local ($i);

    for ($i=0; $i<$nPEs; $i++) {
	if ( $runnable[$i] < 0 ) {
	    print "INCONSISTENCY: PE $i: Size of runnable queue: $runnable[$i] at time $time\n";
            $runnable[$i] = 0 ;
	}
        if  ( $blocked[$i] < 0 ) {
	    print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
            $blocked[$i] = 0 ;
	}
    }
}

# ----------------------------------------------------------------------------

sub get_width {
    local ($n, $type) = @_;

    $warn++   if $n <0;
    print "WARNING: Neg. number of tasks in $type queue: $n!!\n"  if $n <0;
    $n = 0  if $n <0;
    return ( ($type eq $RUNNING) ? ($running_width * $width_unit) : 
	    &min($max_width, $n * $width_unit) );
}

# ----------------------------------------------------------------------------
# Use an intensity between 0 (empty runnable queue) and 1 (`full' runnable
# queue) to abstract from monchrome/color values
# The concrete grayshade/color is computed via PS macros.
# ----------------------------------------------------------------------------

sub get_intensity {
    local ($n) = @_;

    print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n"  if $n<0;

    if ($n >= $inf_block) {
	return 1.0;
    } else {
	return ($n+1)/$inf_block;
    }
}

# ----------------------------------------------------------------------------

sub get_sp_intensity {
    local ($n) = @_;

    print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n"  if $n<0;

    if ($n >= $inf_block) {
	return 1.0;
    } else {
	return ($n+1)/$inf_block;
    }
}

# ----------------------------------------------------------------------------

sub get_shade {
    local ($n) = @_;


    if ($n > $inf_block) {
	return 0.2;
    } else {
	return 0.8 - ($n/$inf_block);
    }
}

# ----------------------------------------------------------------------------

sub max { 
    local($x, $y) = @_;

    return ($x>$y ? $x : $y);
}

# ----------------------------------------------------------------------------

sub min { 
    local($x, $y) = @_;

    return ($x<$y ? $x : $y);
}

# ----------------------------------------------------------------------------

sub list_sum {
    local (@list) = @_;

    local ($sum);

    foreach $x (@list) {
	$sum += $x;
    }

    return ($sum);
}

# ----------------------------------------------------------------------------
# Drawing functions.
# Put on top of funtions that directly generate PostScript.
# ----------------------------------------------------------------------------

sub draw_segment {
    local ($pe, $time, $type) = @_;
    local ($x, $y, $width, $gray);

    if ( $type eq $BLOCKED ) {
	if ( $last_blocked[$pe] == $NO_LAST_BLOCKED ) { return; };
	$width = &get_width($blocked[$pe], $type);
	if ( $width  == 0 ) { return; };
	$y = $stripes_low[$pe] + int($width/2 + 0.5);
	$x = $last_blocked[$pe]; 

	if ( $is_very_big ) {	
	    $x = int($x/$shrink_x) + 1;   # rounded up
	}

	#  $gray = 0.5;  # Ignoring gray level; doesn't change!
	do ps_draw_hline(OUT,$x,$y,$time,$width);   
    } else {
	die "ERROR: Unknow type of line: $type in draw segment\n";
    }

    if ($x < 0 || $y<0) {
	die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
    }
    if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
	die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
    }
}

# ----------------------------------------------------------------------------

sub draw_tic {
    local ($pe, $time, $event) = @_;
    local ($x, $y, $lit);

    $ystart = $stripes_low[$pe];
    $yend = $stripes_high[$pe];
    $x = $time;
    if ( $event eq "STEALING" ) {
	$lit = 0;  # i.e. FROM
    } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
	$lit = 1;  # i.e. TO
    } else {
	die "ERROR: Wrong event $event in draw_tic\n";
    }

    if ( $is_very_big ) {	
	$x = int($x/$shrink_x) + 1;   # rounded up
    }

    if ($x < 0 || $ystart<0 || $yend<0) {
	die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
    }
    do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
}

# ----------------------------------------------------------------------------

sub draw_bg {
    local ($pe,$time) = @_;
    local ($x_start, $x_end, $intensity, $secondary_intensity);

    if ( $last_bg[$pe] == $NO_LAST_BG ) { 
	print OUT "% Omitting BG: NO LAST BG\n" if $opt_D; 
	return; 
    }
    if ( $running[$pe] == $NO_ID ) { 
	print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D; 
	# return;
    }
    $x_start = $last_bg[$pe];  
    $x_end = $time;
    $intensity = ( $running[$pe] == $NO_ID ? 
		      0 : 
	              &get_intensity($runnable[$pe]) );
    $secondary_intensity = ( $running[$pe] == $NO_ID ? 
			        0 : 
	                        &get_intensity($fetching[$pe]) );
    do ps_draw_bg(OUT,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
		  $intensity,$secondary_intensity);

    if ( $opt_M ) {
	do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end, 
			 $mig_width);
    }
    
}

# ----------------------------------------------------------------------------
# Variant of draw_bg; used for spark profile
# ----------------------------------------------------------------------------

sub draw_sp_bg {
    local ($pe,$time) = @_;
    local ($x_start, $x_end, $intensity, $secondary_intensity);

    if ( $last_sp_bg[$pe] == $NO_LAST_BG ) { 
	print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D; 
	return; 
    }
    $x_start = $last_sp_bg[$pe];  
    $x_end = $time;
    $intensity = ( $sparks[$pe] <= 0 ? 
		      0 : 
	              &get_sp_intensity($sparks[$pe]) );
    $secondary_intensity = 0; 
    do ps_draw_bg(OUT_SP,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
		  $intensity,$secondary_intensity);

}

# ----------------------------------------------------------------------------

sub draw_arrow {
    local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
    local ($ystart,$yend);
    
    $ystart = $stripes_high[$from_pe];
    $yend = $stripes_low[$to_pe];
    do ps_draw_arrow(OUT_MIG,$send_time,$arrive_time,$ystart,$yend);
}

# ----------------------------------------------------------------------------
# Normalize the x value s.t. it fits onto the page without scaling.
# The global values $left_border and $right_border and $total_width 
# determine the borders
# of the graph. 
# This fct is only called from within ps_... fcts. Before that the $x values
# are always times.
# ----------------------------------------------------------------------------

sub normalize {
    local ($x) = @_;

    return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
}

# ----------------------------------------------------------------------------
# PostScript generation functions.
# Lowest level of writing output file.
# Now there is only normalizing mode supported. 
# The following is out of date:
# $mode can be $LITERATE i.e. assuming scaling has been done
#           or $NORMALIZING i.e. no scaling has been done so far (do it in
#                                macros for drawing)
# ----------------------------------------------------------------------------

sub ps_draw_hline {
    local ($OUT,$xstart,$y,$xend,$width) = @_;
    local ($xlen); 

    print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D; 

    if ( ! $opt_N ) {
	$xstart = &normalize($xstart);
	$xend = &normalize($xend);
    }

    $xlen = $xend - $xstart;

    printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
    #           ( $mode == $LITERATE ? " L\n" : " N\n");

    # Old version:
    # print $OUT "newpath\n";
    # print $OUT "$GRAY{$type} setgray\n";
    # print $OUT $xend . "  " . $y . " " . $xstart . " " . $y . " " . $width . 
    #    " line\n";
    # print $OUT "stroke\n";
}

# ----------------------------------------------------------------------------

sub ps_draw_vline {
    local ($OUT,$x,$ystart,$yend,$width) = @_;

    print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D; 

    if ( ! $opt_N ) {
	$x = &normalize($x);
    }

    print $OUT "newpath\n";
    print $OUT "0 setgray\n";                             # constant gray level
    printf $OUT ("%d %d %d %d %.1g line\n",
		 $x,$yend ,$x,$ystart,$width);
    print $OUT "stroke\n";
}

# ----------------------------------------------------------------------------

sub ps_draw_tic {
    local ($OUT,$x,$ystart,$yend,$lit) = @_;

    print $OUT "% TIC at ($x,$ystart-$yend)\n"   if $opt_D;

    if ( ! $opt_N ) {
	$x = &normalize($x);
    }

    printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);

    # Old version without PostScript macro /tic:
    # print $OUT "newpath\n";
    # print $OUT "ticwidth setlinewidth\n" .
    #	      $x . " " . $y . " ticlen sub moveto\n" .
    #	      $x . " " . $y . " ticlen add lineto\n";
    #print $OUT "stroke\n";
}

# ----------------------------------------------------------------------------

sub ps_draw_arrow {
    local ($OUT,$xstart,$xend,$ystart,$yend) = @_;

    print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n"   if $opt_D;

    if ( ! $opt_N ) {
	$xstart = &normalize($xstart);
	$xend = &normalize($xend);
    }

    printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
}

# ----------------------------------------------------------------------------

sub ps_draw_bg {
    local ($OUT,$xstart, $xend, $ystart, $yend, 
	   $intensity, $secondary_intensity) = @_;
    local ($xlen, $ylen);

    print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
	       "  (intensity: $intensity, $secondary_intensity)\n"  if $opt_D;

    if ( ! $opt_N ) {
	$xstart = &normalize($xstart);
	$xend = &normalize($xend);
    }

    $xlen = $xend - $xstart;
    $ylen = $yend - $ystart;

    printf $OUT ("%d %d %d %d %.2g %.2g R\n",
		 $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);

    # Old version without PostScript macro /rect:
    #print $OUT "newpath\n";
    #print $OUT " $x_start $y_start moveto\n";
    #print $OUT " $x_end $y_start lineto\n";
    #print $OUT " $x_end $y_end lineto\n";
    #print $OUT " $x_start $y_end lineto\n";
    #print $OUT "closepath\n";
    #print $OUT "$gray setgray\n";
    #print $OUT "fill\n";
}

# ----------------------------------------------------------------------------
# Initialization and such
# ----------------------------------------------------------------------------

sub write_prolog {
    local ($OUT, $x_max, $y_max) = @_;
    local ($now, $dist, $y, $i);

    $now = do get_date();
    # $date is extracted out og the .gr file by skip_header

    if ( $opt_N ) {
      $x_scale = $total_width/$x_max;
      $y_scale = $total_height/$y_max;
    }

    # $tic_width = 2 * $x_max/$total_width;    constant now
    # $tic_len = 4 * $y_max/$total_height;

    print $OUT "%!PS-Adobe-2.0\n";
    print $OUT "%%BoundingBox:    0 0 560 800\n";
    print $OUT "%%Title:          Per-processor Activity Profile\n";
    print $OUT "%%Creator:        gr2pe\n";
    print $OUT "%%StartTime:      $date\n";
    print $OUT "%%CreationDate:   $now\n";
    print $OUT "%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n";
    print $OUT "%%EndComments\n";

    # print $OUT "%%BeginSetup\n";
    # print $OUT "%%PageOrientation: \tSeascape\n";
    # print $OUT "%%EndSetup\n";

    print $OUT "%/runlineto {1.5 setlinewidth lineto} def\n";
    print $OUT "%/suspendlineto {0.5 setlinewidth lineto} def\n";
    print $OUT "%/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n";
    print $OUT "%/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n";
    print $OUT "\n";
    print $OUT "/prt-exact-rt true def\n";
    print $OUT "/prt-exact-tics false def\n";
    print $OUT "\n";
    print $OUT "/total-len $x_max def\n";
    print $OUT "/total-height $total_height def\n";
    print $OUT "/buckets $inf_block def\n";
    print $OUT "/show-len $total_width def\n";
    print $OUT "/x-offset 0 def\n";
    print $OUT "/y-offset -5 def\n";
    print $OUT "/box-x-len 10 def\n";
    print $OUT "/box-y-len 10 def\n";
    print $OUT "/normalize { show-len mul total-len div } def\n";
    print $OUT "/x-normalize { exch show-len mul total-len div exch } def\n";
    print $OUT "/str-len 12 def\n";
    #print $OUT "/prt-n { str-len string cvs show } def" .
    #	       "     % print top-of-stack integer\n";
    print $OUT "/prt-n { cvi str-len string cvs \n" .
	       "         dup stringwidth pop \n" .
	       "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
               "         neg 0 rmoveto \n" . 
               "         show  } def \n" .
	       "        % print top-of-stack integer centered at the current point\n";
    print $OUT "/ticwidth $tic_width def\n";
    print $OUT "%/ticlen $tic_len def     % actually half of the tic-length\n";
    print $OUT "/T    % Draw a tic mark\n" .
               " {    % Operands: x, y-start, y-end of tic, from/to flag \n" .
	       "   newpath\n" .
	       "   0 eq { " . ( $opt_m ? " 0.2 setgray }" 
                                       : " 0 0.7 0.2 setrgbcolor }" ) .
	       "        { " . ( $opt_m ? " 0.8 setgray }" 
                                       : " 0.7 0 0.2 setrgbcolor }" ) . " ifelse\n" .
	       "   ticwidth setlinewidth\n" .
	       "   3 copy pop moveto\n" .
	       "   exch pop lineto\n" .
	       "   stroke\n" .
	       " } def\n";
    #	       "   3 copy pop x-normalize moveto\n" .
    #	       "   exch pop x-normalize lineto\n" .
    #	       "   stroke\n" .
    #	       " } def\n";
    print $OUT "/blocked-gray 0 def\n";
    print $OUT "/idle-gray 1 def\n";
    print $OUT "/blocked-color { 0.2 0.1 0.8 } def\n";
    print $OUT "/idle-color { 0.8 0.1 0.2 } def\n";
    print $OUT "/idle-color-fetch { 0.5 0.6 0.4 } def\n";
    print $OUT "/L              % Draw a line (for blocked tasks)\n" .
	       " {              % Operands: (x,y)-start xlen width\n" .
	       "  newpath \n" .
	       ( $opt_m ? "  blocked-gray setgray\n" : 
                          "  blocked-color setrgbcolor\n") .
	       "         setlinewidth 3 copy pop moveto 0 rlineto pop pop stroke} def\n";
    print $OUT "/N              % Draw a normalized line\n" .
	       " {              % Operands: (x,y)-start xlen width\n" .
	       "  newpath \n" .
	       ( $opt_m ? "  blocked-gray setgray\n" : 
                          "  blocked-color setrgbcolor\n") .
	       "         setlinewidth 3 copy pop x-normalize moveto normalize 0 rlineto pop pop stroke} def\n";
    print $OUT "% /L line def\n";
    print $OUT "/printText { 0 0 moveto (GrAnSim) show } def\n";
    if ( $opt_m ) {
	print $OUT "/logo { gsave \n" .
	           "        translate \n" .
		   "        .95 -.05 0  " .
		   "          { setgray printText 1 -.5 translate } for \n" .
		   "        1 setgray printText\n" . 
		   "        grestore } def\n";
    } else {
	print $OUT "/logo { gsave \n" .
	      "        translate \n" .
	      "        .95 -.05 0\n" .
	      "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
	      "        1 0 0 setrgbcolor printText\n" . 
	      "        grestore} def\n";
    }

    print $OUT "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
    print $OUT  "/starside \n" .
                " {starlen 0 lineto currentpoint translate \n" .
		"    -144 rotate } def\n";

   print $OUT  "/star \n" .
               " { moveto \n" .
	       "   currentpoint translate \n" .
	       "   4 {starside} repeat \n" .
	       "   closepath \n" .
	       "   gsave \n" .
	       "   .7 setgray fill \n" .
	       "   grestore \n" .
	       "   % stroke  \n" .
	       "  } def \n";
    #print $OUT "/get-shade   % compute shade from intensity\n" .
    #	           " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
    if ( $opt_m ) { 
	print $OUT "/from 0.2 def\n";
	print $OUT "/to 0.8 def\n";
	print $OUT "/get-shade   % compute shade from intensity\n" .
	           "  { pop dup 0 eq { pop idle-gray }\n " .
		   "                 { 1 exch sub to from sub mul from add } ifelse } def\n";
	           " { pop 1 exch sub to from sub mul from add } def\n";
    } else {
	print $OUT "/from 0.5 def\n";
	print $OUT "/to 0.9 def\n";
    }
    print $OUT "/epsilon 0.01 def\n";
    print $OUT "/from-blue 0.7 def\n";
    print $OUT "/to-blue   0.95 def\n";
    print $OUT "/m 1 def\n";
    print $OUT "/magnify { m mul dup 1 gt { pop 1 } if } def\n";
    print $OUT "%\n" .
	       "% show no. of runnable threads and the current degree of fetching\n" .
	       "%\n" .
	       "/get-color        % compute color from intensity\n" .
               " { 4 mul dup      % give more weight to second intensity\n" .
	       "   0 eq { pop 0 exch } \n" .
	       "        { from-blue to-blue sub mul from-blue add dup \n" .
	       "          1 gt { pop 1 } if  exch } ifelse \n" .
               "   dup 0 eq { pop pop idle-color }\n" .
               "            { 1 exch sub to from sub mul from add        % green val is top of stack\n" .
	       "              exch 0 3 1 roll  } ifelse } def\n"; 

    print $OUT "%\n";
    print $OUT "% show no. of runable threads only\n";
    print $OUT "%\n";
    print $OUT "/get-color-runnable			% compute color from intensity\n";
    print $OUT "{ pop dup 0 eq { pop idle-color }\n";
    print $OUT "               { 1 exch sub to from sub mul from add   % green val is top of stack\n";
    print $OUT "                 0.2 0 3 1 roll  } ifelse } def\n";

    print $OUT "%\n";
    print $OUT "% show no. of fetching threads only\n";
    print $OUT "%\n";
    print $OUT "/get-color-fetch  			% compute color from intensity\n";
    print $OUT "{ exch pop dup 0 eq { pop idle-color-fetch }\n";
    print $OUT "                    { 1 exch sub to from sub mul from add   % blue val is top of stack\n";
    print $OUT "                      0.2 0.6 3 2 roll  } ifelse } def\n";

    #print $OUT "/get-color    % compute color from intensity\n" .
    #           " { dup 0 eq { pop idle-color }\n" .
    #           "            { 1 exch sub to from sub mul from add 0 exch 0 } ifelse } def\n"; 
    #	       " { dup 0.4 le { 0.4 exch sub 0.2 add 2 mul 0 0 setrgbcolor} " .
    #          "              { 1 exch sub 0.4 add 0 exch 0 setrgbcolor} ifelse \n" .
    print $OUT "/R          % Draw a rectangle \n" .
               " {             % Operands: x y xlen ylen i j \n" .
               "               %    (x,y) left lower start point of rectangle\n" .
               "               %    xlen  length of rec in x direction\n" .
               "               %    ylen  length of rec in y direction\n" .
               "               %    i     intensity of rectangle [0,1] \n" .
               "               %    j     intensity blue to indicate fetching\n" .
               "               %          (ignored in mono mode)\n" .
	       ( $opt_m ? "  get-shade setgray\n" 
		        : "  get-color-runnable setrgbcolor\n" ) .
               "  newpath\n" .
               "  4 copy pop pop moveto\n" .
	       "  1 index  0 rlineto\n" .
	       "  0 index  0 exch rlineto\n" .
	       "  1 index  neg 0 rlineto\n" .
               "  0 index  neg 0 exch rlineto\n" .
               "  pop pop pop pop\n" .
               "  closepath\n" .
               "  fill             % Note: No stroke => no border\n" .
	       " } def\n";
    print $OUT "% /R rect def\n";
    print $OUT "%/A         % Draw an arrow (for migration graph)\n" .
	       "% {         % Operands: x y x' y' \n" .
               "%           %  (x,y)    start point \n" .
               "%           %  (x',y')  end point \n" .
	       ( $opt_m ? "%    0 setgray\n" : "%     0 0 0 setrgbcolor\n" ) .
	       "%  1 setlinewidth\n" .
	       "%  newpath 4 2 roll x-normalize moveto x-normalize lineto stroke } def\n";

    print $OUT "/A         % No arrows \n" .
	       " { pop pop pop pop } def\n";
    print $OUT "-90 rotate\n";
    
    print $OUT "-785 30 translate\n";
    print $OUT "/HE10 /Helvetica findfont 10 scalefont def\n";
    print $OUT "/HE12 /Helvetica findfont 12 scalefont def\n";
    print $OUT "/HE14 /Helvetica findfont 14 scalefont def\n";
    print $OUT "/TI16 /Times-Italic findfont 16 scalefont def\n";
    print $OUT "/HB16 /Helvetica-Bold findfont 16 scalefont def\n";
    print $OUT "% " . "-" x 77 . "\n";

    print $OUT "newpath\n";
    print $OUT "0 8.000000 moveto\n";
    print $OUT "0 525.000000 760.000000 525.000000 8.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "760.000000 525.000000 760.000000 0 8.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "760.000000 0 0 0 8.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "0 0 0 525.000000 8.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "0.500000 setlinewidth\n";
    print $OUT "stroke\n";
    print $OUT "newpath\n";
    print $OUT "4.000000 505.000000 moveto\n";
    print $OUT "4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n";
    print $OUT "4 {pop} repeat\n";
    print $OUT "0.500000 setlinewidth\n";
    print $OUT "stroke\n";

    print $OUT "% ----------------------------------------------------------\n";
    print $OUT "/prt-pallet { % Print pallet at current point\n";
    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
    print $OUT "%       end values in /get-color\n";
    print $OUT "gsave \n";
    print $OUT "0.0 1.00 buckets div 1.00 \n";
    print $OUT " { \n";
    print $OUT "  dup dup \n";
    print $OUT "    from epsilon sub gt exch \n";
    print $OUT "    from epsilon add lt \n";
    print $OUT "   and\n";
    print $OUT "    { newpath " .
	       ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
	       "0 0 moveto 0 -3 rlineto stroke } if\n";
    print $OUT "  dup dup \n";
    print $OUT "    to epsilon 2 mul sub gt exch \n";
    print $OUT "    to epsilon 2 mul add lt \n";
    print $OUT "   and\n";
    print $OUT "    { newpath " . 
	       ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
	       "box-x-len 0 moveto 0 -3 rlineto stroke } if\n";
    print $OUT ($opt_m ? " setgray\n" : "  0 exch 0 setrgbcolor\n");
    print $OUT "  newpath\n";
    print $OUT "  0 0 moveto\n";
    print $OUT "  box-x-len 0 rlineto\n";
    print $OUT "  0 box-y-len  rlineto\n";
    print $OUT "  box-x-len neg 0 rlineto\n";
    print $OUT "  closepath\n";
    print $OUT "  fill\n";
    print $OUT "  box-x-len 0 translate \n";
    print $OUT " } for\n";
    print $OUT "grestore\n";
    print $OUT "} def\n";

    print $OUT <<EOQ;
% /prt-double-pallet {  % Print pallet  for showing fetch at current point
% NOTE: the values for the tics must correspond to start and
%       end values in /get-color
% gsave 
% 0.0 1.00 buckets div 1.00 
% { 
%  dup dup 
%    from epsilon sub gt exch 
%    from epsilon add lt 
%   and
%   { newpath 0 0 0 setrgbcolor 0 0 moveto 0 -3 rlineto stroke } if
%  dup dup 
%    to epsilon 2 mul sub gt exch 
%    to epsilon 2 mul add lt 
%   and
%   { newpath 0 0 0 setrgbcolor box-x-len 0 moveto 0 -3 rlineto stroke } if
%  0.2 exch 0.6 exch setrgbcolor   
%  newpath
%  0 0 moveto
%  box-x-len 0 rlineto
%  0 box-y-len  rlineto
%  box-x-len neg 0 rlineto
%  closepath
%  fill
%  box-x-len 0 translate 
% } for
% grestore
% } def
EOQ

    print $OUT <<EOQ;
% /prt-double-pallet { % Print double pallet at current point
% % NOTE: the values for the tics must correspond to start and
% %       end values in /get-color
% gsave 
% 0.0 1.00 buckets div 1.00 
% { 
%   0 exch 0 setrgbcolor   
%   newpath
%   0 0 moveto
%   box-x-len 0 rlineto
%   0 box-y-len  rlineto
%   box-x-len neg 0 rlineto
%   closepath
%   fill
%   box-x-len 0 translate 
% } for
% grestore
% } def
EOQ

    print $OUT <<EOQ;
% /prt-double-pallet { % Print double pallet at current point
% gsave 
% 0.0 1.00 buckets div 1.00 
% { 
%   dup dup 
%     from epsilon sub gt exch 
%     from epsilon add lt 
%    and
%    { newpath 0 0 0 setrgbcolor 0 3 moveto 0 -6 rlineto stroke } if
%   dup dup 
%     to epsilon 2 mul sub gt exch 
%     to epsilon 2 mul add lt 
%    and
%    { newpath 0 0 0 setrgbcolor box-x-len 3 moveto 0 -6 rlineto stroke } if
%    0.7 exch 0 setrgbcolor   
%    newpath
%    0 0 moveto
%    box-x-len 0 rlineto
%    0 box-y-len  rlineto
%    box-x-len neg 0 rlineto
%    closepath
%    fill
%    box-x-len 0 translate 
% } for
% grestore
% } def
% ----------------------------------------------------------
EOQ

    print $OUT <<EOQ;
% -----------------------------------------------------------------------------
% draw a box in the legend
% -----------------------------------------------------------------------------
/draw-box { % stack: colour x-val |  
  box-y-offset moveto
  0 box-y-len rlineto
  box-x-len 0 rlineto
  0 box-y-len neg rlineto
  closepath
  % gsave
  % stack: colour x-val |
  set-colour-or-gray
  fill
  % grestore
  stroke
} def
% -----------------------------------------------------------------------------
% Aux fcts for constructing x/y-axes (placing tics; succinct total rt etc)
% -----------------------------------------------------------------------------
% From Dave Wakeling's Axes.c (part of hp2ps)
% static floatish
% One-Two-Five(y)
%   floatish y;
% {
%     if (y > 4.0) {
% 	return (5.0);
%     } else if (y > 1.0) {
% 	return (2.0);
%     } else {
% 	return (1.0);
%     }   
% }
/one-two-five { % y
  dup 4.0 gt  % ? y>4.0
  { pop 5.0 }
  { 1.0 gt    % ? y>1.0
    { 2.0 }
    { 1.0 } ifelse } ifelse
} def
% From Dave Wakeling's Axes.c (part of hp2ps)
% static floatish
% Round(y)
%   floatish y;
% {
%     int i;

%     if (y > 10.0) {
% 	for (i = 0; y > 10.0; y /= 10.0, i++) ;
% 	y = One-Two-Five(y);
% 	for ( ; i > 0; y = y * 10.0, i--) ;

%     } else if (y < 1.0) {
% 	for (i = 0; y < 1.0; y *= 10.0, i++) ;
%         y = One-Two-Five(y);
%         for ( ; i > 0; y = y / 10.0, i--) ;
 
%     } else {
% 	y = One-Two-Five(y);
%     }
% }

% % Print debugging info
% /prt-debug { % val str
%   currentpoint exch pop 15 add 100 exch moveto
%   show 20 0 rmoveto prt-n
% } def
% dumy def
/prt-debug { % val str
  pop pop 
} def

% ToDo: get rid of prt-debugs
/dw-round { % y ... the value to round to get nice tic marks
  100 200 moveto dup (Start of dw-round; y: ) prt-debug % debug 
  % special case (added to make the code terminate):
  % input 0 returns 0
  dup 0.0 eq not {                % ? y!=0 
     dup 10.0 gt                  % ? y>10.0 
     { dup 0 exch                 % i = 0
  	% stack: yin i y |
  	{ dup (div-loop; new y: ) prt-debug % debug 
  	  10.0 div                % y/=10.0
  	  exch 1 add exch         % i++
  	  dup 10.0 gt             % until !(y>10.0)
  	  not { exit } if
  	} loop 
  	% stack: yin i y |
  	dup (y after div-loop: ) prt-debug 
  	exch dup (i after div-loop: ) prt-debug exch
  	one-two-five  % y = one-two-five(y)
  	dup (y after div-loop and one-two-five: ) prt-debug 
  	exch
  	% stack: yin y i |
       dup 0.0 gt              % ? i>0
  	{ { exch 
  	    dup (mul-loop; new y: ) prt-debug % debug 
  	    10.0 mul           % y *= 10.0
  	    exch 1 sub         % i--
  	    dup 0.0 gt         % until !(i>0)
  	    not { exit } if
  	} loop } if
  	% stack: yin y i |
  	dup (i after div-loop: ) prt-debug 
  	pop
  	dup (y after div-loop: ) prt-debug 
  	exch pop
  	dup (result: ) prt-debug 
     } % then branch 
     { dup 1.0 lt                   % ? y<1.0
       { dup 0 exch                 % i = 0
  	 % stack: yin i y |
  	 { dup (mul2-loop; new y: ) prt-debug % debug 
	   10.0 mul                 % y*=10.0
	   exch 1 add exch          % i++
	   dup 1.0 lt               % until !(y<1.0)
	   not { exit } if
  	 } loop % until
  	dup (y after mul2-loop: ) prt-debug
  	exch dup (i after mul2-loop: ) prt-debug exch
  	one-two-five  % y = one-two-five(y)
  	dup (y after mul2-loop and one-two-five: ) prt-debug 
  	exch
  	% stack: yin y i |
  	dup 0 gt                    % ? i>0
  	{ { exch 
  	    dup (div2-loop; new y: ) prt-debug % debug 
  	    10.0 div                % y /= 10.0
  	    exch 1 sub              % i--
  	    dup 0 gt                % until !(i>0)
  	    not { exit } if
  	} loop } if
  	% stack: yin y i |
  	dup (i after div2-loop: ) prt-debug 
  	pop
  	dup (y after div2-loop: ) prt-debug 
  	exch pop 
  	} % then branch
  	{
  	one-two-five                % y = one-two-five(y)
  	dup (result: ) prt-debug 
  	} ifelse 
      } ifelse } if                 % ? y!=0.0
 % stack: y | 
  dup (Result: ) prt-debug 
} def
% ---------------------------------------------------------------------------
% Aux functions for approximating and printing runtime
% ---------------------------------------------------------------------------
/approx-rt { % exact-rt short-flag val
             % translate integer val into strings of val and unit
             % if short-flag is true then use M rather than Mcycles etc
 3 2 roll 
 { cvi 12 string cvs () exch } % prt-exact-rt is user tunable
  { dup 1000000 ge 
  { 100000 div floor 10 div 12 string cvs 
    exch { ( M) } { ( Mcycles) } ifelse exch } % val > 1Meg
  { dup 1000 ge 
    { 100 div floor 10 div 12 string cvs exch { ( k) } {( kcycles)} ifelse exch}
    { cvi 12 string cvs () exch } ifelse 
  } ifelse
 } ifelse
 % stack: <string with unit of time> <str with approx rt>
} def
/prt-rt { % exact-rt total-len
 790 20 moveto  % right end of bottom line; print right to left!
 prt-exact-rt exch true exch approx-rt exch ( cycles) (Runtime = ) 4 1 roll
 % (Runtime = ) val unit (cycles) |  % print top 4 strings from right to left
 4 { dup stringwidth pop neg dup 0 rmoveto exch show 0 rmoveto } repeat
} def
/prt-tic { % val |   print value with units center around current point
  % { prt-n } {
    prt-exact-tics exch false exch true exch approx-rt
    2 copy stringwidth pop exch stringwidth pop add 
    % stack: <str of unit> <str of val> <total string length>
    2 div currentpoint 3 1 roll exch sub exch moveto
    show show
  % } ifelse 
} def
% ---------------------------------------------------------------------------
EOQ
    print $OUT "($date) stringwidth pop 750 exch sub 508 moveto prt-pallet\n";

    print $OUT "HE14 setfont\n";
    print $OUT "100 508 moveto\n";
    print $OUT "%($pname  PEs: $nPEs  Lat.: $lat ) show\n";
    print $OUT "($pname $pars) show\n";
    
    print $OUT "($date) dup stringwidth pop 750 exch sub 508 moveto show\n";
    print $OUT ( $opt_m ? "5 512 asciilogo\n" : "5 512 logo\n");    
    print $OUT "% 100 500 moveto\n";    

    print $OUT "0 20 translate\n";

    print $OUT "HE14 setfont\n";
    for ($i=0; $i<$nPEs; $i++) {
	$dist = $stripes_high[$i] - $stripes_low[$i];
	$y = $stripes_low[$i] + $dist/2;
	# print $OUT "/starlen $dist def\n";
	# print $OUT "gsave 2 $y star grestore\n";
	print $OUT "  2 " . ($stripes_low[$i]+1) . " moveto ($i) show\n";
    }

    print $OUT "20 0 translate\n";

#     print $OUT "% Print x-axis:\n";
#     print $OUT "1 setlinewidth\n";
#     print $OUT "0 -5 moveto total-len normalize 0 rlineto stroke\n";
#     print $OUT "gsave\n" .
# 	       "[2 4] 1 setdash\n" .
# 	       "0 0 moveto 0 total-height rlineto stroke\n" .
# 	       "% $x_max 0 moveto 0 total-height rlineto stroke\n" .
# 	       "grestore\n";
#     print $OUT "0 total-len 10 div total-len\n" .
#                " { dup normalize dup -5 moveto 0 -2 rlineto stroke  % tic\n" .
#                "   -17 moveto HE10 setfont round prt-n  % print label \n" .
# 	       " } for \n";

    # Copied over from qp2ps


    print $OUT <<EOQ;
% ---------------------------------------------------------------------------
% draw a dashed line for time 0
gsave
[2 4] 1 setdash
0 0 moveto 0 total-height rlineto stroke
% $x_max 0 moveto 0 total-height rlineto stroke
grestore
% ---------------------------------------------------------------------------
% X-Axis:
0.5 setlinewidth
% horizontal line
x-offset y-offset moveto total-len normalize x-offset sub 0 rlineto stroke
% start increment end
% NB: total-len is rounded to get nice increment for tics
0 total-len dw-round 10 div total-len
 { dup normalize dup y-offset moveto 0 -2 rlineto stroke  % tic
   y-offset 13 sub moveto HE10 setfont prt-tic            % prt-tic may cut rt 
 } for 
1 setlinewidth
% End X-Axis.
% ---------------------------------------------------------------------------
EOQ

    print $OUT "$x_scale  $y_scale  scale\n";

    print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
    
    if ( $opt_D ) {
	print $OUT "% Debugging info : \n";

	print $OUT "% Offset is: $offset\n";

	print $OUT "% y_val table: \n";
	for ($i=0; $i<$nPEs; $i++) {
	    print $OUT "% y_val of $i: $y_val[$i]\n";
	}

	print $OUT "% x-max: $x_max; y-max: $y_max\n";
	print $OUT "% Info from header: Prg: $pname; PEs: $nPEs; Lat.: $lat\n";

	print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
    }
}

# ----------------------------------------------------------------------------

sub write_epilog {
    local ($OUT,$x_max, $y_max) = @_;
    local($x_scale,$y_scale);

    print $OUT "showpage\n";
}

# ----------------------------------------------------------------------------

sub get_x_max {
    local ($file) = @_;
    local ($last_line, @fs);

    open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
    while (<TMP>) {
	$last_line = $_;
    }
    close(TMP);

    @fs = split(/[:\[\]\s]+/,$last_line);

    return $fs[2];
}

# -----------------------------------------------------------------------------

sub get_date {
    local ($date);

    chop($date = `date`);
    return ($date);
}

# -----------------------------------------------------------------------------

sub generate_y_val_table {
    local ($nPEs) = @_;
    local($i, $y, $dist);

    $dist = int($total_height/$nPEs);
    for ($i=0, $y=1; $i<$nPEs; $i++, $y+=$dist) {
	$y_val[$i] = $y + $lower_border;
	$stripes_low[$i] = $y;
	$stripes_high[$i] = $y+$dist-2;
    }

    # print $OUT "10 5 translate\n";

    return ($dist);
}

# ----------------------------------------------------------------------------

sub init { 
    local ($nPEs) = @_;
    local($i);

    for ($i=0; $i<$nPEs; $i++) {
	if ( $opt_S ) {
	    $sparks[$i] = 0;
	}
	$blocked[$i] = 0;
	$runnable[$i] = 0;
	$fetching[$i] = 0;
	$running[$i] = $NO_ID;
	if ( $opt_S ) {
	    $last_sp_bg[$i] = $NO_LAST_BG;
	}
	$last_bg[$i] = $NO_LAST_BG;
	$last_start[$i] = $NO_LAST_START;
	$last_blocked[$i] = $NO_LAST_BLOCKED;
	$last_runnable[$i] = 0; 
	#open($OUT_RA[$i], "PE". $i . ".dat") || die "PE".$i."-R.dat: $!\n";
	#print $OUT_RA[$i] "# Number of Runnable tasks on PE $i\n";
	#open($OUT_BA[$i], "PE". $i . ".dat") || die "PE".$i."-B.dat: $!\n";
	#print $OUT_BA[$i] "# Number of Blocked tasks on PE $i\n";
    } 
    
}


# ----------------------------------------------------------------------------

sub skip_header {
    local ($FILE) = @_;
    local($prg, $pars, $nPEs, $lat, $fetch, $in_header);

    $in_header = 9;
    while (<$FILE>) {
	if ( $in_header == 8 ) {
	    if (/^Start-Time: (.*)$/) {
		$date = $1;
	    } else {
		$date = "???";
	    }
	    return ($prg, $pars, $nPEs, $lat, $date);
	}
	if ( $in_header == 9 ) {
	    if (/^=/) {
		$gum_style_gr = 1;
		$in_header = 0;
		if (/^(\S*)\s+(.*)$/) {		# 
		    $prg = $1;
		    $pars = $2;
		    $prg =~ s/.*=//;
		    $nPEs = $opt_p ? $opt_p : ( $pars =~ /\-qp(\d+)/ ? $1 : 2 );
		    $lat = $opt_l ? $opt_l : "??";
		} else {
		    $prg = "???";
		    $nPEs = "?";
		    $lat = "?";
		}
		$in_header = 8;
	    } else {
		$gum_style_gr = 0;
		$in_header = 1;
	    }
	    
	}
	$prg = $1, $pars = $2   if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
	$nPEs = $1	        if /^PEs\s+(\d+)/;
	$lat = $1, $fetch = $2  if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
	$date = $1              if /^Start time: (.*)$/;
	die "Can't process GranSim-Light profiles!\n"  if /^GrAnSim-Light$/i;

	last             if /^\+\+\+\+\+/;
    }

    return ($prg, $pars, $nPEs, $lat, $date);
}

# ----------------------------------------------------------------------------

sub process_options {

    if ( $opt_h ) {                      
	open(ME,$0) || die "Can't open myself ($0): $!\n";
	$n = 0;
	while (<ME>) {
	    last if $_ =~ /^$/;
	    print $_;
	    $n++;
	}
	close(ME);
	exit ;
    }
    
    if ( $#ARGV != 0 ) {
	print "Usage: $0 [options] <gr-file>\n";
	print "Use -h option to get details\n";
	exit 1;
    }
    
    $input = $ARGV[0] ;
    $input =~ s/\.gr//;
    $input .= ".gr";

    if ( $opt_o ) {
	($output   = $opt_o) =~ s/\.ps// ;
	$output_b = $output . "_peb.ps";
	$output_r = $output . "_per.ps";
	$output_mig = $output . "_mig.ps" if $opt_M;
	$output_sp = $output . "_sp.ps"   if $opt_S;
	$output   = $output . "_pe.ps";
	#($output_b = $opt_o) =~ s/\./-b./ ;
	#($output_r = $opt_o) =~ s/\./-r./ ;
	#($output_mig = $opt_o) =~ s/\./-mig./  if $opt_M;
	#($output_sp = $opt_o) =~ s/\./-sp./  if $opt_S;
    } else {
	($output = $input) =~ s/\.gr// ;
	$output_b = $output . "_peb.ps";
	$output_r = $output . "_per.ps";
	$output_mig = $output . "_mig.ps" if $opt_M;
	$output_sp = $output . "_sp.ps"   if $opt_S;
	$output   = $output . "_pe.ps";
    }
    
    if ( $opt_v ){ 
	$verbose = 1;
    }    

    if ( $opt_i ) {
	$inf_block = $opt_i;
    } else {
	$inf_block = 20;
    }

    $RUNNABLE_file = $input;
    $RUNNABLE_file =~ s/\.gr//;
    $RUNNABLE_file .= "-R";

    $BLOCKED_file = $input;
    $BLOCKED_file =~ s/\.gr//;
    $BLOCKED_file .= "-B";

    $FETCHING_file = $input;
    $FETCHING_file =~ s/\.gr//;
    $FETCHING_file .= "-F";
}

# ----------------------------------------------------------------------------

sub print_verbose_message {

    print "Input file: $input\n";  
    print "Output files: $output, $output_b, $output_r; ".
          ($opt_M ? "Migration: $output_mig" : "") .
	  ($opt_S ? "Sparks: $output_sp" : "") .
	  "\n";
}

# ----------------------------------------------------------------------------
# Junk from draw_segment:
#
#    if ( $type eq $RUNNING ) { 
#	die "ERROR: This version should never draw a RUNNING segment!";
#	$y = $y_val[$pe];
#	$x = $last_start[$pe]; 
#	$width = &get_width(0, $type);
#	# $gray = 0;
#
#	if ( $is_very_big ) {	
#	    $x = int($x/$shrink_x) + 1;   # rounded up
#	}
#
#	do ps_draw_hline(OUT_B,$x,$y,$time,$width);
#	do ps_draw_hline(OUT_R,$x,$y,$time,$width);  
#
#    } elsif ( $type eq $RUNNABLE ) {
#	die "ERROR: This version should never draw a RUNNABLE segment (shades are used instead)!";
#	$y = $y_val[$pe] + $offset;
#	$x = $last_runnable[$pe];
#	$width = &get_width($runnable[$pe], $type);
#
#	if ( $is_very_big ) {	
#	    $x = int($x/$shrink_x) + 1;   # rounded up
#	}
#
#	# $gray = 0.5;
#	do ps_draw_hline(OUT_R,$x,$y,$time,$width);   

sub sanity_check {
  $x=0;
  while ($x<nPEs) {
    print "PE $x: running<0: $_" if $running[$x]<0;
    print "PE $x: runnable<0: $_" if $runnable[$x]<0;
    print "PE $x: blocked<0: $_" if $blocked[$x]<0;
    print "PE $x: fetching<0: $_" if $fetching[$x]<0;
    $x++;
  }
}
