Reid Spencer | f2722ca | 2006-03-22 15:59:55 +0000 | [diff] [blame] | 1 | #!/usr/bin/perl |
| 2 | # |
| 3 | # Program: find-cycles.pl |
| 4 | # |
| 5 | # Synopsis: Given a list of possibly cyclic dependencies, merge all the |
| 6 | # cycles. This makes it possible to topologically sort the |
| 7 | # dependencies between different parts of LLVM. |
| 8 | # |
| 9 | # Syntax: find-cycles.pl < LibDeps.txt > FinalLibDeps.txt |
| 10 | # |
| 11 | # Input: cycmem1: cycmem2 dep1 dep2 |
| 12 | # cycmem2: cycmem1 dep3 dep4 |
| 13 | # boring: dep4 |
| 14 | # |
| 15 | # Output: cycmem1 cycmem2: dep1 dep2 dep3 dep4 |
| 16 | # boring: dep4 |
| 17 | # |
| 18 | # This file was written by Eric Kidd, and is placed into the public domain. |
| 19 | # |
| 20 | |
Reid Spencer | b195d9d | 2006-03-23 23:21:29 +0000 | [diff] [blame] | 21 | use 5.006; |
Reid Spencer | f2722ca | 2006-03-22 15:59:55 +0000 | [diff] [blame] | 22 | use strict; |
| 23 | use warnings; |
| 24 | |
| 25 | my %DEPS; |
| 26 | my @CYCLES; |
| 27 | sub find_all_cycles; |
| 28 | |
| 29 | # Read our dependency information. |
| 30 | while (<>) { |
| 31 | chomp; |
| 32 | my ($module, $dependency_str) = /^([^:]*): ?(.*)$/; |
| 33 | die "Malformed data: $_" unless defined $dependency_str; |
| 34 | my @dependencies = split(/ /, $dependency_str); |
| 35 | $DEPS{$module} = \@dependencies; |
| 36 | } |
| 37 | |
| 38 | # Partition our raw dependencies into sets of cyclically-connected nodes. |
| 39 | find_all_cycles(); |
| 40 | |
| 41 | # Print out the finished cycles, with their dependencies. |
| 42 | my @output; |
| 43 | foreach my $cycle (@CYCLES) { |
| 44 | my @modules = sort keys %{$cycle}; |
| 45 | |
| 46 | # Merge the dependencies of all modules in this cycle. |
| 47 | my %dependencies; |
| 48 | foreach my $module (@modules) { |
| 49 | @dependencies{@{$DEPS{$module}}} = 1; |
| 50 | } |
| 51 | |
| 52 | # Prune the known cyclic dependencies. |
| 53 | foreach my $module (@modules) { |
| 54 | delete $dependencies{$module}; |
| 55 | } |
| 56 | |
| 57 | # Warn about possible linker problems. |
| 58 | my @archives = grep(/\.a$/, @modules); |
| 59 | if (@archives > 1) { |
| 60 | print STDERR "find-cycles.pl: Circular dependency between *.a files:\n"; |
| 61 | print STDERR "find-cycles.pl: ", join(' ', @archives), "\n"; |
| 62 | print STDERR "find-cycles.pl: Some linkers may have problems.\n"; |
| 63 | push @modules, @archives; # WORKAROUND: Duplicate *.a files. Ick. |
| 64 | } |
| 65 | |
| 66 | # Add to our output. (@modules is already as sorted as we need it to be.) |
| 67 | push @output, (join(' ', @modules) . ': ' . |
| 68 | join(' ', sort keys %dependencies) . "\n"); |
| 69 | } |
| 70 | print sort @output; |
| 71 | |
| 72 | |
| 73 | #========================================================================== |
| 74 | # Depedency Cycle Support |
| 75 | #========================================================================== |
| 76 | # For now, we have cycles in our dependency graph. Ideally, each cycle |
| 77 | # would be collapsed down to a single *.a file, saving us all this work. |
| 78 | # |
| 79 | # To understand this code, you'll need a working knowledge of Perl 5, |
| 80 | # and possibly some quality time with 'man perlref'. |
| 81 | |
| 82 | my %SEEN; |
| 83 | my %CYCLES; |
| 84 | sub find_cycles ($@); |
| 85 | sub found_cycles ($@); |
| 86 | |
| 87 | sub find_all_cycles { |
| 88 | # Find all multi-item cycles. |
| 89 | my @modules = sort keys %DEPS; |
| 90 | foreach my $module (@modules) { find_cycles($module); } |
| 91 | |
| 92 | # Build fake one-item "cycles" for the remaining modules, so we can |
| 93 | # treat them uniformly. |
| 94 | foreach my $module (@modules) { |
| 95 | unless (defined $CYCLES{$module}) { |
| 96 | my %cycle = ($module, 1); |
| 97 | $CYCLES{$module} = \%cycle; |
| 98 | } |
| 99 | } |
| 100 | |
| 101 | # Find all our unique cycles. We have to do this the hard way because |
| 102 | # we apparently can't store hash references as hash keys without making |
| 103 | # 'strict refs' sad. |
| 104 | my %seen; |
| 105 | foreach my $cycle (values %CYCLES) { |
| 106 | unless ($seen{$cycle}) { |
| 107 | $seen{$cycle} = 1; |
| 108 | push @CYCLES, $cycle; |
| 109 | } |
| 110 | } |
| 111 | } |
| 112 | |
| 113 | # Walk through our graph depth-first (keeping a trail in @path), and report |
| 114 | # any cycles we find. |
| 115 | sub find_cycles ($@) { |
| 116 | my ($module, @path) = @_; |
| 117 | if (str_in_list($module, @path)) { |
| 118 | found_cycle($module, @path); |
| 119 | } else { |
| 120 | return if defined $SEEN{$module}; |
| 121 | $SEEN{$module} = 1; |
| 122 | foreach my $dep (@{$DEPS{$module}}) { |
| 123 | find_cycles($dep, @path, $module); |
| 124 | } |
| 125 | } |
| 126 | } |
| 127 | |
| 128 | # Give a cycle, attempt to merge it with pre-existing cycle data. |
| 129 | sub found_cycle ($@) { |
| 130 | my ($module, @path) = @_; |
| 131 | |
| 132 | # Pop any modules which aren't part of our cycle. |
| 133 | while ($path[0] ne $module) { shift @path; } |
| 134 | #print join("->", @path, $module) . "\n"; |
| 135 | |
| 136 | # Collect the modules in our cycle into a hash. |
| 137 | my %cycle; |
| 138 | foreach my $item (@path) { |
| 139 | $cycle{$item} = 1; |
| 140 | if (defined $CYCLES{$item}) { |
| 141 | # Looks like we intersect with an existing cycle, so merge |
| 142 | # all those in, too. |
| 143 | foreach my $old_item (keys %{$CYCLES{$item}}) { |
| 144 | $cycle{$old_item} = 1; |
| 145 | } |
| 146 | } |
| 147 | } |
| 148 | |
| 149 | # Update our global cycle table. |
| 150 | my $cycle_ref = \%cycle; |
| 151 | foreach my $item (keys %cycle) { |
| 152 | $CYCLES{$item} = $cycle_ref; |
| 153 | } |
| 154 | #print join(":", sort keys %cycle) . "\n"; |
| 155 | } |
| 156 | |
| 157 | sub str_in_list ($@) { |
| 158 | my ($str, @list) = @_; |
| 159 | foreach my $item (@list) { |
| 160 | return 1 if ($item eq $str); |
| 161 | } |
| 162 | return 0; |
| 163 | } |