scripts/generate_initcall_order.pl

   1 #!/usr/bin/env perl
   2 # SPDX-License-Identifier: GPL-2.0
   3 #
   4 # Generates a linker script that specifies the correct initcall order.
   5 #
   6 # Copyright (C) 2019 Google LLC
   7
   8 use strict;
   9 use warnings;
  10 use IO::Handle;
  11 use IO::Select;
  12 use POSIX ":sys_wait_h";
  13
  14 my $nm = $ENV{'NM'} || die "$0: ERROR: NM not set?";
  15 my $objtree = $ENV{'objtree'} || '.';
  16
  17 ## currently active child processes
  18 my $jobs = {};          # child process pid -> file handle
  19 ## results from child processes
  20 my $results = {};       # object index -> [ { level, secname }, ... ]
  21
  22 ## reads _NPROCESSORS_ONLN to determine the maximum number of processes to
  23 ## start
  24 sub get_online_processors {
  25         open(my $fh, "getconf _NPROCESSORS_ONLN 2>/dev/null |")
  26                 or die "$0: ERROR: failed to execute getconf: $!";
  27         my $procs = <$fh>;
  28         close($fh);
  29
  30         if (!($procs =~ /^\d+$/)) {
  31                 return 1;
  32         }
  33
  34         return int($procs);
  35 }
  36
  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
  97 sub find_initcalls {
  98         my ($index, $file) = @_;
  99
 100         die "$0: ERROR: file $file doesn't exist?" if (! -f $file);
 101
 102         open(my $fh, "\"$nm\" --defined-only \"$file\" 2>/dev/null |")
 103                 or die "$0: ERROR: failed to execute \"$nm\": $!";
 104
 105         my $initcalls = {};
 106
 107         while (<$fh>) {
 108                 chomp;
 109
 110                 # check for the start of a new object file (if processing an
 111                 # archive)
 112                 my ($path)= $_ =~ /^(.+)\:$/;
 113
 114                 if (defined($path)) {
 115                         write_results($index, $initcalls);
 116                         $initcalls = {};
 117                         next;
 118                 }
 119
 120                 # look for an initcall
 121                 my ($module, $counter, $line, $symbol) = $_ =~
 122                         /[a-z]\s+__initcall__(\S*)__(\d+)_(\d+)_(.*)$/;
 123
 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));
 140
 141                 $initcalls->{$counter} = {
 142                         'module'   => $module,
 143                         'line'     => $line,
 144                         'function' => $function,
 145                         'level'    => $level,
 146                 };
 147         }
 148
 149         close($fh);
 150         write_results($index, $initcalls);
 151 }
 152
 153 ## waits for any child process to complete, reads the results, and adds them to
 154 ## the $results array for later processing
 155 sub wait_for_results {
 156         my ($select) = @_;
 157
 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);
 163                 }
 164
 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);
 184 }
 185
 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();
 192
 193         while (my $file = shift(@ARGV)) {
 194                 # fork a child process and read it's stdout
 195                 my $pid = open(my $fh, '-|');
 196
 197                 if (!defined($pid)) {
 198                         die "$0: ERROR: failed to fork: $!";
 199                 } elsif ($pid) {
 200                         # save the child process pid and the file handle
 201                         $select->add($fh);
 202                         $jobs->{$pid} = $fh;
 203                 } else {
 204                         # in the child process
 205                         STDOUT->autoflush(1);
 206                         find_initcalls($index, "$objtree/$file");
 207                         exit;
 208                 }
 209
 210                 $index++;
 211
 212                 # limit the number of children to $njobs
 213                 if (scalar(keys(%{$jobs})) >= $njobs) {
 214                         wait_for_results($select);
 215                 }
 216         }
 217
 218         # wait for the remaining children to complete
 219         while (scalar(keys(%{$jobs})) > 0) {
 220                 wait_for_results($select);
 221         }
 222 }
 223
 224 sub generate_initcall_lds() {
 225         process_files();
 226
 227         my $sections = {};      # level -> [ secname, ...]
 228
 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'};
 234
 235                         if (!exists($sections->{$level})) {
 236                                 $sections->{$level} = [];
 237                         }
 238
 239                         push(@{$sections->{$level}}, $result->{'secname'});
 240                 }
 241         }
 242
 243         die "$0: ERROR: no initcalls?" if (!keys(%{$sections}));
 244
 245         # print out a linker script that defines the order of initcalls for
 246         # each level
 247         print "SECTIONS {\n";
 248
 249         foreach my $level (sort(keys(%{$sections}))) {
 250                 my $section;
 251
 252                 if ($level eq 'con') {
 253                         $section = '.con_initcall.init';
 254                 } else {
 255                         $section = ".initcall${level}.init";
 256                 }
 257
 258                 print "\t${section} : {\n";
 259
 260                 foreach my $secname (@{$sections->{$level}}) {
 261                         print "\t\t*(${section}..${secname}) ;\n";
 262                 }
 263
 264                 print "\t}\n";
 265         }
 266
 267         print "}\n";
 268 }
 269
 270 generate_initcall_lds();