.. | .. |
---|
8 | 8 | use strict; |
---|
9 | 9 | use warnings; |
---|
10 | 10 | use IO::Handle; |
---|
| 11 | +use IO::Select; |
---|
| 12 | +use POSIX ":sys_wait_h"; |
---|
11 | 13 | |
---|
12 | | -my $nm = $ENV{'LLVM_NM'} || "llvm-nm"; |
---|
13 | | -my $ar = $ENV{'AR'} || "llvm-ar"; |
---|
14 | | -my $objtree = $ENV{'objtree'} || "."; |
---|
| 14 | +my $nm = $ENV{'NM'} || die "$0: ERROR: NM not set?"; |
---|
| 15 | +my $objtree = $ENV{'objtree'} || '.'; |
---|
15 | 16 | |
---|
16 | | -## list of all object files to process, in link order |
---|
17 | | -my @objects; |
---|
18 | 17 | ## currently active child processes |
---|
19 | 18 | my $jobs = {}; # child process pid -> file handle |
---|
20 | 19 | ## results from child processes |
---|
21 | | -my $results = {}; # object index -> { level, function } |
---|
| 20 | +my $results = {}; # object index -> [ { level, secname }, ... ] |
---|
22 | 21 | |
---|
23 | | -## reads _NPROCESSORS_ONLN to determine the number of processes to start |
---|
| 22 | +## reads _NPROCESSORS_ONLN to determine the maximum number of processes to |
---|
| 23 | +## start |
---|
24 | 24 | sub get_online_processors { |
---|
25 | 25 | open(my $fh, "getconf _NPROCESSORS_ONLN 2>/dev/null |") |
---|
26 | | - or die "$0: failed to execute getconf: $!"; |
---|
| 26 | + or die "$0: ERROR: failed to execute getconf: $!"; |
---|
27 | 27 | my $procs = <$fh>; |
---|
28 | 28 | close($fh); |
---|
29 | 29 | |
---|
.. | .. |
---|
34 | 34 | return int($procs); |
---|
35 | 35 | } |
---|
36 | 36 | |
---|
37 | | -## finds initcalls defined in an object file, parses level and function name, |
---|
38 | | -## and prints it out to the parent process |
---|
| 37 | +## writes results to the parent process |
---|
| 38 | +## format: <file index> <initcall level> <base initcall section name> |
---|
| 39 | +sub write_results { |
---|
| 40 | + my ($index, $initcalls) = @_; |
---|
| 41 | + |
---|
| 42 | + # sort by the counter value to ensure the order of initcalls within |
---|
| 43 | + # each object file is correct |
---|
| 44 | + foreach my $counter (sort { $a <=> $b } keys(%{$initcalls})) { |
---|
| 45 | + my $level = $initcalls->{$counter}->{'level'}; |
---|
| 46 | + |
---|
| 47 | + # section name for the initcall function |
---|
| 48 | + my $secname = $initcalls->{$counter}->{'module'} . '__' . |
---|
| 49 | + $counter . '_' . |
---|
| 50 | + $initcalls->{$counter}->{'line'} . '_' . |
---|
| 51 | + $initcalls->{$counter}->{'function'}; |
---|
| 52 | + |
---|
| 53 | + print "$index $level $secname\n"; |
---|
| 54 | + } |
---|
| 55 | +} |
---|
| 56 | + |
---|
| 57 | +## reads a result line from a child process and adds it to the $results array |
---|
| 58 | +sub read_results{ |
---|
| 59 | + my ($fh) = @_; |
---|
| 60 | + |
---|
| 61 | + # each child prints out a full line w/ autoflush and exits after the |
---|
| 62 | + # last line, so even if buffered I/O blocks here, it shouldn't block |
---|
| 63 | + # very long |
---|
| 64 | + my $data = <$fh>; |
---|
| 65 | + |
---|
| 66 | + if (!defined($data)) { |
---|
| 67 | + return 0; |
---|
| 68 | + } |
---|
| 69 | + |
---|
| 70 | + chomp($data); |
---|
| 71 | + |
---|
| 72 | + my ($index, $level, $secname) = $data =~ |
---|
| 73 | + /^(\d+)\ ([^\ ]+)\ (.*)$/; |
---|
| 74 | + |
---|
| 75 | + if (!defined($index) || |
---|
| 76 | + !defined($level) || |
---|
| 77 | + !defined($secname)) { |
---|
| 78 | + die "$0: ERROR: child process returned invalid data: $data\n"; |
---|
| 79 | + } |
---|
| 80 | + |
---|
| 81 | + $index = int($index); |
---|
| 82 | + |
---|
| 83 | + if (!exists($results->{$index})) { |
---|
| 84 | + $results->{$index} = []; |
---|
| 85 | + } |
---|
| 86 | + |
---|
| 87 | + push (@{$results->{$index}}, { |
---|
| 88 | + 'level' => $level, |
---|
| 89 | + 'secname' => $secname |
---|
| 90 | + }); |
---|
| 91 | + |
---|
| 92 | + return 1; |
---|
| 93 | +} |
---|
| 94 | + |
---|
| 95 | +## finds initcalls from an object file or all object files in an archive, and |
---|
| 96 | +## writes results back to the parent process |
---|
39 | 97 | sub find_initcalls { |
---|
40 | | - my ($object) = @_; |
---|
| 98 | + my ($index, $file) = @_; |
---|
41 | 99 | |
---|
42 | | - die "$0: object file $object doesn't exist?" if (! -f $object); |
---|
| 100 | + die "$0: ERROR: file $file doesn't exist?" if (! -f $file); |
---|
43 | 101 | |
---|
44 | | - open(my $fh, "\"$nm\" --just-symbol-name --defined-only \"$object\" 2>/dev/null |") |
---|
45 | | - or die "$0: failed to execute \"$nm\": $!"; |
---|
| 102 | + open(my $fh, "\"$nm\" --defined-only \"$file\" 2>/dev/null |") |
---|
| 103 | + or die "$0: ERROR: failed to execute \"$nm\": $!"; |
---|
46 | 104 | |
---|
47 | 105 | my $initcalls = {}; |
---|
48 | 106 | |
---|
49 | 107 | while (<$fh>) { |
---|
50 | 108 | chomp; |
---|
51 | 109 | |
---|
52 | | - my ($counter, $line, $symbol) = $_ =~ /^__initcall_(\d+)_(\d+)_(.*)$/; |
---|
| 110 | + # check for the start of a new object file (if processing an |
---|
| 111 | + # archive) |
---|
| 112 | + my ($path)= $_ =~ /^(.+)\:$/; |
---|
53 | 113 | |
---|
54 | | - if (!defined($counter) || !defined($line) || !defined($symbol)) { |
---|
| 114 | + if (defined($path)) { |
---|
| 115 | + write_results($index, $initcalls); |
---|
| 116 | + $initcalls = {}; |
---|
55 | 117 | next; |
---|
56 | 118 | } |
---|
57 | 119 | |
---|
58 | | - my ($function, $level) = $symbol =~ |
---|
59 | | - /^(.*)((early|rootfs|con|security|[0-9])s?)$/; |
---|
| 120 | + # look for an initcall |
---|
| 121 | + my ($module, $counter, $line, $symbol) = $_ =~ |
---|
| 122 | + /[a-z]\s+__initcall__(\S*)__(\d+)_(\d+)_(.*)$/; |
---|
60 | 123 | |
---|
61 | | - die "$0: duplicate initcall counter value in object $object: $_" |
---|
62 | | - if exists($initcalls->{$counter}); |
---|
| 124 | + if (!defined($module)) { |
---|
| 125 | + $module = '' |
---|
| 126 | + } |
---|
| 127 | + |
---|
| 128 | + if (!defined($counter) || |
---|
| 129 | + !defined($line) || |
---|
| 130 | + !defined($symbol)) { |
---|
| 131 | + next; |
---|
| 132 | + } |
---|
| 133 | + |
---|
| 134 | + # parse initcall level |
---|
| 135 | + my ($function, $level) = $symbol =~ |
---|
| 136 | + /^(.*)((early|rootfs|con|[0-9])s?)$/; |
---|
| 137 | + |
---|
| 138 | + die "$0: ERROR: invalid initcall name $symbol in $file($path)" |
---|
| 139 | + if (!defined($function) || !defined($level)); |
---|
63 | 140 | |
---|
64 | 141 | $initcalls->{$counter} = { |
---|
65 | | - 'level' => $level, |
---|
| 142 | + 'module' => $module, |
---|
66 | 143 | 'line' => $line, |
---|
67 | | - 'function' => $function |
---|
| 144 | + 'function' => $function, |
---|
| 145 | + 'level' => $level, |
---|
68 | 146 | }; |
---|
69 | 147 | } |
---|
70 | 148 | |
---|
71 | 149 | close($fh); |
---|
72 | | - |
---|
73 | | - # sort initcalls in each object file numerically by the counter value |
---|
74 | | - # to ensure they are in the order they were defined |
---|
75 | | - foreach my $counter (sort { $a <=> $b } keys(%{$initcalls})) { |
---|
76 | | - print $initcalls->{$counter}->{"level"} . " " . |
---|
77 | | - $counter . " " . |
---|
78 | | - $initcalls->{$counter}->{"line"} . " " . |
---|
79 | | - $initcalls->{$counter}->{"function"} . "\n"; |
---|
80 | | - } |
---|
| 150 | + write_results($index, $initcalls); |
---|
81 | 151 | } |
---|
82 | 152 | |
---|
83 | 153 | ## waits for any child process to complete, reads the results, and adds them to |
---|
84 | 154 | ## the $results array for later processing |
---|
85 | 155 | sub wait_for_results { |
---|
86 | | - my $pid = wait(); |
---|
87 | | - if ($pid > 0) { |
---|
88 | | - my $fh = $jobs->{$pid}; |
---|
| 156 | + my ($select) = @_; |
---|
89 | 157 | |
---|
90 | | - # the child process prints out results in the following format: |
---|
91 | | - # line 1: <object file index> |
---|
92 | | - # line 2..n: <level> <counter> <line> <function> |
---|
93 | | - |
---|
94 | | - my $index = <$fh>; |
---|
95 | | - chomp($index); |
---|
96 | | - |
---|
97 | | - if (!($index =~ /^\d+$/)) { |
---|
98 | | - die "$0: child $pid returned an invalid index: $index"; |
---|
99 | | - } |
---|
100 | | - $index = int($index); |
---|
101 | | - |
---|
102 | | - while (<$fh>) { |
---|
103 | | - chomp; |
---|
104 | | - my ($level, $counter, $line, $function) = $_ =~ |
---|
105 | | - /^([^\ ]+)\ (\d+)\ (\d+)\ (.*)$/; |
---|
106 | | - |
---|
107 | | - if (!defined($level) || |
---|
108 | | - !defined($counter) || |
---|
109 | | - !defined($line) || |
---|
110 | | - !defined($function)) { |
---|
111 | | - die "$0: child $pid returned invalid data"; |
---|
112 | | - } |
---|
113 | | - |
---|
114 | | - if (!exists($results->{$index})) { |
---|
115 | | - $results->{$index} = []; |
---|
116 | | - } |
---|
117 | | - |
---|
118 | | - push (@{$results->{$index}}, { |
---|
119 | | - 'level' => $level, |
---|
120 | | - 'counter' => $counter, |
---|
121 | | - 'line' => $line, |
---|
122 | | - 'function' => $function |
---|
123 | | - }); |
---|
| 158 | + my $pid = 0; |
---|
| 159 | + do { |
---|
| 160 | + # unblock children that may have a full write buffer |
---|
| 161 | + foreach my $fh ($select->can_read(0)) { |
---|
| 162 | + read_results($fh); |
---|
124 | 163 | } |
---|
125 | 164 | |
---|
126 | | - close($fh); |
---|
127 | | - delete($jobs->{$pid}); |
---|
128 | | - } |
---|
| 165 | + # check for children that have exited, read the remaining data |
---|
| 166 | + # from them, and clean up |
---|
| 167 | + $pid = waitpid(-1, WNOHANG); |
---|
| 168 | + if ($pid > 0) { |
---|
| 169 | + if (!exists($jobs->{$pid})) { |
---|
| 170 | + next; |
---|
| 171 | + } |
---|
| 172 | + |
---|
| 173 | + my $fh = $jobs->{$pid}; |
---|
| 174 | + $select->remove($fh); |
---|
| 175 | + |
---|
| 176 | + while (read_results($fh)) { |
---|
| 177 | + # until eof |
---|
| 178 | + } |
---|
| 179 | + |
---|
| 180 | + close($fh); |
---|
| 181 | + delete($jobs->{$pid}); |
---|
| 182 | + } |
---|
| 183 | + } while ($pid > 0); |
---|
129 | 184 | } |
---|
130 | 185 | |
---|
131 | | -## launches child processes to find initcalls from the object files, waits for |
---|
132 | | -## each process to complete and collects the results |
---|
133 | | -sub process_objects { |
---|
134 | | - my $index = 0; # link order index of the object file |
---|
135 | | - my $njobs = get_online_processors(); |
---|
| 186 | +## forks a child to process each file passed in the command line and collects |
---|
| 187 | +## the results |
---|
| 188 | +sub process_files { |
---|
| 189 | + my $index = 0; |
---|
| 190 | + my $njobs = $ENV{'PARALLELISM'} || get_online_processors(); |
---|
| 191 | + my $select = IO::Select->new(); |
---|
136 | 192 | |
---|
137 | | - while (scalar(@objects) > 0) { |
---|
138 | | - my $object = shift(@objects); |
---|
139 | | - |
---|
| 193 | + while (my $file = shift(@ARGV)) { |
---|
140 | 194 | # fork a child process and read it's stdout |
---|
141 | 195 | my $pid = open(my $fh, '-|'); |
---|
142 | 196 | |
---|
143 | 197 | if (!defined($pid)) { |
---|
144 | | - die "$0: failed to fork: $!"; |
---|
| 198 | + die "$0: ERROR: failed to fork: $!"; |
---|
145 | 199 | } elsif ($pid) { |
---|
146 | 200 | # save the child process pid and the file handle |
---|
| 201 | + $select->add($fh); |
---|
147 | 202 | $jobs->{$pid} = $fh; |
---|
148 | 203 | } else { |
---|
| 204 | + # in the child process |
---|
149 | 205 | STDOUT->autoflush(1); |
---|
150 | | - print "$index\n"; |
---|
151 | | - find_initcalls("$objtree/$object"); |
---|
| 206 | + find_initcalls($index, "$objtree/$file"); |
---|
152 | 207 | exit; |
---|
153 | 208 | } |
---|
154 | 209 | |
---|
155 | 210 | $index++; |
---|
156 | 211 | |
---|
157 | | - # if we reached the maximum number of processes, wait for one |
---|
158 | | - # to complete before launching new ones |
---|
159 | | - if (scalar(keys(%{$jobs})) >= $njobs && scalar(@objects) > 0) { |
---|
160 | | - wait_for_results(); |
---|
| 212 | + # limit the number of children to $njobs |
---|
| 213 | + if (scalar(keys(%{$jobs})) >= $njobs) { |
---|
| 214 | + wait_for_results($select); |
---|
161 | 215 | } |
---|
162 | 216 | } |
---|
163 | 217 | |
---|
164 | 218 | # wait for the remaining children to complete |
---|
165 | 219 | while (scalar(keys(%{$jobs})) > 0) { |
---|
166 | | - wait_for_results(); |
---|
| 220 | + wait_for_results($select); |
---|
167 | 221 | } |
---|
168 | 222 | } |
---|
169 | 223 | |
---|
170 | | -## gets a list of actual object files from thin archives, and adds them to |
---|
171 | | -## @objects in link order |
---|
172 | | -sub find_objects { |
---|
173 | | - while (my $file = shift(@ARGV)) { |
---|
174 | | - my $pid = open (my $fh, "\"$ar\" t \"$file\" 2>/dev/null |") |
---|
175 | | - or die "$0: failed to execute $ar: $!"; |
---|
| 224 | +sub generate_initcall_lds() { |
---|
| 225 | + process_files(); |
---|
176 | 226 | |
---|
177 | | - my @output; |
---|
| 227 | + my $sections = {}; # level -> [ secname, ...] |
---|
178 | 228 | |
---|
179 | | - while (<$fh>) { |
---|
180 | | - chomp; |
---|
181 | | - push(@output, $_); |
---|
182 | | - } |
---|
| 229 | + # sort results to retain link order and split to sections per |
---|
| 230 | + # initcall level |
---|
| 231 | + foreach my $index (sort { $a <=> $b } keys(%{$results})) { |
---|
| 232 | + foreach my $result (@{$results->{$index}}) { |
---|
| 233 | + my $level = $result->{'level'}; |
---|
183 | 234 | |
---|
184 | | - close($fh); |
---|
| 235 | + if (!exists($sections->{$level})) { |
---|
| 236 | + $sections->{$level} = []; |
---|
| 237 | + } |
---|
185 | 238 | |
---|
186 | | - # if $ar failed, assume we have an object file |
---|
187 | | - if ($? != 0) { |
---|
188 | | - push(@objects, $file); |
---|
189 | | - next; |
---|
190 | | - } |
---|
191 | | - |
---|
192 | | - # if $ar succeeded, read the list of object files |
---|
193 | | - foreach (@output) { |
---|
194 | | - push(@objects, $_); |
---|
| 239 | + push(@{$sections->{$level}}, $result->{'secname'}); |
---|
195 | 240 | } |
---|
196 | 241 | } |
---|
197 | | -} |
---|
198 | 242 | |
---|
199 | | -## START |
---|
200 | | -find_objects(); |
---|
201 | | -process_objects(); |
---|
| 243 | + die "$0: ERROR: no initcalls?" if (!keys(%{$sections})); |
---|
202 | 244 | |
---|
203 | | -## process results and add them to $sections in the correct order |
---|
204 | | -my $sections = {}; |
---|
| 245 | + # print out a linker script that defines the order of initcalls for |
---|
| 246 | + # each level |
---|
| 247 | + print "SECTIONS {\n"; |
---|
205 | 248 | |
---|
206 | | -foreach my $index (sort { $a <=> $b } keys(%{$results})) { |
---|
207 | | - foreach my $result (@{$results->{$index}}) { |
---|
208 | | - my $level = $result->{'level'}; |
---|
| 249 | + foreach my $level (sort(keys(%{$sections}))) { |
---|
| 250 | + my $section; |
---|
209 | 251 | |
---|
210 | | - if (!exists($sections->{$level})) { |
---|
211 | | - $sections->{$level} = []; |
---|
| 252 | + if ($level eq 'con') { |
---|
| 253 | + $section = '.con_initcall.init'; |
---|
| 254 | + } else { |
---|
| 255 | + $section = ".initcall${level}.init"; |
---|
212 | 256 | } |
---|
213 | 257 | |
---|
214 | | - my $fsname = $result->{'counter'} . '_' . |
---|
215 | | - $result->{'line'} . '_' . |
---|
216 | | - $result->{'function'}; |
---|
| 258 | + print "\t${section} : {\n"; |
---|
217 | 259 | |
---|
218 | | - push(@{$sections->{$level}}, $fsname); |
---|
219 | | - } |
---|
220 | | -} |
---|
| 260 | + foreach my $secname (@{$sections->{$level}}) { |
---|
| 261 | + print "\t\t*(${section}..${secname}) ;\n"; |
---|
| 262 | + } |
---|
221 | 263 | |
---|
222 | | -if (!keys(%{$sections})) { |
---|
223 | | - exit(0); # no initcalls...? |
---|
224 | | -} |
---|
225 | | - |
---|
226 | | -## print out a linker script that defines the order of initcalls for each |
---|
227 | | -## level |
---|
228 | | -print "SECTIONS {\n"; |
---|
229 | | - |
---|
230 | | -foreach my $level (sort(keys(%{$sections}))) { |
---|
231 | | - my $section; |
---|
232 | | - |
---|
233 | | - if ($level eq 'con') { |
---|
234 | | - $section = '.con_initcall.init'; |
---|
235 | | - } elsif ($level eq 'security') { |
---|
236 | | - $section = '.security_initcall.init'; |
---|
237 | | - } else { |
---|
238 | | - $section = ".initcall${level}.init"; |
---|
| 264 | + print "\t}\n"; |
---|
239 | 265 | } |
---|
240 | 266 | |
---|
241 | | - print "\t${section} : {\n"; |
---|
242 | | - |
---|
243 | | - foreach my $fsname (@{$sections->{$level}}) { |
---|
244 | | - print "\t\t*(${section}..${fsname}) ;\n" |
---|
245 | | - } |
---|
246 | | - |
---|
247 | | - print "\t}\n"; |
---|
| 267 | + print "}\n"; |
---|
248 | 268 | } |
---|
249 | 269 | |
---|
250 | | -print "}\n"; |
---|
| 270 | +generate_initcall_lds(); |
---|