utils/parallel/gr2qp.pl

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