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/gr2java.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/gr2java.pl')
-rw-r--r-- | utils/parallel/gr2java.pl | 322 |
1 files changed, 322 insertions, 0 deletions
diff --git a/utils/parallel/gr2java.pl b/utils/parallel/gr2java.pl new file mode 100644 index 0000000000..acd0b5e631 --- /dev/null +++ b/utils/parallel/gr2java.pl @@ -0,0 +1,322 @@ +#!/usr/local/bin/perl +############################################################################## +# +# Usage: gr2java [options] +# +# Filter that transforms a GrAnSim profile (a .gr file) at stdin to +# a quasi-parallel profile (a .qp file). It is the common front-end for most +# visualization tools (except gr2pe). It collects running, +# runnable and blocked tasks in queues of different `colours', whose meaning +# is: +# G ... green; queue of all running tasks +# A ... amber; queue of all runnable tasks +# R ... red; queue of all blocked tasks +# Y ... cyan; queue of fetching tasks +# C ... crimson; queue of tasks that are being stolen +# B ... blue; queue of all sparks +# +# Options: +# -i <int> ... info level from 1 to 7; number of queues to count (see qp3ps) +# -I <str> ... count tasks that are in one of the given queues; encoding: +# 'a' ... active (running) +# 'r' ... runnable +# 'b' ... blocked +# 'f' ... fetching +# 'm' ... migrating +# 's' ... sparks +# (e.g. -I "arb" counts sum of active, runnable, blocked tasks) +# -c ... check consistency of data (e.g. no neg. number of tasks) +# -v ... be talkative. +# -h ... print help message (this header). +# +############################################################################## + +require "getopts.pl"; + +&Getopts('hvDSci:I:'); + +do process_options(); + +if ( $opt_v ) { + do print_verbose_message(); +} + +# --------------------------------------------------------------------------- +# Init +# --------------------------------------------------------------------------- + +$max = 0; +$pmax = 0; +$ptotal = 0; +$n = 0; + +$active = 0; +$runnable = 0; +$blocked = 0; +$fetching = 0; +$migrating = 0; +$sparks = 0; + +$improved_sort_option = $opt_S ? "-S" : ""; + +open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL"; + +$in_header = 9; +while(<>) { + if ( $in_header == 9 ) { + if (/^=/) { + $gum_style_gr = 1; + $in_header = 0; + } else { + $gum_style_gr = 0; + $in_header = 1; + } + + } + if (/^\++$/) { + $in_header=0; + next; + } + next if $in_header; + next if /^$/; + next if /^=/; + chop; + ($PE, $pe, $time, $act, $tid, $rest) = split; + $time =~ s/[\[\]:]//g; + # next if $act eq 'REPLY'; + chop($tid) if $act eq 'END'; + $from = $queue{$tid}; + $extra = ""; + if ($act eq 'START') { + $from = '*'; + $to = 'G'; + $n++; + if ( $n > $pmax ) { $pmax = $n; } + $ptotal++; + } elsif ($act eq 'START(Q)') { + $from = '*'; + $to = 'A'; + $n++; + if ( $n > $pmax ) { $pmax = $n; } + $ptotal++; + } elsif ($act eq 'STEALING') { + $to = 'C'; + } elsif ($act eq 'STOLEN') { + $to = 'G'; + } elsif ($act eq 'STOLEN(Q)') { + $to = 'A'; + } elsif ($act eq 'FETCH') { + $to = 'Y'; + } elsif ($act eq 'REPLY') { + $to = 'R'; + } elsif ($act eq 'BLOCK') { + $to = 'R'; + } elsif ($act eq 'RESUME') { + $to = 'G'; + $extra = " 0 0x0"; + } elsif ($act eq 'RESUME(Q)') { + $to = 'A'; + $extra = " 0 0x0"; + } elsif ($act eq 'END') { + $to = '*'; + $n--; + if ( $opt_c && $n < 0 ) { + print STDERR "Error at time $time: neg. number of tasks: $n\n"; + } + } elsif ($act eq 'SCHEDULE') { + $to = 'G'; + } elsif ($act eq 'DESCHEDULE') { + $to = 'A'; + # The following are only needed for spark profiling + } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) { + $from = '*'; + $to = 'B'; + } elsif ($act eq 'USED') { + $from = 'B'; + $to = '*'; + } elsif ($act eq 'PRUNED') { + $from = 'B'; + $to = '*'; + } elsif ($act eq 'EXPORTED') { + $from = 'B'; + $to = 'B'; + } elsif ($act eq 'ACQUIRED') { + $from = 'B'; + $to = 'B'; + } else { + print STDERR "Error at time $time: unknown event $act\n"; + } + $queue{$tid} = $to; + + if ( $from eq '' ) { + print STDERRR "Error at time $time: process $tid has no from queue\n"; + } + if ($to ne $from) { + print FOOL $time, " ", $pe, " ", + $from, $to, "\n"; + } + + if ($to ne $from) { + # Compare with main loop in qp3ps + if ($from eq '*') { + } elsif ($from eq 'G') { + --$active; + } elsif ($from eq 'A') { + --$runnable; + } elsif ($from eq 'R') { + --$blocked; + } elsif ($from eq 'B') { + --$sparks; + } elsif ($from eq 'C') { + --$migrating; + } elsif ($from eq 'Y') { + --$fetching; + } else { + print STDERR "Illegal from char: $from at $time\n"; + } + + if ($to eq '*') { + } elsif ($to eq 'G') { + ++$active; + } elsif ($to eq 'A') { + ++$runnable; + } elsif ($to eq 'R') { + ++$blocked; + } elsif ($to eq 'B') { + ++$sparks; + } elsif ($to eq 'C') { + ++$migrating; + } elsif ($to eq 'Y') { + ++$fetching; + } else { + print STDERR "Illegal to char: $to at $time\n"; + } + + } + + $curr = &count(); + if ( $curr > $max ) { + $max = $curr; + } + + if ( 0 ) { + print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " . + "($active, $runnable, $blocked, $fetching, $migrating, $sparks)". + " max = $max\n" ; + } + + #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n" if $opt_D; + + if ( $time > $tmax ) { + $tmax = $time; + } + delete $queue{$tid} if $to eq '*'; + +} + +print "Time: ", $tmax, " Max_selected_tasks: ", $max, + " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n"; + +close(FOOL); + +exit 0; + +# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +# Copied from qp3ps and slightly modified (we don't keep a list for each queue +# but just compute the max value we get out of all calls to count during the +# execution of the script). +# ----------------------------------------------------------------------------- + +# ----------------------------------------------------------------------------- + +sub queue_on { + local ($queue) = @_; + + return index($show,$queue)+1; +} + +# ----------------------------------------------------------------------------- + +sub count { + local ($res); + + $res = (($queue_on_a) ? $active : 0) + + (($queue_on_r) ? $runnable : 0) + + (($queue_on_b) ? $blocked : 0) + + (($queue_on_f) ? $fetching : 0) + + (($queue_on_m) ? $migrating : 0) + + (($queue_on_s) ? $sparks : 0); + + return $res; +} + +# ----------------------------------------------------------------------------- +# DaH 'oH lo'lu'Qo' +# ----------------------------------------------------------------------------- + +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 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 ; + } + + $show = "armfb"; + + if ( $opt_i ) { + $show = "a" if info_level == 1; + $show = "ar" if info_level == 2; + $show = "arb" if info_level == 3; + $show = "arfb" if info_level == 4; + $show = "armfb" if info_level == 5; + $show = "armfbs" if info_level == 6; + } + + if ( $opt_I ) { + $show = $opt_I; + } + + if ( $opt_v ){ + $verbose = 1; + } + + $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"); +} + +sub print_verbose_message { + + print STDERR "Info-str: $show\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"; +} |