ghc/utils/parallel/gr2java.pl

   1 #!/usr/local/bin/perl
   2 ##############################################################################
   3 #
   4 # Usage: gr2java [options]
   5 #
   6 # Filter that transforms a GrAnSim profile (a .gr file) at stdin to
   7 # a quasi-parallel profile (a .qp file). It is the common front-end for most
   8 # visualization tools (except gr2pe). It collects  running,
   9 # runnable and blocked tasks in queues of different `colours', whose meaning
  10 # is:
  11 #  G ... green; queue of all running tasks
  12 #  A ... amber; queue of all runnable tasks
  13 #  R ... red; queue of all blocked tasks
  14 #  Y ... cyan; queue of fetching tasks
  15 #  C ... crimson; queue of tasks that are being stolen
  16 #  B ... blue; queue of all sparks
  17 #
  18 # Options:
  19 #  -i <int>  ... info level from 1 to 7; number of queues to count (see qp3ps)
  20 #  -I <str>  ... count tasks that are in one of the given queues; encoding:
  21 #                 'a' ... active (running)
  22 #                 'r' ... runnable
  23 #                 'b' ... blocked
  24 #                 'f' ... fetching
  25 #                 'm' ... migrating
  26 #                 's' ... sparks
  27 #                (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
  28 #  -c        ... check consistency of data (e.g. no neg. number of tasks)
  29 #  -v        ... be talkative.
  30 #  -h        ... print help message (this header).
  31 #
  32 ##############################################################################
  33
  34 require "getopts.pl";
  35
  36 &Getopts('hvDSci:I:');
  37
  38 do process_options();
  39
  40 if ( $opt_v ) {
  41     do print_verbose_message();
  42 }
  43
  44 # ---------------------------------------------------------------------------
  45 # Init
  46 # ---------------------------------------------------------------------------
  47
  48 $max = 0;
  49 $pmax = 0;
  50 $ptotal = 0;
  51 $n = 0;
  52
  53 $active = 0;
  54 $runnable = 0;
  55 $blocked = 0;
  56 $fetching = 0;
  57 $migrating = 0;
  58 $sparks = 0;
  59
  60 $improved_sort_option = $opt_S ? "-S" : "";
  61
  62 open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
  63
  64 $in_header = 9;
  65 while(<>) {
  66     if ( $in_header == 9 ) {
  67         if (/^=/) {
  68             $gum_style_gr = 1;
  69             $in_header = 0;
  70         } else {
  71             $gum_style_gr = 0;
  72             $in_header = 1;
  73         }
  74
  75     }
  76     if (/^\++$/) {
  77         $in_header=0;
  78         next;
  79     }
  80     next if $in_header;
  81     next if /^$/;
  82     next if /^=/;
  83     chop;
  84     ($PE, $pe, $time, $act, $tid, $rest) = split;
  85     $time =~ s/[\[\]:]//g;
  86     # next if $act eq 'REPLY';
  87     chop($tid) if $act eq 'END';
  88     $from = $queue{$tid};
  89     $extra = "";
  90     if ($act eq 'START') {
  91         $from = '*';
  92         $to = 'G';
  93         $n++;
  94         if ( $n > $pmax ) { $pmax = $n; }
  95         $ptotal++;
  96     } elsif ($act eq 'START(Q)') {
  97         $from = '*';
  98         $to = 'A';
  99         $n++;
 100         if ( $n > $pmax ) { $pmax = $n; }
 101         $ptotal++;
 102     } elsif ($act eq 'STEALING') {
 103         $to = 'C';
 104     } elsif ($act eq 'STOLEN') {
 105         $to = 'G';
 106     } elsif ($act eq 'STOLEN(Q)') {
 107         $to = 'A';
 108     } elsif ($act eq 'FETCH') {
 109         $to = 'Y';
 110     } elsif ($act eq 'REPLY') {
 111         $to = 'R';
 112     } elsif ($act eq 'BLOCK') {
 113         $to = 'R';
 114     } elsif ($act eq 'RESUME') {
 115         $to = 'G';
 116         $extra = " 0 0x0";
 117     } elsif ($act eq 'RESUME(Q)') {
 118         $to = 'A';
 119         $extra = " 0 0x0";
 120     } elsif ($act eq 'END') {
 121         $to = '*';
 122         $n--;
 123         if ( $opt_c && $n < 0 ) {
 124             print STDERR "Error at time $time: neg. number of tasks: $n\n";
 125         }
 126     } elsif ($act eq 'SCHEDULE') {
 127         $to = 'G';
 128     } elsif ($act eq 'DESCHEDULE') {
 129         $to = 'A';
 130     # The following are only needed for spark profiling
 131     } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
 132         $from = '*';
 133         $to = 'B';
 134     } elsif ($act eq 'USED') {
 135         $from = 'B';
 136         $to = '*';
 137     } elsif ($act eq 'PRUNED') {
 138         $from = 'B';
 139         $to = '*';
 140     } elsif ($act eq 'EXPORTED') {
 141         $from = 'B';
 142         $to = 'B';
 143     } elsif ($act eq 'ACQUIRED') {
 144         $from = 'B';
 145         $to = 'B';
 146     } else {
 147         print STDERR "Error at time $time: unknown event $act\n";
 148     }
 149     $queue{$tid} = $to;
 150
 151     if ( $from eq '' ) {
 152         print STDERRR "Error at time $time: process $tid has no from queue\n";
 153     }
 154     if ($to ne $from) {
 155         print FOOL $time, "  ", $pe, " ",
 156           $from, $to, "\n";
 157     }
 158
 159     if ($to ne $from) {
 160         # Compare with main loop in qp3ps
 161         if ($from eq '*') {
 162         } elsif ($from eq 'G') {
 163             --$active;
 164         } elsif ($from eq 'A') {
 165             --$runnable;
 166         } elsif ($from eq 'R') {
 167             --$blocked;
 168         } elsif ($from eq 'B') {
 169             --$sparks;
 170         } elsif ($from eq 'C') {
 171             --$migrating;
 172         } elsif ($from eq 'Y') {
 173             --$fetching;
 174         } else {
 175             print STDERR "Illegal from char: $from at $time\n";
 176         }
 177
 178         if ($to eq '*') {
 179         } elsif ($to eq 'G') {
 180             ++$active;
 181         } elsif ($to eq 'A') {
 182             ++$runnable;
 183         } elsif ($to eq 'R') {
 184             ++$blocked;
 185         } elsif ($to eq 'B') {
 186             ++$sparks;
 187         } elsif ($to eq 'C') {
 188             ++$migrating;
 189         } elsif ($to eq 'Y') {
 190             ++$fetching;
 191         } else {
 192             print STDERR "Illegal to char: $to at $time\n";
 193         }
 194
 195     }
 196
 197     $curr = &count();
 198     if ( $curr > $max ) {
 199         $max = $curr;
 200     }
 201
 202     if ( 0 ) {
 203         print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
 204             "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
 205                 " max = $max\n"  ;
 206     }
 207
 208     #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n"  if $opt_D;
 209
 210     if ( $time > $tmax ) {
 211         $tmax = $time;
 212     }
 213     delete $queue{$tid} if $to eq '*';
 214
 215 }
 216
 217 print "Time: ", $tmax, " Max_selected_tasks: ", $max,
 218       " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
 219
 220 close(FOOL);
 221
 222 exit 0;
 223
 224 # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 225 # Copied from qp3ps and slightly modified (we don't keep a list for each queue
 226 # but just compute the max value we get out of all calls to count during the
 227 # execution of the script).
 228 # -----------------------------------------------------------------------------
 229
 230 # -----------------------------------------------------------------------------
 231
 232 sub queue_on {
 233     local ($queue) = @_;
 234
 235     return index($show,$queue)+1;
 236 }
 237
 238 # -----------------------------------------------------------------------------
 239
 240 sub count {
 241     local ($res);
 242
 243     $res = (($queue_on_a)  ? $active : 0) +
 244            (($queue_on_r)  ? $runnable : 0) +
 245            (($queue_on_b)  ? $blocked : 0) +
 246            (($queue_on_f)  ? $fetching : 0) +
 247            (($queue_on_m)  ? $migrating : 0) +
 248            (($queue_on_s)  ? $sparks : 0);
 249
 250     return $res;
 251 }
 252
 253 # -----------------------------------------------------------------------------
 254 # DaH 'oH lo'lu'Qo'
 255 # -----------------------------------------------------------------------------
 256
 257 sub set_values {
 258     local ($samples,
 259            $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
 260
 261     $G[$samples] = queue_on_a ? $active : 0;
 262     $A[$samples] = queue_on_r ? $runnable : 0;
 263     $R[$samples] = queue_on_b ? $blocked : 0;
 264     $Y[$samples] = queue_on_f ? $fetching : 0;
 265     $B[$samples] = queue_on_s ? $sparks : 0;
 266     $C[$samples] = queue_on_m ? $migrating : 0;
 267 }
 268
 269 # -----------------------------------------------------------------------------
 270
 271 sub process_options {
 272     if ( $opt_h ) {
 273         open(ME,$0) || die "Can't open myself ($0): $!\n";
 274         $n = 0;
 275         while (<ME>) {
 276             last if $_ =~ /^$/;
 277             print $_;
 278             $n++;
 279         }
 280         close(ME);
 281         exit ;
 282     }
 283
 284     $show = "armfb";
 285
 286     if ( $opt_i ) {
 287         $show = "a"             if info_level == 1;
 288         $show = "ar"            if info_level == 2;
 289         $show = "arb"           if info_level == 3;
 290         $show = "arfb"          if info_level == 4;
 291         $show = "armfb"         if info_level == 5;
 292         $show = "armfbs"        if info_level == 6;
 293     }
 294
 295     if ( $opt_I ) {
 296         $show = $opt_I;
 297     }
 298
 299     if ( $opt_v ){
 300         $verbose = 1;
 301     }
 302
 303     $queue_on_a = &queue_on("a");
 304     $queue_on_r = &queue_on("r");
 305     $queue_on_b = &queue_on("b");
 306     $queue_on_f = &queue_on("f");
 307     $queue_on_s = &queue_on("s");
 308     $queue_on_m = &queue_on("m");
 309 }
 310
 311 sub print_verbose_message {
 312
 313     print STDERR "Info-str: $show\n";
 314     print STDERR "The following queues are turned on: " .
 315           ( $queue_on_a ? "active, " : "") .
 316           ( $queue_on_r ? "runnable, " : "") .
 317           ( $queue_on_b ? "blocked, " : "") .
 318           ( $queue_on_f ? "fetching, " : "") .
 319           ( $queue_on_m ? "migrating, " : "") .
 320           ( $queue_on_s ? "sparks" : "") .
 321           "\n";
 322 }