1#! /usr/bin/perl
2#
3# Generate Valgrind's module dependence graph in 'dot' format.
4#
5# You can run it from anywhere(?) in a Valgrind source tree, but the two
6# most interesting places are:
7# - the root, to get the entire module dependence graph.
8# - coregrind/, to get the core's module dependence graph.
9#
10# It sends a dot-format graph to stdout.  You can use dot (part of the
11# "GraphViz" package) to generated a PostScript graphs like this:
12#
13#   dot -Tps foo.dot -o foo.ps
14#
15# Caveats:
16# - It's not a proper parser.  If you have a #include that is commented out,
17#   it will think it's there.  We see that particularly in m_demangle.
18# - It only looks in C files, not in header files, so it will miss any
19#   extra dependencies this causes.  Fortunately we don't have many like
20#   that.
21
22use warnings;
23use strict;
24
25#----------------------------------------------------------------------------
26# Global variables
27#----------------------------------------------------------------------------
28
29# The dependence graph is a set of src-->dst pairs, stored in a double-hash:
30#
31#   hash(src, hash(dst, dst_realname))
32#
33# Each of 'src' and 'dst' are node names.  'src' is always a module name,
34# eg. 'm_main' or 'memcheck'.  The destination is sometimes a module name,
35# and sometimes a header file.  Because Dot can't handle certain characters
36# in its node names, when 'dst' represents a header file it's a transformed
37# version of the header file name, eg. 'INT_memcheck_h' or 'EXT_sys_mman_h'.
38# The 'dst_realname' holds the original name, eg.  '"memcheck.h"' or
39# "<sys/mman.h>".  We use 'dst' for the node name in the graph, but label it
40# with 'dst_realname' and that's what gets seen.  (Although we use "" for
41# 'dst_realname' when it would be the same as 'dst'.)
42my $deps = {};
43
44# Directories to skip.  These are the defaults, they can be augmented
45# using command-line options.
46my %dirs_to_skip = ( auxprogs => 1, hp2ps => 1, tests => 1 );
47
48# Command-line variables -- things we should show.  Default is yes.
49my $show_tools   = 1;
50my $show_headers = 1;
51my $show_libc    = 1;
52
53# Modules to hide.
54my %hide;
55
56# List of all tools.
57my @tools = ( "cachegrind", "helgrind",
58              "lackey", "massif", "memcheck", "none" );
59
60my $usage = <<END
61usage: gen-mdg [options]
62
63  options:
64    --headers=no|yes    show headers, ie. show module-to-module deps only
65    --hide=<a>,<b>,...  hide module(s) named <a>, <b>, ...
66END
67;
68
69#----------------------------------------------------------------------------
70# Subroutines
71#----------------------------------------------------------------------------
72
73sub process_cmd_line()
74{
75   for my $arg (@ARGV) { 
76
77        # --headers=yes|no
78        if ($arg =~ /^--headers=(yes|no)$/) {
79            $show_headers = 1 if ($1 eq "yes");
80            $show_headers = 0 if ($1 eq "no");
81
82        # --hide=<a>,<b>,...
83        } elsif ($arg =~ /^--hide=(.*)$/) {
84            my @hiders = split(/,/, $1);
85            foreach my $h (@hiders) {
86                $hide{$h} = 1;
87            }
88
89        } else {
90            die $usage;
91        }
92    }
93
94    if (!$show_tools) {
95        foreach my $tool (@tools) {
96            $dirs_to_skip{$tool} = 1;
97        }
98    }
99}
100
101# Convert a header filename into a node name acceptable by dot.
102sub clean_nodename($)
103{
104    my ($s) = @_;
105    $s =~ s/"([^"]+)"/INT_$1/;  # "foo.h" --> foo.h
106    $s =~ s/<([^>]+)>/EXT_$1/;  # <foo.h> --> foo.h
107    $s =~ s/\./_/g;  # foo.h     --> foo_h
108    $s =~ s/-/_/g;   # foo-bar.h --> foo_bar_h
109    $s =~ s/\//_/g;  # bar/foo_h --> bar_foo_h
110    return $s;
111}
112
113# Convert a header filename into a node label acceptable by dot.
114sub clean_nodelabel($)
115{
116    my ($s) = @_;
117    $s =~ s/"/\\"/g;    # "foo.h" --> \"foo.h\"
118    return $s;
119}
120
121# $module is the module to which the C/asm file $f belongs.
122sub scan_C_or_asm_file($$)
123{
124    my ($module, $f) = @_;
125
126    # Skip if this is a module we want to hide
127    if ($hide{$module}) {
128        return;
129    }
130    
131    # Get any existing dependencies for this module, initialise if none
132    my $module_deps = $deps->{$module};
133    if (not defined $module_deps) {
134        $module_deps = {};
135    }
136    
137    # Scan the C/asm file
138    open(CFILE, "< $f") || die "File $f not openable\n";
139    while (my $line = <CFILE>) {
140        if ($line =~ /#include\s+(("|<)[^">]+("|>))/) {
141            # Right!  We've found a #include line.
142            my $include_string = $1;
143            my $target;
144            my $realname;
145            if ($include_string =~ /"pub_(core|tool)_([A-Za-z]+).h"/) {
146                # If #include string is "pub_core_foo.h" or "pub_tool_foo.h", 
147                # the target module is "m_foo".
148                #
149                # Nb: assuming the "foo" part does not contains underscores!
150                $target   = "m_$2";
151                $realname = "";
152
153                # But don't show hidden modules
154                if ($hide{$target}) {
155                    $target = "";
156                }
157
158            } elsif ($show_headers) {
159                # Otherwise use the #include string as-is for the target.
160                # Note that "#include pub_core_foo_asm.h" falls into this
161                # category.  We don't consider that part of the m_foo module
162                # because the *_asm.h only define some constants.
163                $target   = clean_nodename($include_string);
164                $realname = clean_nodelabel($include_string);
165
166            } else {
167                # Don't record anything
168                $target   = "";
169                $realname = "";
170            }
171
172            # Maybe record dependency (unless it's circular)
173            if ($target ne "" and $target ne $module) {
174                $module_deps->{$target} = $realname;
175            }
176        }
177    }
178    close(CFILE);
179
180    # Store the updated dependencies.
181    $deps->{$module} = $module_deps;
182}
183
184sub process_dir($);      # forward declarations required because of recursion
185sub process_dir($)
186{
187    my ($parentd) = @_;
188
189    # Go through each file/dir in the directory.
190    my @fs = <*>;
191    foreach my $f (@fs) {
192        if (-d $f) {
193            # Directory -- recursively process unless we want to skip it.
194            if (not exists $dirs_to_skip{$f}) {
195                chdir $f or die;
196                process_dir($f);
197                chdir ".." or die;
198            }
199
200        } elsif (-f $f) {
201            if ($f =~ /\w+\.[cS]$/) {
202                # If this is a .c/.S file in coregrind/, it's a module in its
203                # own right, eg. coregrind/m_redir.c --> module name of
204                # "m_redir".
205                #
206                # Otherwise, it belongs to the module whose name is that of
207                # the parent directory, eg. coregrind/m_debuginfo/symtab.c
208                # --> module name of "m_debuginfo".
209                my $module;
210                if ($parentd eq "coregrind") {
211                    $module = $f;
212                    $module =~ s/(\w+).[cS]$/$1/;     # foo.c --> foo
213                } else {
214                    $module = $parentd;
215                }
216                # Now the module/f pair is either:
217                #   -    like this:  (m_redir, m_redir.c)
218                #   - or like this:  (m_debuginfo, symtab.c)
219                scan_C_or_asm_file($module, $f);
220            }
221
222        } else {
223            die "$f is not a dir nor a file\n";
224        }
225    }
226}
227
228sub print_graph()
229{
230    my %printed_realnames;
231
232    print("digraph G {\n");
233    while (my ($src, $dst_hash) = each %$deps) {
234        while (my ($dst, $dst_realname) = each %$dst_hash) {
235
236            # If the dstnode has a realname, print just the dstnode with that
237            # realname, and record it in %printed_realnames so we don't print
238            # it again.
239            if ($dst_realname ne "") {
240                if (not defined $printed_realnames{$dst}) {
241                    print("  $dst [label=\"$dst_realname\"]\n");
242                    $printed_realnames{$dst} = 1;
243                }
244            }
245            
246            # Print the src-->dst edge.
247            print("  $src -> $dst\n");
248        }
249    }
250    print("}\n");
251}
252
253#----------------------------------------------------------------------------
254# main
255#----------------------------------------------------------------------------
256process_cmd_line();
257
258my $start_dir = `basename \`pwd\``;
259chop($start_dir);           # trim newline
260process_dir($start_dir);
261
262print_graph();
263
264
265