X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Futils%2Fparallel%2Fgr2qp.pl;fp=ghc%2Futils%2Fparallel%2Fgr2qp.pl;h=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hp=e87f21b1e4c11868d1a3de2bfd7df0ac7f06d7a6;hpb=28a464a75e14cece5db40f2765a29348273ff2d2;p=ghc-hetmet.git diff --git a/ghc/utils/parallel/gr2qp.pl b/ghc/utils/parallel/gr2qp.pl deleted file mode 100644 index e87f21b..0000000 --- a/ghc/utils/parallel/gr2qp.pl +++ /dev/null @@ -1,329 +0,0 @@ -#!/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; - $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, " ", - $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"; -}