diff options
Diffstat (limited to 'tools/apbuild/Apbuild/GCC.pm')
| -rw-r--r-- | tools/apbuild/Apbuild/GCC.pm | 539 |
1 files changed, 539 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; |