X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Futils%2Fparallel%2Fgr2qp.pl;h=e87f21b1e4c11868d1a3de2bfd7df0ac7f06d7a6;hp=c0844622d80e206a1a051dacba8464e9fd7f05d8;hb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;hpb=f7ecf7234c224489be8a5e63fced903b655d92ee diff --git a/ghc/utils/parallel/gr2qp.pl b/ghc/utils/parallel/gr2qp.pl index c084462..e87f21b 100644 --- a/ghc/utils/parallel/gr2qp.pl +++ b/ghc/utils/parallel/gr2qp.pl @@ -1,16 +1,111 @@ +#!/usr/local/bin/perl +############################################################################## +# Time-stamp: +# +# Usage: gr2qp [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 ... info level from 1 to 7; number of queues to count (see qp3ps) +# -I ... 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 == 8 ) { + $start_time = $1 if /^Start-Time: (.*)$/; + $in_header = 0; + next; + } + if ( $in_header == 9 ) { + if (/^=/) { + $gum_style_gr = 1; + $in_header = 8; + next; + } 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; - next if $act eq 'REPLY'; + $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') { @@ -19,6 +114,8 @@ while(<>) { $to = 'A'; } elsif ($act eq 'FETCH') { $to = 'Y'; + } elsif ($act eq 'REPLY') { + $to = 'R'; } elsif ($act eq 'BLOCK') { $to = 'R'; } elsif ($act eq 'RESUME') { @@ -29,17 +126,204 @@ while(<>) { $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 substr($time,1,length($time)-3), " ", + print FOOL $time, " ", $from, $to, " 0 0x", $tid, $extra, "\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 () { + 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"; +}