2 ##############################################################################
4 # Usage: qp2ps.pl [options] <max-x> <prg> <date>
6 # Filter that transforms a quasi-parallel profile (a .qp file) at stdin to
7 # a PostScript file at stdout, showing essentially the total number of running,
8 # runnable and blocked tasks.
11 # -o <file> ... write PS file to <file>
12 # -m ... create mono PostScript file instead a color one.
13 # -O ... compress i.e. try to minimize the size of the .ps file
14 # -s <str> ... print <str> in the top right corner of the generated graph
15 # -i <int> ... info level from 1 to 7; number of queues to display
16 # -v ... be talkative.
17 # -h ... print help message (this header).
19 ##############################################################################
23 &Getopts('hvDOmSs:i:I:');
28 do print_verbose_message();
31 # ---------------------------------------------------------------------------
33 # ---------------------------------------------------------------------------
39 $labelx = $scalex - 45;
40 $markx = $scalex - 30;
55 $lines_per_flush = 100; # depends on the PS implementation you use
57 %color = ( "a", "green",
64 # ---------------------------------------------------------------------------
72 $time_of_second_event = 0;
76 ($time, $event, $tid, $addr, $tid2, $addr2) = split;
77 $time_of_second_event = $time if $time_of_second_event == 0;
80 $tottime += $G[$samples] * ($time-$T[$samples]);
87 if($G[$samples] < $amax && $A[$samples] > 0) {
88 printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " .
89 "R $R[$samples], B $B[$samples], " .
95 if($G[$samples] < 0 || $A[$samples] < 0 ||
96 $R[$samples] < 0 || $B[$samples] < 0 ||
98 printf(stderr "Error: Impossible number of tasks at time " .
99 "$T[$samples] (G $G[$samples], A $A[$samples], ".
100 "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
106 $eventfrom = substr($event,0,1);
107 $eventto = substr($event,1,1);
109 printf(stderr "$time $event $eventfrom $eventto\n") if $opt_D;
111 if ($eventfrom eq '*') {
114 elsif ($eventfrom eq 'G') {
118 elsif ($eventfrom eq 'A') {
122 elsif ($eventfrom eq 'R') {
126 elsif ($eventfrom eq 'B') {
130 elsif ($eventfrom eq 'C') {
134 elsif ($eventfrom eq 'Y') {
138 if ($eventto eq '*') {
141 elsif ($eventto eq 'G') {
145 elsif ($eventto eq 'A') {
150 elsif ($eventto eq 'R') {
155 elsif ($eventto eq 'B') {
160 elsif ($eventto eq 'C') {
165 elsif ($eventto eq 'Y') {
170 printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
171 "B $sparks, C $migrating\n") if 0;
173 $T[$samples] = $time;
174 $G[$samples] = &queue_on("a") ? $active : 0;
175 $A[$samples] = &queue_on("r") ? $runnable : 0;
176 $R[$samples] = &queue_on("b") ? $blocked : 0;
177 $Y[$samples] = &queue_on("f") ? $fetching : 0;
178 $B[$samples] = &queue_on("s") ? $sparks : 0;
179 $C[$samples] = &queue_on("m") ? $migrating : 0;
181 $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
182 $B[$samples] + $C[$samples] ;
190 die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
195 print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
198 # Average Parallelism
200 if ( 0 ) { # HACK warning; is this *always* correct -- HWL
201 $avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
203 $avg = $tottime/$time;
205 $avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
206 print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 525 moveto show\n");
207 $rt_str=sprintf("Runtime = %0.0f\n",$tmax);
208 print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 30 moveto show\n");
211 # -----------------------------------------------------------------------------
212 # Draw axes lines etc
213 # -----------------------------------------------------------------------------
219 # Draw dashed line for orientation (startup time) -- HWL
223 $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
224 $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
228 "[1 3] 1 setdash\n" .
229 "$x $y moveto 0 $h rlineto stroke\n" .
233 # and another one at the second event -- HWL
235 print STDERR "Time of second event is: $time_of_second_event" if $opt_D;
239 $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
240 $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
245 print "green setrgbcolor\n";
247 print "[3 5] 1 setdash\n" .
248 "$x $y moveto 0 $h rlineto stroke\n" .
254 # -----------------------------------------------------------------------------
255 # Draw the different kinds of tasks
256 # -----------------------------------------------------------------------------
258 $rshow = reverse($show);
259 print STDERR "\nReversed info-mask is : $rshow" if $opt_D;
260 print STDERR "\nMaximal y value is $pmax" if $opt_D;
261 for ($j=0; $j<length($rshow); $j++) {
262 $x = substr($rshow,$j,1);
263 print STDERR "Queue = $x i.e. " . ($color{$x}) . "\n" if $opt_D;
264 print("$xmin $ymin moveto\n");
265 for($i=1; $i <= $samples; $i++) {
266 do psout($T[$i],&count($x,$i));
267 if ($i % $lines_per_flush == 0) {
268 print($color{$x} . " flush-it\n");
271 # print("$xmax $ymin L\n");
274 print "closepath " . ($color{$x}) . " setgray fill\n";
276 print "closepath " . ($color{$x}) . " setrgbcolor fill\n";
280 # -----------------------------------------------------------------------------
284 print("HE14 setfont\n");
286 print("50 530 asciilogo\n");
288 print("50 530 logo\n");
296 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
297 # -----------------------------------------------------------------------------
298 # Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the
299 # x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
300 # In case of optimization ($opt_O):
301 # If there is a sequence of (x,y) pairs with same x value, then just
302 # print the first and the last pair in the seqence. To do that, $last_x
303 # always contains the scaled x-val of the last point. $last_y contains
304 # the y-val of the last point in the current sequence (it is 0 outside a
306 # -----------------------------------------------------------------------------
311 $x = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
313 $x = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
315 $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
317 die "Error in psout: Neg x coordinate\n" if ($x < 0) ;
320 if ( $last_x == $x ) { # If seq before $x that then print last pt
325 } else { # If seq with same $x val then ignore pts
326 if ( $in_seq ) { # Seq before that -> print last in seq
327 print("$last_x $last_y L\n") if ($first_y != $last_y);
339 # -----------------------------------------------------------------------------
344 return index($show,$queue)+1;
347 # -----------------------------------------------------------------------------
350 local ($queue,$index) = @_;
353 $where = &queue_on($queue);
354 $res = ((&queue_on("a") && (&queue_on("a")<=$where)) ? $G[$index] : 0) +
355 ((&queue_on("r") && (&queue_on("r")<=$where)) ? $A[$index] : 0) +
356 ((&queue_on("b") && (&queue_on("b")<=$where)) ? $R[$index] : 0) +
357 ((&queue_on("f") && (&queue_on("f")<=$where)) ? $Y[$index] : 0) +
358 ((&queue_on("m") && (&queue_on("m")<=$where)) ? $B[$index] : 0) +
359 ((&queue_on("s") && (&queue_on("s")<=$where)) ? $C[$index] : 0);
364 # -----------------------------------------------------------------------------
369 open (DATE,"date |") || die ("$!");
378 # -----------------------------------------------------------------------------
383 $date = do get_date();
385 print("%!PS-Adobe-2.0\n");
386 print("%%BoundingBox: 0 0 560 800\n");
387 print("%%Title: Activity Profile\n");
388 print("%%Creator: qp2ps.pl\n");
389 print("%%CreationDate: $date\n");
390 print("%%EndComments\n");
391 #print ("/greenlineto {1.0 setlinewidth lineto} def\n");
392 #print ("/amberlineto {0.5 setlinewidth lineto} def\n");
393 #print ("/redlineto {1.5 setlinewidth lineto} def\n");
394 #print ("/G {newpath moveto greenlineto stroke} def\n");
395 #print ("/A {newpath moveto amberlineto stroke} def\n");
396 #print ("/R {newpath moveto redlineto stroke} def\n");
399 print "/red { 0.5 } def\n";
400 print "/green { 0 } def\n";
401 print "/blue { 0.7 } def\n";
402 print "/crimson { 0.8 } def\n";
403 print "/amber { 0.9 } def\n";
404 print "/cyan { 0.3 } def\n";
406 print "/red { 0.8 0 0 } def\n";
407 print "/green { 0 0.9 0.1 } def\n";
408 print "/blue { 0 0.1 0.9 } def\n";
409 print "/crimson { 0.7 0.5 0 } def\n";
410 print "/amber { 0.9 0.7 0.2 } def\n";
411 print "/cyan { 0 0.6 0.9 } def\n";
414 print "/printText { 0 0 moveto (GrAnSim) show } def\n";
417 print "/logo { gsave \n" .
420 " { setgray printText 1 -.5 translate } for \n" .
421 " 1 setgray printText\n" .
424 print "/logo { gsave \n" .
427 " { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
428 " 1 0 0 setrgbcolor printText\n" .
432 print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
433 print "/cmpx {pop exch pop eq} def % compare x-coors of 2 points\n";
434 print "/cmpy {exch pop 3 2 roll pop eq} def % compare y-coors of 2 points\n";
435 print "/cmp {2 index eq {exch pop eq} % compare 2 points\n";
436 print " {pop pop pop false} ifelse } def\n";
437 print "%/L { lineto } def\n";
438 print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n";
439 print "/L {2 copy currentpoint cmpx not\n";
440 print " {2 copy pop currentpoint exch pop lineto} if\n";
441 print " 2 copy currentpoint cmpy \n";
442 print " {pop pop} \n";
443 print " {lineto} ifelse\n";
445 print "/flush-it { % draw a segment of the overall area; Arg: color\n";
446 print " currentpoint \n";
447 print " 1 index 50 lineto closepath\n";
449 print " 3 2 roll setgray fill \n";
451 print " 5 2 roll setrgbcolor fill \n";
453 print " 1 index 50 moveto lineto \n";
455 print "% For debugging PS uncomment this line and add the file behandler.ps\n";
456 print "% $brkpage begin printonly endprint \n";
457 print("/HE10 /Helvetica findfont 10 scalefont def\n");
458 print("/HE12 /Helvetica findfont 12 scalefont def\n");
459 print("/HE14 /Helvetica findfont 14 scalefont def\n");
460 print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
461 print "% " . "-" x 77 . "\n";
463 print("-90 rotate\n");
464 print("-785 30 translate\n");
466 print("0 8 moveto\n");
467 print("0 525 760 525 8 arcto\n");
468 print("4 {pop} repeat\n");
469 print("760 525 760 0 8 arcto\n");
470 print("4 {pop} repeat\n");
471 print("760 0 0 0 8 arcto\n");
472 print("4 {pop} repeat\n");
473 print("0 0 0 525 8 arcto\n");
474 print("4 {pop} repeat\n");
475 print("0.500000 setlinewidth\n");
478 print("4 505 moveto\n");
479 print("4 521 752 521 4 arcto\n");
480 print("4 {pop} repeat\n");
481 print("752 521 752 501 4 arcto\n");
482 print("4 {pop} repeat\n");
483 print("752 501 4 501 4 arcto\n");
484 print("4 {pop} repeat\n");
485 print("4 501 4 521 4 arcto\n");
486 print("4 {pop} repeat\n");
487 print("0.500000 setlinewidth\n");
490 print("HE14 setfont\n");
491 print("100 505 moveto\n");
492 print("($pname ) show\n");
494 # print("($date) dup stringwidth pop 750 exch sub 505 moveto show\n");
496 print("4 8 moveto\n");
497 print("4 24 756 24 4 arcto\n");
498 print("4 {pop} repeat\n");
499 print("756 24 756 4 4 arcto\n");
500 print("4 {pop} repeat\n");
501 print("756 4 4 4 4 arcto\n");
502 print("4 {pop} repeat\n");
503 print("4 4 4 24 4 arcto\n");
504 print("4 {pop} repeat\n");
505 print("0.500000 setlinewidth\n");
517 $no_of_labels = length($show); # $info_level;
519 $step = ($x_end-$x_begin)/($no_of_labels);
523 if ( &queue_on("a") ) {
524 do print_box_and_label($x_now,$y_label,"green","running");
527 if ( &queue_on("r") ) {
529 do print_box_and_label($x_now,$y_label,"amber","runnable");
532 if ( &queue_on("f") ) {
534 do print_box_and_label($x_now,$y_label,"cyan","fetching");
537 if ( &queue_on("b") ) {
539 do print_box_and_label($x_now,$y_label,"red","blocked");
542 if ( &queue_on("m") ) {
544 do print_box_and_label($x_now,$y_label,"blue","migrating");
547 if ( &queue_on("s") ) {
549 do print_box_and_label($x_now,$y_label,"crimson","sparked");
552 # Print runtime of prg; this is jus a crude HACK; better: x-axis! -- HWL
553 #print("HE10 setfont\n");
554 #print("680 10 moveto\n");
555 #print("(RT: $tmax) show\n");
557 print("-40 -20 translate\n");
560 # -----------------------------------------------------------------------------
562 sub print_box_and_label {
563 local ($x,$y,$color,$label) = @_;
566 print("$x 10 moveto\n");
567 print("0 10 rlineto\n");
568 print("10 0 rlineto\n");
569 print("0 -10 rlineto\n");
570 print("closepath\n");
573 print("$color setgray\n");
575 print("$color setrgbcolor\n");
580 print("HE14 setfont\n");
581 print(($x+$z) . " 10 moveto\n");
582 print("($label) show\n");
586 # -----------------------------------------------------------------------------
594 print("HE12 setfont\n");
596 print("dup stringwidth pop\n");
599 print("$labelx exch\n");
600 print("translate\n");
601 print("90 rotate\n");
602 print("0 0 moveto\n");
611 print "0 0 0 setrgbcolor\n";
614 print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
616 if ($pmax < $majorticks) {
620 $majormax = int($pmax/$majorticks)*$majorticks;
621 $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
622 $majorint = $majormax/$majorticks;
624 for($i=0; $i <= $majorticks; ++$i) {
625 $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
626 $majorval = int($majorint * ($majormax/$majorint-$i));
627 print("$scalex $y moveto\n$major $y lineto\n");
628 print("$markx $y moveto\n($majorval) show\n");
631 # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
635 # -----------------------------------------------------------------------------
637 sub print_verbose_message {
639 print "Prg Name: $pname Date: $date Info-str: $show\n";
640 print "Input: stdin Output: stdout\n";
643 # ----------------------------------------------------------------------------
645 sub process_options {
648 open(ME,$0) || die "Can't open myself ($0): $!\n";
660 print "Usage: $0 [options] <max y value> <prg name> <date> \n";
661 print "Use -h option to get details\n";
678 $show = "a" if info_level == 1;
679 $show = "ar" if info_level == 2;
680 $show = "arb" if info_level == 3;
681 $show = "arfb" if info_level == 4;
682 $show = "armfb" if info_level == 5;
683 $show = "armfbs" if info_level == 6;
695 # printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
700 # -----------------------------------------------------------------------------
701 # Old way of drawing areas
702 # -----------------------------------------------------------------------------
707 if ($someblocked && ($info_level >= 3)) {
708 print("$xmin $ymin moveto\n");
709 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
710 do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]+$R[$i]);
711 if ($i % $lines_per_flush == 0) {
712 print("red flush-it\n");
715 # print("$xmax $ymin L\n");
718 print "closepath red setgray fill\n";
720 print "closepath red setrgbcolor fill\n";
725 if ($somefetching && ($info_level >= 4)) {
726 print("$xmin $ymin moveto\n");
727 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
728 do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]);
729 if ($i % $lines_per_flush == 0) {
730 print("cyan flush-it\n");
733 # print("$xmax $ymin L\n");
736 print "closepath cyan setgray fill\n";
738 print "closepath cyan setrgbcolor fill\n";
743 if ($somesparks && ($info_level >= 6)) {
744 print("$xmin $ymin moveto\n");
745 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
746 do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]);
747 if ($i % $lines_per_flush == 0) {
748 print("crimson flush-it\n");
751 # print("$xmax $ymin L\n");
754 print "closepath crimson setgray fill\n";
756 print "closepath crimson setrgbcolor fill\n";
761 if ($somemigratory && ($info_level >= 5)) {
762 print("$xmin $ymin moveto\n");
763 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
764 do psout($T[$i],$G[$i]+$A[$i]+$C[$i]);
765 if ($i % $lines_per_flush == 0) {
766 print("blue flush-it\n");
769 # print("$xmax $ymin L\n");
770 # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
772 print "closepath blue setgray fill\n";
774 print "closepath blue setrgbcolor fill\n";
779 if($somerunnable && ($info_level >= 2)) {
780 print("$xmin $ymin moveto\n");
781 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
782 do psout($T[$i],$G[$i]+$A[$i]);
783 if ($i % $lines_per_flush == 0) {
784 print("amber flush-it\n");
787 # print("$xmax $ymin L\n");
788 # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
790 print "closepath amber setgray fill\n";
792 print "closepath amber setrgbcolor fill\n";
797 if ($info_level >= 1) {
798 print("$xmin $ymin moveto\n");
799 for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
800 do psout($T[$i],$G[$i]);
801 if ($i % $lines_per_flush == 0) {
802 print("green flush-it\n");
805 # print("$xmax $ymin L\n");
806 # print("closepath\ngsave\n0.5 setgray\nfill\ngrestore\nstroke\n");
808 print "closepath green setgray fill\n";
810 print "closepath green setrgbcolor fill\n";