a good deal of salutory renaming
[ghc-hetmet.git] / utils / parallel / tf.pl
1 #!/usr/local/bin/perl
2 # ############################################################################
3 # Time-stamp: <Fri Aug 25 1995 23:17:43 Stardate: [-31]6189.64 hwloidl>
4 #                                       (C) Hans Wolfgang Loidl, November 1994
5 #
6 # Usage: tf [options] <gr-file>
7 #
8 # Show the `taskflow' in the .gr file (especially useful for keeping track of 
9 # migrated tasks. It's also possible to focus on a given PE or on a given
10 # event.  
11
12 # Options:
13 #  -p <int> ... Print all events on PE <int>
14 #  -t <int> ... Print all events that occur on task <int>
15 #  -e <str> ... Print all <str> events
16 #  -n <hex> ... Print all events about fetching the node at address <hex>.
17 #  -s <int> ... Print all events with a spark name <int>
18 #  -L       ... Print all events with spark queue length information
19 #  -H       ... Print header of the <gr-file>, too
20 #  -h       ... print help message (this text)
21 #  -v       ... be talkative
22 #
23 # ############################################################################
24
25 # ----------------------------------------------------------------------------
26 # Command line processing and initialization
27 # ----------------------------------------------------------------------------
28
29 require "getopts.pl";
30
31 &Getopts('hvHLp:t:e:n:s:S:');  
32
33 do process_options();
34
35 if ( $opt_v ) {
36     do print_verbose_message();
37 }
38
39 # ----------------------------------------------------------------------------
40
41 $in_header = 1;
42 while (<>) {
43     if ( $opt_H && $in_header ) {
44         print;
45         $in_header = 0 if /^\+\+\+\+\+/;
46     }
47     next unless /^PE/;
48     @c = split(/[\s\[\]:;,]+/);
49     if ( ( $check_proc ? $proc eq $c[1] : 1 ) &&
50         ( $check_event ? $event eq $c[3] : 1 ) &&
51         ( $check_task ? $task eq $c[4] : 1) &&
52         ( $check_node ? $node eq $c[5] : 1) &&
53         ( $check_spark ? (("END" eq $c[3]) && ($spark eq $c[6])) : 1) &&
54         ( $negated_spark ? (("END" eq $c[3]) && ($spark ne $c[6])) : 1) &&
55         ( $spark_queue_len ? ($c[5] =~ /sparks/) : 1 ) ) {
56         print;
57     }
58 }
59
60 exit 0;
61
62 # ----------------------------------------------------------------------------
63
64 sub process_options { 
65
66  if ( $opt_p ne "" ) {
67    $check_proc = 1;
68    $proc = $opt_p;
69  }
70
71  if ( $opt_t ne "" ) {
72    $check_task = 1;
73    $task = $opt_t;
74  }
75
76  if ( $opt_e ne "" ) {
77    $check_event = 1;
78    $event = $opt_e;
79  }
80
81  if ( $opt_n ne "" ) {
82    $check_node = 1;
83    $node = $opt_n
84  }
85
86  if ( $opt_s ne "" ) {
87    $check_spark = 1;
88    $spark = $opt_s
89  }
90
91  if ( $opt_S ne "" ) {
92    $negated_spark = 1;
93    $spark = $opt_S
94  }
95
96  if ( $opt_L ) {
97      $spark_queue_len = 1;
98  } else {
99      $spark_queue_len = 0;
100  }
101
102  if ( $opt_h ) {
103      open (ME,$0) || die "!$: $0";
104      while (<ME>) {
105          last if /^$/;
106          print;
107      }
108      close (ME);
109      exit 1;
110  }
111 }
112
113 # ----------------------------------------------------------------------------
114
115 sub print_verbose_message { 
116
117  if ( $opt_p ne "" ) {
118    print "Processor: $proc\n";
119  }
120
121  if ( $opt_t ne "" ) {
122    print "Task: $task\n";
123  }
124
125  if ( $opt_e ne "" ) {
126    print "Event: $event\n";
127  }
128
129  if ( $opt_n ne "" ) {
130    print "Node: $node\n";
131  }
132
133  if ( $opt_s ne "" ) {
134    print "Spark: $spark\n";
135  }
136
137  if ( $opt_S ne "" ) {
138    print "Negated Spark: $spark\n";
139  }
140
141  if ( $opt_L ne "" ) {
142    print "Printing spark queue len info.\n";
143  }
144
145 }
146
147 # ----------------------------------------------------------------------------
148