2 # (C) Hans Wolfgang Loidl, November 1994
3 # ############################################################################
4 # Time-stamp: <Fri Jun 14 1996 20:21:17 Stardate: [-31]7659.03 hwloidl>
6 # Usage: gr2pe [options] <gr-file>
8 # Create per processor activity profile (as ps-file) from a given gr-file.
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)
23 # ############################################################################
25 # die "This script is still under development -- HWL\n";
27 # ----------------------------------------------------------------------------
28 # Command line processing and initialization
29 # ----------------------------------------------------------------------------
33 &Getopts('hvDCMNmSGti:o:l:p:');
38 do print_verbose_message();
41 # ----------------------------------------------------------------------------
43 # ----------------------------------------------------------------------------
46 $RUNNABLE = "RUNNABLE";
62 # Special value showing that no task is running on $pe if in $running[$pe]
64 $NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;
66 # The number of PEs we have
69 # Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
72 # Width of line for RUNNING
75 # Offset of BLOCKED and RUNNABLE lines from the center line
78 # Left and right border of the picture; Width of the picture
81 $total_width = $right_border - $left_border;
84 # Height of the picture measured from y-val of first to y-val of last PE
87 $total_height = $upper_border - $lower_border;
90 # Constant from where shrinking of x-values (+scaling as usual) is enabled
93 # Factor by which the x values are shrunk (if very big)
96 # Set format of output of numbers
99 # Width of stripes in migration graph
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
108 # ----------------------------------------------------------------------------
109 # The real thing starts here
110 # ----------------------------------------------------------------------------
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";
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;
126 ($pname,$pars,$nPEs,$lat) = &skip_header(IN);
129 # Fill in the y_val table for all PEs
130 $offset = (&generate_y_val_table($nPEs)/2);
133 $x_max = &get_x_max($input);
134 $y_max = $total_height;
135 #$y_max = $y_val[$nPEs-1] + offset;
137 $is_very_big = $x_max > $very_big;
139 # Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
140 $max_width = $offset;
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);
152 next if /^$/; # Omit empty lines;
153 next if /^--/; # Omit comment lines;
155 ($event, $time, $id, $pe) = &get_line($_);
156 $x_max_ = $time if $time > $x_max_;
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;
166 ($event eq "START") && do {
167 # do draw_tic($pe, $time, $START);
168 do draw_bg($pe, $time);
169 $last_bg[$pe] = $time;
171 # $where{$id} = $pe + 1;
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;
180 # $where{$id} = $pe + 1;
183 ($event eq "STEALING") && do {
184 do draw_bg($pe, $time);
185 $last_bg[$pe] = $time;
187 $where{$id} = $pe + 1;
190 do draw_tic($pe, $time, $event);
194 ($event eq "STOLEN") && do {
195 # do draw_tic($pe, $time, $START);
196 do draw_bg($pe, $time);
197 $last_bg[$pe] = $time;
203 print "WARNING: No previous location for STOLEN task $id found!" .
204 " Check the gr file!\n";
207 do draw_tic($pe, $time, $event);
208 do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
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;
222 print "WARNING: No previous location for STOLEN(Q) task $id found!" .
223 " Check the gr file!\n";
226 do draw_tic($pe, $time, $event);
227 do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
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);
238 $running[$pe] = $NO_ID;
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;
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;
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;
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;
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;
289 $running[$pe] = $NO_ID;
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;
302 # These are only processed if a spark pofile is generated, too
303 (($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
308 do draw_sp_bg($pe, $time);
309 $last_sp_bg[$pe] = $time;
314 (($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
319 do draw_sp_bg($pe, $time);
320 $last_sp_bg[$pe] = $time;
322 if ( $sparks[$pe]<0 ) {
323 print STDERR "Error: Neg. number of sparks @ $time\n";
329 print "WARNING: Unknown event: $event\n";
331 do check_consistency() if $opt_M;
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);
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;
351 #for ($i=0; $i<$nPEs; $i++) {
352 # close($OUT_BA[$i]);
353 # close($OUT_RA[$i]);
356 if ($x_max != $x_max_ ) {
357 print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
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);
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;
367 system "fortune -s" if $opt_v;
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 # ----------------------------------------------------------------------------
381 local ($event, $time, $id, $pe);
383 @fs = split(/[:\[\]\s]+/,$line);
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";
393 return ($event, $time, $id, $pe);
395 # if ($fs[3] eq "START") {
397 # print (substr($3,2,length($3)-3))," *G 0 0x" $5;
399 # if ($fs[3] eq "START(Q)") {
400 # print (substr($3,2,length($3)-3))," *A 0 0x" $5;
403 # if ($fs[3] eq "STOLEN") {
404 # print (substr($3,2,length($3)-3))," AG 0 0x" $5;
407 # if ($fs[3] eq "BLOCK") {
408 # print (substr($3,2,length($3)-3))," GR 0 0x" $5;
410 # if ($fs[3] eq "RESUME") {
411 # print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0";
413 # if ($fs[3] eq "RESUME(Q)") {
414 # print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0";
416 # if ($fs[3] eq "END") {
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));
421 # print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
424 # if ($fs[3] eq "SCHEDULE") {
425 # print (substr($3,2,length($3)-3))," AG 0 0x" $5;
430 # ----------------------------------------------------------------------------
432 sub check_consistency {
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";
440 if ( $blocked[$i] < 0 ) {
441 print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
447 # ----------------------------------------------------------------------------
450 local ($n, $type) = @_;
453 print "WARNING: Neg. number of tasks in $type queue: $n!!\n" if $n <0;
455 return ( ($type eq $RUNNING) ? ($running_width * $width_unit) :
456 &min($max_width, $n * $width_unit) );
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 # ----------------------------------------------------------------------------
468 print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n" if $n<0;
470 if ($n >= $inf_block) {
473 return ($n+1)/$inf_block;
477 # ----------------------------------------------------------------------------
479 sub get_sp_intensity {
482 print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n" if $n<0;
484 if ($n >= $inf_block) {
487 return ($n+1)/$inf_block;
491 # ----------------------------------------------------------------------------
497 if ($n > $inf_block) {
500 return 0.8 - ($n/$inf_block);
504 # ----------------------------------------------------------------------------
509 return ($x>$y ? $x : $y);
512 # ----------------------------------------------------------------------------
517 return ($x<$y ? $x : $y);
520 # ----------------------------------------------------------------------------
534 # ----------------------------------------------------------------------------
536 # Put on top of funtions that directly generate PostScript.
537 # ----------------------------------------------------------------------------
540 local ($pe, $time, $type) = @_;
541 local ($x, $y, $width, $gray);
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];
550 if ( $is_very_big ) {
551 $x = int($x/$shrink_x) + 1; # rounded up
554 # $gray = 0.5; # Ignoring gray level; doesn't change!
555 do ps_draw_hline(OUT,$x,$y,$time,$width);
557 die "ERROR: Unknow type of line: $type in draw segment\n";
560 if ($x < 0 || $y<0) {
561 die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
563 if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
564 die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
568 # ----------------------------------------------------------------------------
571 local ($pe, $time, $event) = @_;
572 local ($x, $y, $lit);
574 $ystart = $stripes_low[$pe];
575 $yend = $stripes_high[$pe];
577 if ( $event eq "STEALING" ) {
578 $lit = 0; # i.e. FROM
579 } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
582 die "ERROR: Wrong event $event in draw_tic\n";
585 if ( $is_very_big ) {
586 $x = int($x/$shrink_x) + 1; # rounded up
589 if ($x < 0 || $ystart<0 || $yend<0) {
590 die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
592 do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
595 # ----------------------------------------------------------------------------
598 local ($pe,$time) = @_;
599 local ($x_start, $x_end, $intensity, $secondary_intensity);
601 if ( $last_bg[$pe] == $NO_LAST_BG ) {
602 print OUT "% Omitting BG: NO LAST BG\n" if $opt_D;
605 if ( $running[$pe] == $NO_ID ) {
606 print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D;
609 $x_start = $last_bg[$pe];
611 $intensity = ( $running[$pe] == $NO_ID ?
613 &get_intensity($runnable[$pe]) );
614 $secondary_intensity = ( $running[$pe] == $NO_ID ?
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);
621 do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end,
627 # ----------------------------------------------------------------------------
628 # Variant of draw_bg; used for spark profile
629 # ----------------------------------------------------------------------------
632 local ($pe,$time) = @_;
633 local ($x_start, $x_end, $intensity, $secondary_intensity);
635 if ( $last_sp_bg[$pe] == $NO_LAST_BG ) {
636 print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D;
639 $x_start = $last_sp_bg[$pe];
641 $intensity = ( $sparks[$pe] <= 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);
650 # ----------------------------------------------------------------------------
653 local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
654 local ($ystart,$yend);
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);
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
666 # This fct is only called from within ps_... fcts. Before that the $x values
668 # ----------------------------------------------------------------------------
673 return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
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 # ----------------------------------------------------------------------------
687 local ($OUT,$xstart,$y,$xend,$width) = @_;
690 print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D;
693 $xstart = &normalize($xstart);
694 $xend = &normalize($xend);
697 $xlen = $xend - $xstart;
699 printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
700 # ( $mode == $LITERATE ? " L\n" : " N\n");
703 # print $OUT "newpath\n";
704 # print $OUT "$GRAY{$type} setgray\n";
705 # print $OUT $xend . " " . $y . " " . $xstart . " " . $y . " " . $width .
707 # print $OUT "stroke\n";
710 # ----------------------------------------------------------------------------
713 local ($OUT,$x,$ystart,$yend,$width) = @_;
715 print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D;
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";
728 # ----------------------------------------------------------------------------
731 local ($OUT,$x,$ystart,$yend,$lit) = @_;
733 print $OUT "% TIC at ($x,$ystart-$yend)\n" if $opt_D;
739 printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);
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";
749 # ----------------------------------------------------------------------------
752 local ($OUT,$xstart,$xend,$ystart,$yend) = @_;
754 print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n" if $opt_D;
757 $xstart = &normalize($xstart);
758 $xend = &normalize($xend);
761 printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
764 # ----------------------------------------------------------------------------
767 local ($OUT,$xstart, $xend, $ystart, $yend,
768 $intensity, $secondary_intensity) = @_;
769 local ($xlen, $ylen);
771 print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
772 " (intensity: $intensity, $secondary_intensity)\n" if $opt_D;
775 $xstart = &normalize($xstart);
776 $xend = &normalize($xend);
779 $xlen = $xend - $xstart;
780 $ylen = $yend - $ystart;
782 printf $OUT ("%d %d %d %d %.2g %.2g R\n",
783 $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);
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";
796 # ----------------------------------------------------------------------------
797 # Initialization and such
798 # ----------------------------------------------------------------------------
801 local ($OUT, $x_max, $y_max) = @_;
802 local ($date, $dist, $y, $i);
807 $x_scale = $total_width/$x_max;
808 $y_scale = $total_height/$y_max;
811 # $tic_width = 2 * $x_max/$total_width; constant now
812 # $tic_len = 4 * $y_max/$total_height;
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";
822 # print $OUT "%%BeginSetup\n";
823 # print $OUT "%%PageOrientation: \tSeascape\n";
824 # print $OUT "%%EndSetup\n";
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";
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" .
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" .
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" .
858 # " 3 copy pop x-normalize moveto\n" .
859 # " exch pop x-normalize lineto\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" .
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" .
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";
882 print $OUT "/logo { gsave \n" .
885 " { setgray printText 1 -.5 translate } for \n" .
886 " 1 setgray printText\n" .
889 print $OUT "/logo { gsave \n" .
892 " { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
893 " 1 0 0 setrgbcolor printText\n" .
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";
902 print $OUT "/star \n" .
904 " currentpoint translate \n" .
905 " 4 {starside} repeat \n" .
908 " .7 setgray fill \n" .
912 #print $OUT "/get-shade % compute shade from intensity\n" .
913 # " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
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";
922 print $OUT "/from 0.5 def\n";
923 print $OUT "/to 0.9 def\n";
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";
931 "% show no. of runnable threads and the current degree of fetching\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";
943 print $OUT "% show no. of runable threads only\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";
951 print $OUT "% show no. of fetching threads only\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";
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" ) .
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" .
981 " fill % Note: No stroke => no border\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";
992 print $OUT "/A % No arrows \n" .
993 " { pop pop pop pop } def\n";
994 print $OUT "-90 rotate\n";
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";
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";
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";
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";
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";
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";
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";
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";
1144 print $OUT "0 20 translate\n";
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";
1155 print $OUT "20 0 translate\n";
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" .
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" .
1171 print $OUT "$x_scale $y_scale scale\n";
1173 print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
1176 print $OUT "% Debugging info : \n";
1178 print $OUT "% Offset is: $offset\n";
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";
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";
1188 print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
1192 # ----------------------------------------------------------------------------
1195 local ($OUT,$x_max, $y_max) = @_;
1196 local($x_scale,$y_scale);
1198 print $OUT "showpage\n";
1201 # ----------------------------------------------------------------------------
1205 local ($last_line, @fs);
1207 open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
1213 @fs = split(/[:\[\]\s]+/,$last_line);
1218 # ----------------------------------------------------------------------------
1221 # local ($now,$today,@lt);
1223 # @lt = localtime(time);
1224 # $now = join(":",reverse(splice(@lt,0,3)));
1225 # $today = join(".",splice(@lt,0,3));
1227 # return $now . " on " . $today;
1230 # ----------------------------------------------------------------------------
1235 open (DATE,"date |") || die ("$!");
1244 # -----------------------------------------------------------------------------
1246 sub generate_y_val_table {
1248 local($i, $y, $dist);
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;
1257 # print $OUT "10 5 translate\n";
1262 # ----------------------------------------------------------------------------
1268 for ($i=0; $i<$nPEs; $i++) {
1275 $running[$i] = $NO_ID;
1277 $last_sp_bg[$i] = $NO_LAST_BG;
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";
1292 # ----------------------------------------------------------------------------
1296 local($prg, $pars, $nPEs, $lat, $fetch, $in_header);
1300 if ( $in_header = 9 ) {
1305 $pars = "-b??????"; #
1306 $nPEs = $opt_p ? $opt_p : 1; #
1307 $lat = $opt_l ? $opt_l : 1;
1308 return ($prg, $pars, $nPEs, $lat);
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;
1320 last if /^\+\+\+\+\+/;
1323 return ($prg, $pars, $nPEs, $lat);
1326 # ----------------------------------------------------------------------------
1328 sub process_options {
1331 open(ME,$0) || die "Can't open myself ($0): $!\n";
1342 if ( $#ARGV != 0 ) {
1343 print "Usage: $0 [options] <gr-file>\n";
1344 print "Use -h option to get details\n";
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;
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";
1377 $inf_block = $opt_i;
1382 $RUNNABLE_file = $input;
1383 $RUNNABLE_file =~ s/\.gr//;
1384 $RUNNABLE_file .= "-R";
1386 $BLOCKED_file = $input;
1387 $BLOCKED_file =~ s/\.gr//;
1388 $BLOCKED_file .= "-B";
1390 $FETCHING_file = $input;
1391 $FETCHING_file =~ s/\.gr//;
1392 $FETCHING_file .= "-F";
1395 # ----------------------------------------------------------------------------
1397 sub print_verbose_message {
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" : "") .
1406 # ----------------------------------------------------------------------------
1407 # Junk from draw_segment:
1409 # if ( $type eq $RUNNING ) {
1410 # die "ERROR: This version should never draw a RUNNING segment!";
1412 # $x = $last_start[$pe];
1413 # $width = &get_width(0, $type);
1416 # if ( $is_very_big ) {
1417 # $x = int($x/$shrink_x) + 1; # rounded up
1420 # do ps_draw_hline(OUT_B,$x,$y,$time,$width);
1421 # do ps_draw_hline(OUT_R,$x,$y,$time,$width);
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);
1429 # if ( $is_very_big ) {
1430 # $x = int($x/$shrink_x) + 1; # rounded up
1434 # do ps_draw_hline(OUT_R,$x,$y,$time,$width);