diff options
author | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
commit | 0065d5ab628975892cea1ec7303f968c3338cbe1 (patch) | |
tree | 8e2afe0ab48ee33cf95009809d67c9649573ef92 /utils/parallel/qp2ap.pl | |
parent | 28a464a75e14cece5db40f2765a29348273ff2d2 (diff) | |
download | haskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz |
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.
The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level. The build system now makes no
pretense at being multi-project, it is just the GHC build system.
No doubt this will break many things, and there will be a period of
instability while we fix the dependencies. A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.
Diffstat (limited to 'utils/parallel/qp2ap.pl')
-rw-r--r-- | utils/parallel/qp2ap.pl | 495 |
1 files changed, 495 insertions, 0 deletions
diff --git a/utils/parallel/qp2ap.pl b/utils/parallel/qp2ap.pl new file mode 100644 index 0000000000..b3c3bcf122 --- /dev/null +++ b/utils/parallel/qp2ap.pl @@ -0,0 +1,495 @@ +#! /usr/local/bin/perl +############################################################################## +# Time-stamp: <Wed Jul 24 1996 22:05:31 Stardate: [-31]7859.39 hwloidl> +# +# Usage: qp2ap [options] <max-x> <max-y> <prg> <date> +# +# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to +# a PostScript file at stdout, showing an activity profile with one horizontal +# line for each task (thickness of the line shows if it's active or suspended). +# +# Options: +# -o <file> ... write .ps file to <file> +# -m ... create mono PostScript file instead a color one. +# -O ... optimise i.e. try to minimise the size of the .ps file. +# -s <n> ... scaling factor of y axis (default: 1) +# -w <n> ... width of lines denoting running threads (default: 2) +# -v ... be talkative. +# -h ... print help message (this header). +# +############################################################################## + + +require "getopts.pl"; + +&Getopts('hvms:w:OlD'); + +do process_options(); + +if ( $opt_v ) { + do print_verbose_message(); +} + +# --------------------------------------------------------------------------- +# Init +# --------------------------------------------------------------------------- + +$y_scaling = 0; +$gtid = 1; # number of process so far = $gtid-1 + +$xmin = 100; +$xmax = 790; + +$scalex = $xmin; +$labelx = $scalex - 45; +$markx = $scalex - 30; +$major = $scalex - 5; +$majorticks = 10; + +# $pmax = 40; +$ymin = 50; +$ymax = 500; + +if ( ($ymax - $ymin)/$pmax < 3 ) { + print STDERR "Warning: Too many tasks! Distance will be smaller than 3 pixels.\n"; +} + +if ( !$width ) { + $width = 2/3 * ($ymax - $ymin)/$pmax; +} + +do write_prolog(); +do print_y_axis(); + +# --------------------------------------------------------------------------- +# Main Part +# --------------------------------------------------------------------------- + +while(<STDIN>) { + next if /^[^0-9]/; # ignore lines not beginning with a digit (esp. last) + chop; + ($time, $event, $tid, $addr, $tid2, $addr2) = split; + + if ( $event eq "*G") { + $TID{$addr} = $gtid++; + $START{$addr} = $time; + } + + elsif ($event eq "*A") { + $TID{$addr} = $gtid++; + $SUSPEND{$addr} = $time; + } + + elsif ($event eq "G*" || $event eq "GR" ) { + do psout($START{$addr},$time,$TID{$addr},"runlineto"); +# $STOP{$addr} = $time; + } + + elsif ($event eq "GA" || $event eq "GC" || $event eq "GY") { + do psout($START{$addr},$time,$TID{$addr},"runlineto"); + $SUSPEND{$addr} = $time; + } + + elsif ($event eq "RA") { + $SUSPEND{$addr} = $time; + } + + elsif ($event eq "YR") { + do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto"); + } + + elsif ($event eq "CA" || $event eq "YA" ) { + do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto"); + $SUSPEND{$addr} = $time; + } + + elsif ($event eq "AC" || $event eq "AY" ) { + do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto"); + $SUSPEND{$addr} = $time; + } + + elsif ($event eq "RG") { + $START{$addr} = $time; + } + + elsif ($event eq "AG") { + do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto"); + $START{$addr} = $time; + } + + elsif ($event eq "CG" || $event eq "YG" ) { + do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto"); + $START{$addr} = $time; + } elsif ( $event eq "B*" || $event eq "*B" || $event eq "BB" ) { + print STDERR "Ignoring spark event $event at $time\n" if $opt_v; + } else { + print STDERR "Unexpected event $event at $time\n"; + } + + print("%% $time: $event $addr $TID{$addr}\n\n") if $opt_D; +} + +# --------------------------------------------------------------------------- + +# Logo +print("HE14 setfont\n"); +if ( $opt_m ) { + print("50 550 asciilogo\n"); +} else { + print("50 550 logo\n"); # +} + +# Epilogue +print("showpage\n"); + +if ( $gtid-1 != $pmax ) { + if ( $pedantic ) { + die "Error: Calculated max no. of tasks ($gtid-1) does not agree with stated max. no. of tasks ($pmax)\n"; + } else { + print STDERR "Warning: Calculated total no. of tasks ($gtid-1) does not agree with stated total no. of tasks ($pmax)\n" if $opt_v; + $y_scaling = $pmax/($gtid-1); + } +} + + +exit 0; + +# --------------------------------------------------------------------------- + +sub psout { + local($x1, $x2, $y, $cmd) = @_; + print("% ($x1,$y) -- ($x2,$y) $cmd\n") if $opt_D; + $x1 = int(($x1/$tmax) * ($xmax-$xmin) + $xmin); + $x2 = int(($x2/$tmax) * ($xmax-$xmin) + $xmin); + $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin); + if ( $x1 == $x2 ) { + $x2 = $x1 + 1; + } + + if ( $opt_l ) { + print("newpath\n"); + print("$x1 $y moveto\n"); + print("$x2 $y $cmd\n"); + print("stroke\n"); + } elsif ( $opt_O ) { + print "$x1 $x2 $y " . + ( $cmd eq "runlineto" ? "G RL\n" : + $cmd eq "suspendlineto" ? "R SL\n" : + $cmd eq "fetchlineto" ? "B FL\n" : + "\n% ERROR: Unknown command $cmd\n"); + + } else { + print "$x2 $y $x1 $y " . + ( $cmd eq "runlineto" ? "green run\n" : + $cmd eq "suspendlineto" ? "red suspend\n" : + $cmd eq "fetchlineto" ? "blue fetch\n" : + "\n% ERROR: Unknown command $cmd\n"); + } +} + +# ----------------------------------------------------------------------------- + +sub get_date { + local ($date); + + chop($date = `date`); + return ($date); +} + +# ----------------------------------------------------------------------------- + +sub write_prolog { + local ($now); + + $now = do get_date(); + + print("%!PS-Adobe-2.0\n"); + print("%%BoundingBox: 0 0 560 800\n"); + print("%%Title: Per-thread Activity Profile\n"); + print("%%Creator: qp2ap\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 "% " . "-" x 77 . "\n"; + print "% Tunable Parameters:\n"; + print "% The width of a line representing a task\n"; + print "/width $width def\n"; + print "% Scaling factor for the y-axis (usful to enlarge)\n"; + print "/y-scale $y_scale def\n"; + print "% " . "-" x 77 . "\n"; + + 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 is the PS version of the formula: \n" . + "% int(($x1/$tmax) * ($xmax-$xmin) + $xmin) \n" . + "% in psout.\n"; + print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n"; + print "/x-normalize { exch show-len mul total-len div exch } def\n"; + print "/y-normalize { y-offset sub y-scale mul y-offset add } def\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"; + # print "/prt-n { cvi str-len string cvs \n" . + # " dup stringwidth pop 2 div neg 0 rmoveto \n" . + # " show } def \n" . + # " % print top-of-stack integer centered at the current point\n"; + + if ( $opt_l ) { + print ("/runlineto {1.5 setlinewidth lineto} def\n"); + print ("/suspendlineto {0.5 setlinewidth lineto} def\n"); + print ("/fetchlineto {0.2 setlinewidth lineto} def\n"); + } else { + if ( $opt_m ) { + if ( $opt_O ) { + print "/R { 0 } def\n"; + print "/G { 0.5 } def\n"; + print "/B { 0.2 } def\n"; + } else { + print "/red { 0 } def\n"; + print "/green { 0.5 } def\n"; + print "/blue { 0.2 } def\n"; + } + print "/set-bg { setgray } def\n"; + } else { + if ( $opt_O ) { + print "/R { 0.8 0 0 } def\n"; + print "/G { 0 0.9 0.1 } def\n"; + print "/B { 0 0.1 0.9 } def\n"; + print "/set-bg { setrgbcolor } def\n"; + } else { + print "/red { 0.8 0 0 } def\n"; + print "/green { 0 0.9 0.1 } def\n"; + print "/blue { 0 0.1 0.9 } def\n"; + print "/set-bg { setrgbcolor } def\n"; + } + } + + if ( $opt_O ) { + print "% RL: runlineto; draws a horizontal line in given color\n"; + print "% Operands: x-from x-to y color\n"; + print "/RL { set-bg % set color \n" . + " newpath y-normalize % mangle y val\n" . + " 2 index 1 index moveto width setlinewidth \n" . + " lineto pop stroke} def\n"; + print "% SL: suspendlineto; draws a horizontal line in given color (thinner)\n"; + print "% Operands: x-from x-to y color\n"; + print "/SL { set-bg % set color \n" . + " newpath y-normalize % mangle y val\n" . + " 2 index 1 index moveto width 2 div setlinewidth \n" . + " lineto pop stroke} def\n"; + print "% FL: fetchlineto; draws a horizontal line in given color (thinner)\n"; + print "% Operands: x-from x-to y color\n"; + print "/FL { set-bg % set color \n" . + " newpath y-normalize % mangle y val\n" . + " 2 index 1 index moveto width " . + ( $opt_m ? " 4 " : " 2 ") . + " div setlinewidth \n" . + " lineto pop stroke} def\n"; + } else { + print "/run { set-bg newpath 50 sub y-scale mul 50 add moveto width " . + "setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n"; + print "/suspend { set-bg newpath 50 sub y-scale mul 50 add moveto width " . + "2 div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n"; + print "/fetch { set-bg newpath 50 sub y-scale mul 50 add moveto width " . + ( $opt_m ? " 4 " : " 2 ") . + "div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n"; + #print ("/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n"); + #print ("/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n"); + } + } + + print "/printText { 0 0 moveto (GrAnSim) show } def\n"; + print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n"; + if ( $opt_m ) { + print "/logo { asciilogo } def\n"; + } else { + print "/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 "% For debugging PS uncomment this line and add the file behandler.ps\n"; + print "% $brkpage begin printonly endprint \n"; + + print("/HE10 /Helvetica findfont 10 scalefont def\n"); + print("/HE12 /Helvetica findfont 12 scalefont def\n"); + print("/HE14 /Helvetica findfont 14 scalefont def\n"); + print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n"); + print "% " . "-" x 77 . "\n"; + print("newpath\n"); + + print("-90 rotate\n"); + print("-785 30 translate\n"); + print("0 8.000000 moveto\n"); + print("0 525.000000 760.000000 525.000000 8.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("760.000000 525.000000 760.000000 0 8.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("760.000000 0 0 0 8.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("0 0 0 525.000000 8.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("0.500000 setlinewidth\n"); + print("stroke\n"); + print("newpath\n"); + print("4.000000 505.000000 moveto\n"); + print("4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n"); + print("4 {pop} repeat\n"); + print("0.500000 setlinewidth\n"); + print("stroke\n"); + + print("HE14 setfont\n"); + print("100 505 moveto\n"); + print("($pname ) show\n"); + + print("($date) dup stringwidth pop 750 exch sub 505.000000 moveto show\n"); + + # print "/total-len $tmax def\n"; + print("-40 -40 translate\n"); + + print "% " . "-" x 77 . "\n"; + print "% Print x-axis:\n"; + print "/y-val $ymin def % { y-offset 40 sub 2 div y-offset add } 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 "% " . "-" 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"; + + if ( $opt_m ) { + print "0 setgray\n"; + } else { + print "0 0 0 setrgbcolor\n"; + } + + print("gsave\n"); + print("HE12 setfont\n"); + print("(tasks)\n"); + print("dup stringwidth pop\n"); + print("$ymax\n"); + print("exch sub\n"); + print("$labelx exch\n"); + print("translate\n"); + print("90 rotate\n"); + print("0 0 moveto\n"); + print("show\n"); + print("grestore\n"); + +# Scale + + if ($pmax < $majorticks) { + $majorticks = $pmax; + } + + print "0.5 setlinewidth\n"; + + print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n"); + print("% Total number of tasks: $pmax\n"); + print("% Number of ticks: $majorticks\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) { + $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin; + $majorval = int($majorint * ($majormax/$majorint-$i)); + print("$scalex $y moveto\n$major $y lineto\n"); + print("$markx $y moveto\n($majorval) show\n"); + } + + # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n"); + print " stroke\n"; + print "1 setlinewidth\n"; + print "% " . ("-" x 75) . "\n"; +} + +# --------------------------------------------------------------------------- + +sub print_verbose_message { + + print "Prg Name: $pname Date: $date\n"; + print "Input: stdin Output: stdout\n"; +} + +# ---------------------------------------------------------------------------- + +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 ( $opt_s ) { + $y_scale = $opt_s; + } else { + $y_scale = 1; + } + + if ( $#ARGV != 3 ) { + print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n"; + print "Use -h option to get details\n"; + exit 1; + } + + $tmax = $ARGV[0]; + $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]; + + if ( $opt_w ) { + $width = $opt_w; + } else { + $width = 0; + } + +} +# ----------------------------------------------------------------------------- |