summaryrefslogtreecommitdiff
path: root/ghc/utils/parallel/gr2java.pl
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/utils/parallel/gr2java.pl')
-rw-r--r--ghc/utils/parallel/gr2java.pl322
1 files changed, 322 insertions, 0 deletions
diff --git a/ghc/utils/parallel/gr2java.pl b/ghc/utils/parallel/gr2java.pl
new file mode 100644
index 0000000000..acd0b5e631
--- /dev/null
+++ b/ghc/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";
+}
View Lorry Controller Status