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