X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fparallel%2Fqp2ps.pl;h=2fb090346a38ffdc826edee8d23e2cdc178f93c3;hb=387a411e5d6478249de6872c283f2df78ef83bf4;hp=d671cb89374830c90e2127145b3ac2afd17617ff;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/utils/parallel/qp2ps.pl b/ghc/utils/parallel/qp2ps.pl index d671cb8..2fb0903 100644 --- a/ghc/utils/parallel/qp2ps.pl +++ b/ghc/utils/parallel/qp2ps.pl @@ -1,18 +1,31 @@ #! /usr/local/bin/perl ############################################################################## +# Time-stamp: # -# Usage: qp2ps.pl [options] +# Usage: qp2ps [options] # # Filter that transforms a quasi-parallel profile (a .qp file) at stdin to # a PostScript file at stdout, showing essentially the total number of running, # runnable and blocked tasks. # # Options: -# -o ... write PS file to +# -o ... write .ps file to # -m ... create mono PostScript file instead a color one. # -O ... compress i.e. try to minimize the size of the .ps file # -s ... print in the top right corner of the generated graph # -i ... info level from 1 to 7; number of queues to display +# -I ... queues to be displayed (in the given order) with the encoding +# 'a' ... active (running) +# 'r' ... runnable +# 'b' ... blocked +# 'f' ... fetching +# 'm' ... migrating +# 's' ... sparks +# (e.g. -I "arb" shows active, runnable, blocked tasks) +# -l ... length of a slice in the .ps file; (default: 100) +# small value => less memory consumption of .ps file & script +# but slower in generating the .ps file +# -d ... Print date instead of average parallelism # -v ... be talkative. # -h ... print help message (this header). # @@ -20,7 +33,7 @@ require "getopts.pl"; -&Getopts('hvDOmSs:i:I:'); +&Getopts('hvDCOmdl:s:i:I:H'); do process_options(); @@ -32,6 +45,8 @@ if ( $opt_v ) { # Init # --------------------------------------------------------------------------- +$y_scaling = 1.0; + $xmin = 100; $xmax = 790; @@ -41,7 +56,8 @@ $markx = $scalex - 30; $major = $scalex - 5; $majorticks = 10; -$pmax = 1; +$mmax = 1; + $amax = 0; $ymin = 50; $ymax = 500; @@ -49,64 +65,78 @@ $ymax = 500; $active = 0; $runnable = 0; $blocked = 0; -$sparks = 0; $fetching = 0; +$migrating = 0; +$sparks = 0; -$lines_per_flush = 100; # depends on the PS implementation you use +#$lines_per_flush = 100; # depends on the PS implementation you use -%color = ( "a", "green", - "r", "amber", - "b", "red", - "f", "cyan", - "m", "blue", - "s", "crimson" ); +%color = ( "a", "green", # active + "r", "amber", # runnable + "b", "red", # blocked + "f", "cyan", # fetching + "m", "blue", # migrating + "s", "crimson" ); # sparks # --------------------------------------------------------------------------- do print_prolog(); $otime = -1; -$last_x = -1; -$last_y = -1; -$in_seq = 0; $time_of_second_event = 0; +$samples = 0; + +$T[0] = 0; +$G[0] = 0; +$A[0] = 0; +$R[0] = 0; +$B[0] = 0; +$Y[0] = 0; while() { + next if /^[^0-9]/; # ignore lines not beginning with a digit (esp. last) chop; ($time, $event, $tid, $addr, $tid2, $addr2) = split; $time_of_second_event = $time if $time_of_second_event == 0; if($time != $otime) { $tottime += $G[$samples] * ($time-$T[$samples]); + $otime = $time; + } - if($active > $amax) { - $amax = $active; - } + if($active > $amax) { + $amax = $active; + } - if ( $opt_D ) { - if($G[$samples] < $amax && $A[$samples] > 0) { - printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " . - "R $R[$samples], B $B[$samples], " . - "Y $Y[$samples]\n"); - } + if ( $opt_D ) { + if($G[$samples] < $amax && $A[$samples] > 0) { + printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " . + "R $R[$samples], B $B[$samples], " . + "Y $Y[$samples]\n"); } + } - # Reality Check - if($G[$samples] < 0 || $A[$samples] < 0 || - $R[$samples] < 0 || $B[$samples] < 0 || - $Y[$samples] < 0) { - printf(stderr "Error: Impossible number of tasks at time " . - "$T[$samples] (G $G[$samples], A $A[$samples], ". - "R $R[$samples], B $B[$samples], Y $Y[$samples])\n"); - } - $samples++; - $otime = $time; + # Reality Check + if($G[$samples] < 0 || $A[$samples] < 0 || + $R[$samples] < 0 || $B[$samples] < 0 || + $Y[$samples] < 0) { + printf(stderr "Error: Impossible number of tasks at time " . + "$T[$samples] (G $G[$samples], A $A[$samples], ". + "R $R[$samples], B $B[$samples], Y $Y[$samples])\n") if $opt_v || $opt_D; + if ( $opt_H ) { # HACK + $G[$samples] = 0 if $G[$samples] < 0; + $A[$samples] = 0 if $A[$samples] < 0; + $R[$samples] = 0 if $R[$samples] < 0; + $B[$samples] = 0 if $B[$samples] < 0; + $Y[$samples] = 0 if $Y[$samples] < 0; + } } + $samples++; $eventfrom = substr($event,0,1); $eventto = substr($event,1,1); - printf(stderr "$time $event $eventfrom $eventto\n") if $opt_D; + printf(stderr "$time $event $eventfrom $eventto\n") if 0 && $opt_D; if ($eventfrom eq '*') { } @@ -167,27 +197,84 @@ while() { $somefetching = 1; } - printf(stderr "%% $time: G $active, A $runnable, R $blocked, " . - "B $sparks, C $migrating\n") if 0; - $T[$samples] = $time; - $G[$samples] = &queue_on("a") ? $active : 0; - $A[$samples] = &queue_on("r") ? $runnable : 0; - $R[$samples] = &queue_on("b") ? $blocked : 0; - $Y[$samples] = &queue_on("f") ? $fetching : 0; - $B[$samples] = &queue_on("s") ? $sparks : 0; - $C[$samples] = &queue_on("m") ? $migrating : 0; + #printf(stderr "%% $time: G $active, A $runnable, R $blocked, " . + # "B $sparks, C $migrating\n") if 1; + + printf(stderr "Error: Trying to write at index 0!\n") if $samples == 0; + $T[$samples] = $time; + do set_values($samples, + $active,$runnable,$blocked,$fetching,$sparks,$migrating); + + #$G[$samples] = queue_on_a ? $active : 0; + #$A[$samples] = queue_on_r ? $runnable : 0; + #$R[$samples] = queue_on_b ? $blocked : 0; + #$Y[$samples] = queue_on_f ? $fetching : 0; + #$B[$samples] = queue_on_s ? $sparks : 0; + #$C[$samples] = queue_on_m ? $migrating : 0; $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] + $B[$samples] + $C[$samples] ; - if($all > $pmax) { - $pmax = $all; + if($all > $mmax) { + $mmax = $all; + } + + if ( 0 ) { + print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " . + "($active, $runnable, $blocked, $fetching, $migrating, $sparks)". + " max = $all\n" ; + } + + #print STDERR "Sparks @ $time: $sparks \tAll: $all \tMMax: $mmax\n" if $opt_D; + + if ( $samples >= $slice_width ) { + do flush_queues(); + $samples = 0; } + +} # + +do flush_queues(); +print "%% End\n" if $opt_C; + +# For debugging only +if ($opt_D) { + printf(stderr "Queue values after last event: " . + "$T[$samples] (G $G[$samples], A $A[$samples], ". + "R $R[$samples], B $B[$samples], Y $Y[$samples])\n"); } if($time != $tmax) { - die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n"; + if ( $pedantic ) { + die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n"; + } else { # + print STDERR "Warning: Calculated time ($time) does not agree with stated max. time ($tmax)\n" if $opt_v; + } +} + +# HACK warning: +# The real max-y value ($mmax) might differ from the one that is the input +# to this script ($pmax). If so, we post-process the generated ps-file +# and place an appropriate scaling fct into the header of the ps-file. +# This is done by yet another perl-script: +# ps-scale-y + +if($pmax != $mmax) { + if ( $pedantic ) { + die "Error: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n"; + } else { + print STDERR "Warning: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n" if $opt_v; + $y_scaling = $pmax/$mmax; #((float) $pmax)/((float) $mmax); + } +} + +print "% " . ("-" x 75) . "\n"; + +if ( $opt_m ) { + print "0 setgray\n"; +} else { + print "0 0 0 setrgbcolor\n"; } # Print optional str @@ -195,26 +282,32 @@ if($time != $tmax) { print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n"); } + print("unscale-y\n"); + # Average Parallelism if($time > 0) { - if ( 0 ) { # HACK warning; is this *always* correct -- HWL + if ( $opt_S ) { # HACK warning; is this *always* correct -- HWL $avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event); } else { $avg = $tottime/$time; } - $avgs=sprintf("Average Parallelism = %0.1f\n",$avg); - print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 525 moveto show\n"); + if ( $opt_d ) { # Print date instead of average parallelism + print("HE14 setfont ($date) dup stringwidth pop 790 exch sub 515 moveto show\n"); + } else { + $avgs=sprintf("Average Parallelism = %0.1f\n",$avg); + print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 515 moveto show\n"); + } $rt_str=sprintf("Runtime = %0.0f\n",$tmax); - print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 30 moveto show\n"); + print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 20 moveto show\n"); } +# do print_y_axis(); + # ----------------------------------------------------------------------------- # Draw axes lines etc # ----------------------------------------------------------------------------- -do print_y_axis(); - -# if ( ! $opt_S ) { +if ( ! $opt_S ) { # Draw dashed line for orientation (startup time) -- HWL @@ -232,7 +325,7 @@ if ( $draw_lines ) { # and another one at the second event -- HWL -print STDERR "Time of second event is: $time_of_second_event" if $opt_D; +print STDERR "Time of second event is: $time_of_second_event" if 0 && $opt_D; if ( $draw_lines ) { local($x, $y); @@ -249,52 +342,71 @@ if ( $draw_lines ) { "grestore\n"; } -# } - -# ----------------------------------------------------------------------------- -# Draw the different kinds of tasks -# ----------------------------------------------------------------------------- - -$rshow = reverse($show); -print STDERR "\nReversed info-mask is : $rshow" if $opt_D; -print STDERR "\nMaximal y value is $pmax" if $opt_D; -for ($j=0; $j ($foo_x,$foo_y)\n" if $opt_C; + # print($color{$q} . " flush-it\n"); + # print("$xmax $ymin L\n"); + } + do wrap($samples); + + #print "% Last sample T $T[$samples] (G $G[$samples], A $A[$samples], ". + # " R $R[$samples], B $B[$samples], Y $Y[$samples])\n" if $opt_C; +} + +# ----------------------------------------------------------------------------- # Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the # x-(time-) axis fits between $xmin and $xmax (range for .ps graph). # In case of optimization ($opt_O): @@ -305,15 +417,42 @@ exit 0; # sequence!). # ----------------------------------------------------------------------------- -sub psout { +sub normalize { local($x, $y ) = @_; + local($x_norm, $y_norm ); + if ( $opt_S ) { - $x = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin); + $x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin); } else { - $x = int(($x/$tmax) * ($xmax-$xmin) + $xmin); + $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin); } - $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin); + $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin); + + return (($x_norm, $y_norm)); +} + +# ----------------------------------------------------------------------------- + +sub init_psout { + local ($q, $x, $y) = @_; + local ($x_norm, $y_norm); + ($last_x, $last_y, $in_seq) = (-1, -1, 0); + ($x_norm, $y_norm) = &normalize($T[0],&count($q,0)); + $last_x = $x_norm; + $last_y = $y_norm; + print "%% Begin " . ($color{$q}) . " (" . $T[0] . ", " . &count($q,0) . ") -> ($x_norm,$y_norm)\n" if $opt_C; + print $x_norm, " ", $y_norm, " M\n"; + +} + +# ---------------------------------------------------------------------------- + +sub psout { + local($x_in, $y_in ) = @_; + local($x, $y ); + + ($x, $y) = &normalize($x_in, $y_in); die "Error in psout: Neg x coordinate\n" if ($x < 0) ; if ( $opt_O ) { @@ -346,47 +485,99 @@ sub queue_on { # ----------------------------------------------------------------------------- -sub count{ +sub count { local ($queue,$index) = @_; local ($res); $where = &queue_on($queue); - $res = ((&queue_on("a") && (&queue_on("a")<=$where)) ? $G[$index] : 0) + - ((&queue_on("r") && (&queue_on("r")<=$where)) ? $A[$index] : 0) + - ((&queue_on("b") && (&queue_on("b")<=$where)) ? $R[$index] : 0) + - ((&queue_on("f") && (&queue_on("f")<=$where)) ? $Y[$index] : 0) + - ((&queue_on("m") && (&queue_on("m")<=$where)) ? $B[$index] : 0) + - ((&queue_on("s") && (&queue_on("s")<=$where)) ? $C[$index] : 0); + $res = (($queue_on_a && ($queue_on_a<=$where)) ? $G[$index] : 0) + + (($queue_on_r && ($queue_on_r<=$where)) ? $A[$index] : 0) + + (($queue_on_b && ($queue_on_b<=$where)) ? $R[$index] : 0) + + (($queue_on_f && ($queue_on_f<=$where)) ? $Y[$index] : 0) + + (($queue_on_m && ($queue_on_m<=$where)) ? $C[$index] : 0) + + (($queue_on_s && ($queue_on_s<=$where)) ? $B[$index] : 0); return $res; } # ----------------------------------------------------------------------------- +sub set_values { + local ($samples, + $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_; + + $G[$samples] = $queue_on_a ? $active : 0; + $A[$samples] = $queue_on_r ? $runnable : 0; + $R[$samples] = $queue_on_b ? $blocked : 0; + $Y[$samples] = $queue_on_f ? $fetching : 0; + $B[$samples] = $queue_on_s ? $sparks : 0; + $C[$samples] = $queue_on_m ? $migrating : 0; +} + +# ----------------------------------------------------------------------------- + +sub set_queue_val { + local ($queue,$index,$val) = @_; + + if ( $queue == "a" ) { $G[$index] = $val; } + elsif ( $queue == "r" ) { $A[$index] = $val; } + elsif ( $queue == "b" ) { $R[$index] = $val; } + elsif ( $queue == "f" ) { $Y[$index] = $val; } + elsif ( $queue == "m" ) { $C[$index] = $val; } + elsif ( $queue == "s" ) { $B[$index] = $val; } +} + +# ----------------------------------------------------------------------------- + +sub wrap { # used in flush_queues at the end of a slice + local ($index) = @_; + + $T[0] = $T[$index]; + + $G[0] = $G[$index]; + $A[0] = $A[$index]; + $R[0] = $R[$index]; + $Y[0] = $Y[$index]; + $B[0] = $B[$index]; + $C[0] = $C[$index]; +} + +# ----------------------------------------------------------------------------- + +sub get_queue_val { + local ($queue,$index) = @_; + + if ( $queue == "a" ) { return $G[$index]; } + elsif ( $queue == "r" ) { return $A[$index]; } + elsif ( $queue == "b" ) { return $R[$index]; } + elsif ( $queue == "f" ) { return $Y[$index]; } + elsif ( $queue == "m" ) { return $C[$index]; } + elsif ( $queue == "s" ) { return $B[$index]; } +} + +# ----------------------------------------------------------------------------- + sub get_date { local ($date); - open (DATE,"date |") || die ("$!"); - while () { - $date = $_; - } - close (DATE); - + chop($date = `date`); return ($date); } # ----------------------------------------------------------------------------- sub print_prolog { - local ($date); + local ($now); - $date = do get_date(); + $now = do get_date(); print("%!PS-Adobe-2.0\n"); print("%%BoundingBox: 0 0 560 800\n"); print("%%Title: Activity Profile\n"); - print("%%Creator: qp2ps.pl\n"); - print("%%CreationDate: $date\n"); + print("%%Creator: qp2ps\n"); + print("%%StartTime: $date\n"); + print("%%CreationDate: $now\n"); + print("%%Copyright: 1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n"); print("%%EndComments\n"); #print ("/greenlineto {1.0 setlinewidth lineto} def\n"); #print ("/amberlineto {0.5 setlinewidth lineto} def\n"); @@ -396,8 +587,8 @@ sub print_prolog { #print ("/R {newpath moveto redlineto stroke} def\n"); if ( $opt_m ) { - print "/red { 0.5 } def\n"; - print "/green { 0 } def\n"; + print "/red { 0 } def\n"; + print "/green { 0.5 } def\n"; print "/blue { 0.7 } def\n"; print "/crimson { 0.8 } def\n"; print "/amber { 0.9 } def\n"; @@ -434,6 +625,31 @@ sub print_prolog { print "/cmpy {exch pop 3 2 roll pop eq} def % compare y-coors of 2 points\n"; print "/cmp {2 index eq {exch pop eq} % compare 2 points\n"; print " {pop pop pop false} ifelse } def\n"; + + # Hook for scaling just the graph and y-axis + print "% " . "-" x 77 . "\n"; + print "/scale-y { } def\n"; + print "/unscale-y { } def\n"; + + print "% " . "-" x 77 . "\n"; + print "/str-len 12 def\n"; + print "/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"; + # NB: These PostScript functions must correspond to the Perl fct `normalize' + # Currently normalize defines the following trafo on (x,y) values: + # $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin); + # $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin); + + print "/total-len $tmax def\n"; + print "/show-len $xmax def\n"; + print "/x-offset $xmin def\n"; + print "/y-offset $ymin def\n"; + print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n"; + print "% " . "-" x 77 . "\n"; print "%/L { lineto } def\n"; print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n"; print "/L {2 copy currentpoint cmpx not\n"; @@ -442,15 +658,17 @@ sub print_prolog { print " {pop pop} \n"; print " {lineto} ifelse\n"; print "} def\n"; - print "/flush-it { % draw a segment of the overall area; Arg: color\n"; - print " currentpoint \n"; - print " 1 index 50 lineto closepath\n"; + print "/F { % flush a segment of the overall area; Arg: color\n"; + print " currentpoint pop $ymin lineto closepath\n"; if ( $opt_m ) { - print " 3 2 roll setgray fill \n"; + print " setgray fill \n"; } else { - print " 5 2 roll setrgbcolor fill \n"; + print " setrgbcolor fill \n"; } - print " 1 index 50 moveto lineto \n"; + print "} def\n"; + print "/M { % Start drawing a slice (vert. line and moveto startpoint)\n"; + print " % Arg: x y\n"; + print " newpath 1 index $ymin moveto lineto\n"; print "} def\n"; print "% For debugging PS uncomment this line and add the file behandler.ps\n"; print "% $brkpage begin printonly endprint \n"; @@ -520,31 +738,31 @@ sub print_prolog { $x_now = $x_begin; - if ( &queue_on("a") ) { + if ( $queue_on_a ) { do print_box_and_label($x_now,$y_label,"green","running"); } - if ( &queue_on("r") ) { + if ( $queue_on_r ) { $x_now += $step; do print_box_and_label($x_now,$y_label,"amber","runnable"); } - if ( &queue_on("f") ) { + if ( $queue_on_f ) { $x_now += $step; do print_box_and_label($x_now,$y_label,"cyan","fetching"); } - if ( &queue_on("b") ) { + if ( $queue_on_b ) { $x_now += $step; do print_box_and_label($x_now,$y_label,"red","blocked"); } - if ( &queue_on("m") ) { + if ( $queue_on_m ) { $x_now += $step; do print_box_and_label($x_now,$y_label,"blue","migrating"); } - if ( &queue_on("s") ) { + if ( $queue_on_s ) { $x_now += $step; do print_box_and_label($x_now,$y_label,"crimson","sparked"); } @@ -554,7 +772,21 @@ sub print_prolog { #print("680 10 moveto\n"); #print("(RT: $tmax) show\n"); - print("-40 -20 translate\n"); + print("-40 -10 translate\n"); + + do print_x_axis(); + + print("$xmin $ymin moveto\n"); + if ( $opt_m ) { + print "0 setgray\n"; + } else { + print "0 0 0 setrgbcolor\n"; + } + + do print_y_axis(); + + print("scale-y\n"); + } # ----------------------------------------------------------------------------- @@ -585,11 +817,36 @@ sub print_box_and_label { # ----------------------------------------------------------------------------- +sub print_x_axis { + + print "% " . "-" x 77 . "\n"; + print "% X-Axis:\n"; + print "/y-val $ymin def\n"; + print "0.5 setlinewidth\n"; + print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n"; + print "0 total-len 10 div total-len\n" . + " { dup normalize dup y-val moveto 0 -2 rlineto stroke % tic\n" . + " y-val 10 sub moveto HE10 setfont round prt-n % print label \n" . + " } for \n"; + print "1 setlinewidth\n"; + print "% End X-Axis:\n"; + print "% " . "-" x 77 . "\n"; +} + +# ----------------------------------------------------------------------------- + sub print_y_axis { local ($i); + local ($y, $smax,$majormax, $majorint); # Y-axis label + print "% " . ("-" x 75) . "\n"; + print "% Y-Axis:\n"; + print "% " . ("-" x 75) . "\n"; + + print("%scale-y % y-axis outside scaled area if ps-scale-y rebuilds it!\n"); + print("gsave\n"); print("HE12 setfont\n"); print("(tasks)\n"); @@ -605,23 +862,25 @@ sub print_y_axis { # Scale - if ( $opt_m ) { - print "0 setgray\n"; - } else { - print "0 0 0 setrgbcolor\n"; + if ($pmax < $majorticks) { + $majorticks = $pmax; } print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n"); + print("% Max number of tasks: $pmax\n"); + print("% Number of ticks: $majorticks\n"); - if ($pmax < $majorticks) { - $majorticks = $pmax; - } + print "0.5 setlinewidth\n"; + + $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin; + print("$scalex $y moveto\n$major $y lineto\n"); + print("$markx $y moveto\n($pmax) show\n"); $majormax = int($pmax/$majorticks)*$majorticks; $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin; $majorint = $majormax/$majorticks; - for($i=0; $i <= $majorticks; ++$i) { + for($i=1; $i <= $majorticks; ++$i) { $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin; $majorval = int($majorint * ($majormax/$majorint-$i)); print("$scalex $y moveto\n$major $y lineto\n"); @@ -630,14 +889,32 @@ sub print_y_axis { # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n"); print " stroke\n"; + print "1 setlinewidth\n"; + print "%unscale-y\n"; + print "% End Y-Axis.\n"; + print "% " . ("-" x 75) . "\n"; } # ----------------------------------------------------------------------------- sub print_verbose_message { - print "Prg Name: $pname Date: $date Info-str: $show\n"; - print "Input: stdin Output: stdout\n"; + print STDERR "Prg Name: $pname \nDate: $date \nInfo-str: $show\n"; + print STDERR "Input: stdin Output: stdout\n"; + print STDERR "The following queues are turned on: " . + ( $queue_on_a ? "active, " : "") . + ( $queue_on_r ? "runnable, " : "") . + ( $queue_on_b ? "blocked, " : "") . + ( $queue_on_f ? "fetching, " : "") . + ( $queue_on_m ? "migrating, " : "") . + ( $queue_on_s ? "sparks" : "") . + "\n"; + if ( $opt_C ) { + print STDERR "Inserting check code into .ps file (for check-ps3 script)\n"; + } + if ( $opt_D ) { + print STDERR "Debugging is turned ON!\n"; + } } # ---------------------------------------------------------------------------- @@ -656,23 +933,22 @@ sub process_options { exit ; } - if ( $#ARGV != 2 ) { - print "Usage: $0 [options] \n"; + if ( $#ARGV != 3 ) { + print "Usage: $0 [options] \n"; print "Use -h option to get details\n"; exit 1; } $tmax = $ARGV[0]; - $pname = $ARGV[1]; - $date = $ARGV[2]; + $pmax = $ARGV[1]; + # GUM uses the absolute path (with '=' instead of '/') of the executed file + # (for PVM reasons); if you want to have the full path in the generated + # graph, too, eliminate the substitution below + ($pname = $ARGV[2]) =~ s/.*=//; + $date = $ARGV[3]; $show = "armfb"; - - if ( $opt_S ) { - $draw_lines = 1; - } else { - $draw_lines = 0; - } + $draw_lines = 0; if ( $opt_i ) { $show = "a" if info_level == 1; @@ -691,123 +967,22 @@ sub process_options { $verbose = 1; } -# if ($#ARGV == 0) { -# printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n"); -# exit 1; -# } -} - -# ----------------------------------------------------------------------------- -# Old way of drawing areas -# ----------------------------------------------------------------------------- - -exit 0; - -# Blocked Tasks -if ($someblocked && ($info_level >= 3)) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]+$R[$i]); - if ($i % $lines_per_flush == 0) { - print("red flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - - if ( $opt_m ) { - print "closepath red setgray fill\n"; - } else { - print "closepath red setrgbcolor fill\n"; - } -} - -# Fetching Tasks -if ($somefetching && ($info_level >= 4)) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]); - if ($i % $lines_per_flush == 0) { - print("cyan flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - - if ( $opt_m ) { - print "closepath cyan setgray fill\n"; - } else { - print "closepath cyan setrgbcolor fill\n"; - } -} - -# Sparks -if ($somesparks && ($info_level >= 6)) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]); - if ($i % $lines_per_flush == 0) { - print("crimson flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - - if ( $opt_m ) { - print "closepath crimson setgray fill\n"; - } else { - print "closepath crimson setrgbcolor fill\n"; - } -} - -# Migrating Threads -if ($somemigratory && ($info_level >= 5)) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]+$A[$i]+$C[$i]); - if ($i % $lines_per_flush == 0) { - print("blue flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n"); - if ( $opt_m ) { - print "closepath blue setgray fill\n"; + if ( $opt_l ) { + $slice_width = $opt_l; } else { - print "closepath blue setrgbcolor fill\n"; + $slice_width = 500; } -} -# Runnable Tasks -if($somerunnable && ($info_level >= 2)) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]+$A[$i]); - if ($i % $lines_per_flush == 0) { - print("amber flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n"); - if ( $opt_m ) { - print "closepath amber setgray fill\n"; - } else { - print "closepath amber setrgbcolor fill\n"; - } -} + $queue_on_a = &queue_on("a"); + $queue_on_r = &queue_on("r"); + $queue_on_b = &queue_on("b"); + $queue_on_f = &queue_on("f"); + $queue_on_s = &queue_on("s"); + $queue_on_m = &queue_on("m"); -# Active Tasks -if ($info_level >= 1) { - print("$xmin $ymin moveto\n"); - for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) { - do psout($T[$i],$G[$i]); - if ($i % $lines_per_flush == 0) { - print("green flush-it\n"); - } - } - # print("$xmax $ymin L\n"); - # print("closepath\ngsave\n0.5 setgray\nfill\ngrestore\nstroke\n"); - if ( $opt_m ) { - print "closepath green setgray fill\n"; - } else { - print "closepath green setrgbcolor fill\n"; - } +# if ($#ARGV == 0) { +# printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n"); +# exit 1; +# } }