← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to utils/parallel/tf.pl

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
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