SSL generate_initcall_order.pl Sprache: Shell

#!/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();

quality36%

¤ Dauer der Verarbeitung: 0.30 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.