271 строка
5.9 KiB
Perl
271 строка
5.9 KiB
Perl
|
#!/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();
|