123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270 |
- #!/usr/bin/env perl
- # SPDX-License-Identifier: GPL-2.0
- #
- # Generates a linker script that specifies the correct initcall order.
- #
- # Copyright (C) 2019 Google LLC
- use strict;
- use warnings;
- use IO::Handle;
- use IO::Select;
- use POSIX ":sys_wait_h";
- my $nm = $ENV{'NM'} || die "$0: ERROR: NM not set?";
- my $objtree = $ENV{'objtree'} || '.';
- ## currently active child processes
- my $jobs = {}; # child process pid -> file handle
- ## results from child processes
- my $results = {}; # object index -> [ { level, secname }, ... ]
- ## reads _NPROCESSORS_ONLN to determine the maximum number of processes to
- ## start
- sub get_online_processors {
- open(my $fh, "getconf _NPROCESSORS_ONLN 2>/dev/null |")
- or die "$0: ERROR: failed to execute getconf: $!";
- my $procs = <$fh>;
- close($fh);
- if (!($procs =~ /^\d+$/)) {
- return 1;
- }
- return int($procs);
- }
- ## writes results to the parent process
- ## format: <file index> <initcall level> <base initcall section name>
- sub write_results {
- my ($index, $initcalls) = @_;
- # sort by the counter value to ensure the order of initcalls within
- # each object file is correct
- foreach my $counter (sort { $a <=> $b } keys(%{$initcalls})) {
- my $level = $initcalls->{$counter}->{'level'};
- # section name for the initcall function
- my $secname = $initcalls->{$counter}->{'module'} . '__' .
- $counter . '_' .
- $initcalls->{$counter}->{'line'} . '_' .
- $initcalls->{$counter}->{'function'};
- print "$index $level $secname\n";
- }
- }
- ## reads a result line from a child process and adds it to the $results array
- sub read_results{
- my ($fh) = @_;
- # each child prints out a full line w/ autoflush and exits after the
- # last line, so even if buffered I/O blocks here, it shouldn't block
- # very long
- my $data = <$fh>;
- if (!defined($data)) {
- return 0;
- }
- chomp($data);
- my ($index, $level, $secname) = $data =~
- /^(\d+)\ ([^\ ]+)\ (.*)$/;
- if (!defined($index) ||
- !defined($level) ||
- !defined($secname)) {
- die "$0: ERROR: child process returned invalid data: $data\n";
- }
- $index = int($index);
- if (!exists($results->{$index})) {
- $results->{$index} = [];
- }
- push (@{$results->{$index}}, {
- 'level' => $level,
- 'secname' => $secname
- });
- return 1;
- }
- ## finds initcalls from an object file or all object files in an archive, and
- ## writes results back to the parent process
- sub find_initcalls {
- my ($index, $file) = @_;
- die "$0: ERROR: file $file doesn't exist?" if (! -f $file);
- open(my $fh, "\"$nm\" --defined-only \"$file\" 2>/dev/null |")
- or die "$0: ERROR: failed to execute \"$nm\": $!";
- my $initcalls = {};
- while (<$fh>) {
- chomp;
- # check for the start of a new object file (if processing an
- # archive)
- my ($path)= $_ =~ /^(.+)\:$/;
- if (defined($path)) {
- write_results($index, $initcalls);
- $initcalls = {};
- next;
- }
- # look for an initcall
- my ($module, $counter, $line, $symbol) = $_ =~
- /[a-z]\s+__initcall__(\S*)__(\d+)_(\d+)_(.*)$/;
- if (!defined($module)) {
- $module = ''
- }
- if (!defined($counter) ||
- !defined($line) ||
- !defined($symbol)) {
- next;
- }
- # parse initcall level
- my ($function, $level) = $symbol =~
- /^(.*)((early|rootfs|con|[0-9])s?)$/;
- die "$0: ERROR: invalid initcall name $symbol in $file($path)"
- if (!defined($function) || !defined($level));
- $initcalls->{$counter} = {
- 'module' => $module,
- 'line' => $line,
- 'function' => $function,
- 'level' => $level,
- };
- }
- close($fh);
- write_results($index, $initcalls);
- }
- ## waits for any child process to complete, reads the results, and adds them to
- ## the $results array for later processing
- sub wait_for_results {
- my ($select) = @_;
- my $pid = 0;
- do {
- # unblock children that may have a full write buffer
- foreach my $fh ($select->can_read(0)) {
- read_results($fh);
- }
- # check for children that have exited, read the remaining data
- # from them, and clean up
- $pid = waitpid(-1, WNOHANG);
- if ($pid > 0) {
- if (!exists($jobs->{$pid})) {
- next;
- }
- my $fh = $jobs->{$pid};
- $select->remove($fh);
- while (read_results($fh)) {
- # until eof
- }
- close($fh);
- delete($jobs->{$pid});
- }
- } while ($pid > 0);
- }
- ## forks a child to process each file passed in the command line and collects
- ## the results
- sub process_files {
- my $index = 0;
- my $njobs = $ENV{'PARALLELISM'} || get_online_processors();
- my $select = IO::Select->new();
- while (my $file = shift(@ARGV)) {
- # fork a child process and read it's stdout
- my $pid = open(my $fh, '-|');
- if (!defined($pid)) {
- die "$0: ERROR: failed to fork: $!";
- } elsif ($pid) {
- # save the child process pid and the file handle
- $select->add($fh);
- $jobs->{$pid} = $fh;
- } else {
- # in the child process
- STDOUT->autoflush(1);
- find_initcalls($index, "$objtree/$file");
- exit;
- }
- $index++;
- # limit the number of children to $njobs
- if (scalar(keys(%{$jobs})) >= $njobs) {
- wait_for_results($select);
- }
- }
- # wait for the remaining children to complete
- while (scalar(keys(%{$jobs})) > 0) {
- wait_for_results($select);
- }
- }
- sub generate_initcall_lds() {
- process_files();
- my $sections = {}; # level -> [ secname, ...]
- # sort results to retain link order and split to sections per
- # initcall level
- foreach my $index (sort { $a <=> $b } keys(%{$results})) {
- foreach my $result (@{$results->{$index}}) {
- my $level = $result->{'level'};
- if (!exists($sections->{$level})) {
- $sections->{$level} = [];
- }
- push(@{$sections->{$level}}, $result->{'secname'});
- }
- }
- die "$0: ERROR: no initcalls?" if (!keys(%{$sections}));
- # print out a linker script that defines the order of initcalls for
- # each level
- print "SECTIONS {\n";
- foreach my $level (sort(keys(%{$sections}))) {
- my $section;
- if ($level eq 'con') {
- $section = '.con_initcall.init';
- } else {
- $section = ".initcall${level}.init";
- }
- print "\t${section} : {\n";
- foreach my $secname (@{$sections->{$level}}) {
- print "\t\t*(${section}..${secname}) ;\n";
- }
- print "\t}\n";
- }
- print "}\n";
- }
- generate_initcall_lds();
|