diff options
Diffstat (limited to 'tools/apbuild/Apbuild')
-rw-r--r-- | tools/apbuild/Apbuild/GCC.pm | 539 | ||||
-rw-r--r-- | tools/apbuild/Apbuild/Utils.pm | 195 |
2 files changed, 734 insertions, 0 deletions
diff --git a/tools/apbuild/Apbuild/GCC.pm b/tools/apbuild/Apbuild/GCC.pm new file mode 100644 index 00000000..b4246148 --- /dev/null +++ b/tools/apbuild/Apbuild/GCC.pm @@ -0,0 +1,539 @@ +# Various gcc-related functions +package Apbuild::GCC; + +use strict; +use Apbuild::Utils; +use IPC::Open3; + + +######## Special constants; used for parsing GCC parameters ######## + +# Parameters that require an extra parameter +our $extraTypes = 'o|u|Xlinker|b|V|MF|MT|MQ|I|L|R|Wl,-rpath|isystem|D|x'; +# Linker parameters +our $linkerTypes = 'L|Wl|o$|l|s|n|R'; +# Files with these extensions are objects +our $staticLibTypes = 'a|al'; +our $objectTypes = "o|os|so(\\.\\d+)*|la|lo|$staticLibTypes"; +our $headerTypes = 'h|hpp'; +# Source file types +our $cTypes = 'c|C'; +our $cxxTypes = 'cpp|cxx|cc|c\+\+'; +our $srcTypes = "$cTypes|$cxxTypes"; + + +######## Methods ######## + +## +# Apbuild::GCC->new(gcc_command) +# gcc_command: The command for invoking GCC. +# +# Create a new Apbuild:GCC object. +sub new { + my ($class, $gcc) = @_; + my %self; + + $self{gcc} = $gcc; + $self{gcc_file} = checkCommand($gcc); + if (!defined $self{gcc_file}) { + error "$gcc: command not found\n"; + exit 127; + } + + # FIXME: should use gcc -print-search-paths. + $self{searchPaths} = ["/usr/lib", "/usr/local/lib"]; + foreach (reverse(split(/:/, $ENV{LIBRARY_PATH}))) { + push @{$self{searchPaths}}, $_; + } + + bless \%self, $class; + return \%self; +} + +## +# $gcc->capabilities() +# Returns: a hash with capabilities for this compiler. +# +# Check GCC's capabilities. This function will return +# a hash with the following keys: +# libgcc : Is 1 if gcc supports the parameter -{shared,static}-libgcc. +# as_needed: Is 1 if gcc's linker supports --as-needed. +# abi2 : Is 1 if gcc supports -fabi-version=2. +# +# This function takes care of caching results. +sub capabilities { + my ($self) = @_; + my (%capabilities, %cache); + + my $gcc = $self->{gcc}; + my $gcc_file = $self->{gcc_file}; + + # First, check the cache + my @stat = stat $gcc_file; + my $gcc_mtime = $stat[9]; + my $home = homeDir(); + if (-f "$home/.apbuild") { + parseDataFile("$home/.apbuild", \%cache); + if ($cache{version} != 2) { + # Cache file version incompatible; delete cache + %cache = (); + + } else { + if ($cache{"mtime_$gcc_file"} != $gcc_mtime) { + # Cache out of date for this compiler; update cache + delete $cache{"libgcc_$gcc_file"}; + delete $cache{"abi2_$gcc_file"}; + delete $cache{"as_needed_$gcc_file"}; + delete $cache{"hash_style_$gcc_file"}; + delete $cache{"stack_protector_$gcc_file"}; + delete $cache{"fortify_source_$gcc_file"}; + } + } + } + + my $lc_all = $ENV{LC_ALL}; + $ENV{LC_ALL} = 'C'; + + if (exists $cache{"libgcc_$gcc_file"} && exists $cache{"abi2_$gcc_file"}) { + $capabilities{libgcc} = $cache{"libgcc_$gcc_file"}; + $capabilities{abi2} = $cache{"abi2_$gcc_file"}; + + } else { + # Get output from 'gcc -v' + my ($r, $w, $e); + + my $pid = open3($w, $r, $e, $gcc_file, '-v'); + close $w if ($w); + close $e if ($e); + my @output = <$r>; + waitpid $pid, 0; + + # Check whether gcc >= 3.0 + my ($major, $minor) = $output[@output - 1] =~ /version ([0-9]+)\.([0-9]+)/; + if ($major >= 3) { + $capabilities{libgcc} = 1; + $cache{"libgcc_$gcc_file"} = 1; + } else { + $capabilities{libgcc} = 0; + $cache{"libgcc_$gcc_file"} = 0; + } + + if ($major > 3 || ($major >= 3 && $minor >= 4)) { + $capabilities{abi2} = 1; + $cache{"abi2_$gcc_file"} = 1; + } else { + $capabilities{abi2} = 0; + $cache{"abi2_$gcc_file"} = 0; + } + + $cache{"mtime_$gcc_file"} = $gcc_mtime; + } + + if (exists $cache{"as_needed_$gcc_file"}) { + $capabilities{as_needed} = $cache{"as_needed_$gcc_file"}; + + } else { + my ($r, $w, $e); + + my $pid = open3($w, $r, $e, $gcc_file, '-Wl,--help'); + close $w if ($w); + close $e if ($e); + local($/); + my $output = <$r>; + waitpid $pid, 0; + + if ($output =~ /--as-needed/) { + $capabilities{as_needed} = 1; + $cache{"as_needed_$gcc_file"} = 1; + } else { + $capabilities{as_needed} = 0; + $cache{"as_needed_$gcc_file"} = 0; + } + } + + if (exists $cache{"hash_style_$gcc_file"}) { + $capabilities{hash_style} = $cache{"hash_style_$gcc_file"}; + } else { + my ($r, $w, $e); + + my $pid = open3($w, $r, $e, $gcc_file, '-Wl,--help'); + close $w if ($w); + close $e if ($e); + local($/); + my $output = <$r>; + waitpid $pid, 0; + + if ($output =~ /--hash-style/) { + $capabilities{hash_style} = 1; + $cache{"hash_style_$gcc_file"} = 1; + } else { + $capabilities{hash_style} = 0; + $cache{"hash_style_$gcc_file"} = 0; + } + } + + if (exists $cache{"stack_protector_$gcc_file"}) { + $capabilities{stack_protector} = $cache{"stack_protector_$gcc_file"}; + } else { + # Get output from 'gcc -v' + my ($r, $w, $e); + + my $pid = open3($w, $r, $e, $gcc_file, '-v'); + close $w if ($w); + close $e if ($e); + my @output = <$r>; + waitpid $pid, 0; + + # Check whether gcc >= 3.0 + my ($major, $minor) = $output[@output - 1] =~ /version ([0-9]+)\.([0-9]+)/; + if ($major >= 4 && $minor >= 1) { + $capabilities{stack_protector} = 1; + $cache{"stack_protector_$gcc_file"} = 1; + } else { + $capabilities{stack_protector} = 0; + $cache{"stack_protector_$gcc_file"} = 0; + } + } + + if (exists $cache{"fortify_source_$gcc_file"}) { + $capabilities{fortify_source} = $cache{"fortify_source_$gcc_file"}; + } else { + # Get output from 'gcc -v' + my ($r, $w, $e); + + my $pid = open3($w, $r, $e, $gcc_file, '-v'); + close $w if ($w); + close $e if ($e); + my @output = <$r>; + waitpid $pid, 0; + + # Check whether gcc >= 4.1 + my ($major, $minor) = $output[@output - 1] =~ /version ([0-9]+)\.([0-9]+)/; + if ($major >= 4 && $minor >= 1) { + $capabilities{fortify_source} = 1; + $cache{"fortify_source_$gcc_file"} = 1; + } else { + $capabilities{fortify_source} = 0; + $cache{"fortify_source_$gcc_file"} = 0; + } + } + + if (defined $lc_all) { + $ENV{LC_ALL} = $lc_all; + } else { + delete $ENV{LC_ALL}; + } + + $cache{version} = 2; + writeDataFile("$home/.apbuild", \%cache); + return %capabilities; +} + + +## +# $gcc->command() +# +# Returns the GCC command associated with this Apbuild::GCC object. +sub command { + my ($self) = @_; + return $self->{gcc}; +} + + +## +# $gcc->foreach(args, callback) +# args: a reference to an array which contains GCC parameters. +# callback: the callback function which will be called in every iteration of the loop. +# +# Iterate through each GCC parameter. $callback will be called as follows: +# $callback->(type, args...); +# $type is the current parameter's type, either "param" or "file" (source file). +# args is an array of parameters. If this parameter is a parameter which excepts +# another parameter (such as -o, it expects a filename), then the expected +# parameter will also be passed to the callback function. +sub foreach { + my ($self, $args, $callback) = @_; + for (my $i = 0; $i < @{$args}; $i++) { + $_ = $args->[$i]; + if (/^-/ || /\.($objectTypes|$headerTypes)$/ || /.*\.so\.?$/) { + # Parameter + if (/^-($extraTypes)$/) { + # This parameter expects another parameter + $callback->("param", $_, $args->[$i + 1]); + $i++; + } else { + $callback->("param", $_); + } + + } else { + # File + $callback->("file", $_); + } + } +} + +## +# $gcc->splitParams(args, files, params) +# args: a reference to an array which contains GCC parameters. +# files: a reference to an array, or undef. +# params: a reference to an array, or undef. +# +# Parse GCC's parameters. Seperate files and arguments. +# A list of files will be stored in the array referenced to by $file, +# a list of non-file parameters will be stored in the array referenced to by $params. +sub splitParams { + my ($self, $args, $files, $params) = @_; + + my $callback = sub { + my $type = shift; + if ($type eq "param") { + push @{$params}, @_ if ($params); + } elsif ($type eq "file") { + push @{$files}, $_[0] if ($files); + } + }; + $self->foreach($args, $callback); +} + + +sub stripLinkerParams { + my ($self, $r_params, $linking) = @_; + my @params; + my $i = 0; + + my $callback = sub { + my $type = shift; + if ($type eq 'param' && $_[0] =~ /^-($linkerTypes)/) { + push @{$linking}, @_; + } else { + push @params, @_; + } + }; + $self->foreach($r_params, $callback); + @{$r_params} = @params; +} + + +sub addSearchPaths { + my ($self, $dir) = @_; + push @{$self->{searchPaths}}, $dir; +} + +# Parse $args and extract library search paths from it. +# Those paths, along with paths added by addSearchPaths(), +# will be appended to $paths. +sub getSearchPaths { + my ($self, $args, $paths) = @_; + + my $callback = sub { + my $type = shift; + return if ($type ne "param"); + + if ($_[0] eq "-L") { + push @{$paths}, $_[1]; + + } elsif ($_[0] =~ /^-L(.+)/ || $_[0] =~ /^--library-path=(.+)/) { + push @{$paths}, $1; + } + }; + $self->foreach($args, $callback); + + push @{$paths}, @{$self->{searchPaths}}; +} + + +## +# $gcc->isLibrary(arg, libname) +# +# Check whether $arg is a (dynamic) library argument. +# The base library name will be stored in $$libname. +sub isLibrary { + my ($self, $arg, $libname) = @_; + if ($arg =~ /^-l(.+)/ || $arg =~ /^--library=(.+)/ || $arg =~ /^(?:.*\/)?lib([^\/]+)\.so/) { + $$libname = $1 if ($libname); + return 1; + } else { + return 0; + } +} + +## +# $gcc->isObject(arg) +# +# Check whether $arg is an object. This includes static libraries. +sub isObject { + my ($self, $arg) = @_; + return $arg !~ /^-/ && $arg =~ /\.($objectTypes)$/; +} + +sub isStaticLib { + my ($self, $arg) = @_; + return $arg !~ /^-/ && $arg =~ /\.($staticLibTypes)$/; +} + +## +# $gcc->isSource(file) +# +# Checks whether $file is a source file. +sub isSource { + my ($self, $file) = @_; + return $file =~ /\.($srcTypes)$/; +} + +## +# $gcc->isCxxSource(file) +# +# Checks whether $file is a C++ source file. +sub isCxxSource { + my ($self, $file) = @_; + return $file =~ /\.($cxxTypes)$/; +} + + +# I wish I know how to explain what these functions do, but I can't. :( +# If you know a better way to name these, please do tell me. +sub sourceOrderIsImportant { + my ($self, $arg) = @_; + return $arg =~ /^-(x)$/; +} + +sub linkOrderIsImportant { + my ($self, $arg) = @_; + return $arg =~ /^-(Wl,--whole-archive|Wl,--no-whole-archive)$/; +} + +## +# $gcc->getOutputFile(args) +# args: a reference to an array which contains GCC parameters. +# Returns: a filename. +# +# Parse the GCC arguments and detect the output filename. +sub getOutputFile { + my ($gcc, $args) = @_; + my ($output, $compilingToObject, $source); + + my $callback = sub { + my $type = shift; + if ($type eq 'param' && $_[0] eq '-o') { + $output = $_[1]; + + } elsif ($type eq 'param' && $_[0] eq '-c') { + $compilingToObject = 1; + + } elsif ($type eq 'file' && $gcc->isSource($_[0])) { + $source = $_[0]; + } + }; + $gcc->foreach($args, $callback); + + if (defined $output) { + return $output; + } elsif ($compilingToObject) { + $source =~ s/\.[^.]*?$/.o/; + return $source; + } else { + return "a.out"; + } +} + +## +# $gcc->setOutputFile(args, new_output_file) +# args: a reference to an array which contains GCC parameters. +# new_output_file: the new output filename. +# +# Parse the GCC arguments and change the output filename. +# The array referenced by $args will be modified. +sub setOutputFile { + my ($gcc, $args, $new_output_file) = @_; + my (@newArgs, $changed); + + my $callback = sub { + my $type = shift; + + if ($type eq 'param' && $_[0] eq '-o') { + push @newArgs, "-o", $new_output_file; + $changed = 1; + + } else { + push @newArgs, @_; + } + }; + $gcc->foreach($args, $callback); + + if (!$changed) { + push @newArgs, "-o", $new_output_file if (!$changed); + } + @{$args} = @newArgs; +} + + +## +# $gcc->situation(args) +# args: a reference to an array which contains GCC arguments. +# Returns: 'compile', 'depcheck', 'compile and link', 'linking' or 'other'. +# +# Detect the situation in which the compiler is used. +# Basically, there are 5 situations in which the compiler is used: +# 1) Compilation (to an object file). +# 2) Linking. +# 3) Compilation and linking. +# 4) Dependancy checking with -M* or -E. +# 5) None of the above. Compiler is invoked with --help or something. +# Note that source files may also contain non-C/C++ files. +sub situation { + my ($self, $args) = @_; + + my $files = 0; + for (@{$args}) { + $files++ if (!(/^-/)); + } + + for (@{$args}) { + if (/^-c$/) { + # Situation 1 + return 'compile'; + } elsif (/^-M(|M|G)$/ || /^-E$/) { + # Situation 4 + return 'depcheck'; + } + } + + if ($files == 1) + { + my $i = 0; + for (@{$args}) + { + if (!(/^-/) && (/\.($headerTypes)$/)) + { + print($args->[$i], "\n"); + return 'precompiled header'; + } + $i++; + } + } + + my $i = 0; + for (@{$args}) { + if (!(/^-/) && !(/\.($objectTypes)$/)) { + if ($i > 0 && $args->[$i - 1] =~ /^-($extraTypes)$/) { + $i++; + next; + } else { + # Situation 3 + return 'compile and link'; + } + } + $i++; + } + + if ($files == 0) { + # Situation 5 + return 'other'; + } else { + # Situation 2 + return 'linking'; + } +} + + +1; diff --git a/tools/apbuild/Apbuild/Utils.pm b/tools/apbuild/Apbuild/Utils.pm new file mode 100644 index 00000000..a5089299 --- /dev/null +++ b/tools/apbuild/Apbuild/Utils.pm @@ -0,0 +1,195 @@ +package Apbuild::Utils; + +use strict; +use warnings; +use Exporter; +use base qw(Exporter); +use IO::Handle; +use IPC::Open2; +use POSIX; +use Cwd qw(abs_path); + + +our @EXPORT = qw(debug error checkCommand empty homeDir searchLib searchStaticLib soname run parseDataFile writeDataFile); +our $debugOpened = 0; + + +## +# debug(message) +# +# If the environment variable $APBUILD_DEBUG is set to 1, +# then print a debugging message to /dev/tty (not stdout or stderr). +sub debug { + return if (empty($ENV{APBUILD_DEBUG}) || !$ENV{APBUILD_DEBUG}); + + if (!$debugOpened) { + if (open DEBUG, '>/dev/tty') { + $debugOpened = 1; + } else { + return; + } + } + + my @args = split /\n/, "@_"; + foreach (@args) { + $_ = '# ' . $_; + $_ .= "\n"; + } + + print DEBUG "\033[1;33m"; + print DEBUG join '', @args; + print DEBUG "\033[0m"; + DEBUG->flush; +} + + +## +# error(message) +# +# Print an error message to stderr. It will be displayed in red. +sub error { + print STDERR "\033[1;31m"; + print STDERR $_[0]; + print STDERR "\033[0m"; + STDERR->flush; +} + + +## +# checkCommand(file) +# file: an command's filename. +# Returns: the full path to $file, or undef if $file is not a valid command. +# +# Checks whether $file is an executable which is in $PATH or the working directory. +# +# Example: +# checkCommand('gcc'); # Returns "/usr/bin/gcc" +sub checkCommand { + my ($file, $file2) = split / /, $_[0]; + $file = $file2 if ($file =~ /ccache/); + + return abs_path($file) if (-x $file); + foreach my $dir (split /:+/, $ENV{PATH}) { + if (-x "$dir/$file") { + return "$dir/$file"; + } + } + return undef; +} + +## +# empty(str) +# +# Checks whether $str is undefined or empty. +sub empty { + return !defined($_[0]) || $_[0] eq ''; +} + +## +# homeDir() +# +# Returns the user's home folder. +sub homeDir { + if (!$ENV{HOME}) { + my $user = getpwuid(POSIX::getuid()); + $ENV{HOME} = (getpwnam($user))[7]; + } + return $ENV{HOME}; +} + +## +# searchLib(basename, [extra_paths]) +# basename: the base name of the library. +# extra_paths: a reference to an array, which contains extra folders in which to look for the library. +# Returns: the absolute path to the library, or undef if not found. +# +# Get the absolute path of a (static or shared) library. +# +# Example: +# searchLib("libfoo.so.1"); # Returns "/usr/lib/libfoo.so.1" +sub searchLib { + my ($basename, $extra_paths) = @_; + + if ($extra_paths) { + foreach my $path (reverse(@{$extra_paths})) { + return "$path/$basename" if (-f "$path/$basename"); + } + } + foreach my $path ('/usr/local/lib', '/lib', '/usr/lib') { + return "$path/$basename" if (-f "$path/$basename"); + } + return undef; +} + +## +# soname(lib) +# lib: a filename to a shared library. +# Returns: the soname. +# +# Get the soname of the specified shared library by reading +# the SONAME section of the shared library file. +sub soname { + my ($lib) = @_; + my ($r, $w); + + if (open2($r, $w, 'objdump', '-p', $lib)) { + close $w; + my @lines = <$r>; + close $r; + + my ($soname) = grep {/SONAME/} @lines; + $soname =~ s/.*?SONAME[ \t]+//; + $soname =~ s/\n//gs; + return $soname; + + } else { + my ($soname) = $lib =~ /.*\/lib(.+)\.so/; + return $soname; + } +} + +## +# run(args...) +# Returns: the command's exit code. +# +# Run a command with system(). +sub run { + # split the first item in @_ into "words". The `printf ...` + # takes care of respecting ' and " quotes so we don't split a + # quoted string that contains whitespace. If $cmd itself + # contains \n, this will still go wrong. + my $cmd = shift @_; + my @words = `printf '%s\n' $cmd`; + chomp @words; + my $status = system(@words, @_); + return 127 if ($status == -1); + return $status / 256 if ($status != 0); + return 0; +} + +sub parseDataFile { + my ($file, $r_hash) = @_; + + %{$r_hash} = (); + return if (!open FILE, "< $file"); + foreach (<FILE>) { + next if (/^#/); + s/[\r\n]//g; + next if (length($_) == 0); + + my ($key, $value) = split / /, $_, 2; + $r_hash->{$key} = $value; + } + close FILE; +} + +sub writeDataFile { + my ($file, $r_hash) = @_; + return if (!open FILE, "> $file"); + foreach my $key (sort(keys %{$r_hash})) { + print FILE "$key $r_hash->{$key}\n"; + } + close FILE; +} + +1; |