aboutsummaryrefslogtreecommitdiffstats
path: root/cil/lib/Cilly.pm
diff options
context:
space:
mode:
Diffstat (limited to 'cil/lib/Cilly.pm')
-rw-r--r--cil/lib/Cilly.pm2137
1 files changed, 2137 insertions, 0 deletions
diff --git a/cil/lib/Cilly.pm b/cil/lib/Cilly.pm
new file mode 100644
index 00000000..fa7aa53b
--- /dev/null
+++ b/cil/lib/Cilly.pm
@@ -0,0 +1,2137 @@
+#
+#
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+
+
+
+# This module implements a compiler stub that parses the command line
+# arguments of gcc and Microsoft Visual C (along with some arguments for the
+# script itself) and gives hooks into preprocessing, compilation and linking.
+
+
+$::cilbin = 'bin';
+
+package Cilly;
+@ISA = ();
+
+use strict;
+use File::Basename;
+use File::Copy;
+use File::Spec;
+use Data::Dumper;
+use Carp;
+use Text::ParseWords;
+
+use KeptFile;
+use OutputFile;
+use TempFile;
+
+$Cilly::savedSourceExt = "_saved.c";
+
+# Pass to new a list of command arguments
+sub new {
+ my ($proto, @args) = @_;
+
+ my $class = ref($proto) || $proto;
+
+ my $ref =
+ { CFILES => [], # C input files
+ SFILES => [], # Assembly language files
+ OFILES => [], # Other input files
+ IFILES => [], # Already preprocessed files
+ EARLY_PPARGS => [], # Preprocessor args, first (pre-CIL) pass only
+ PPARGS => [], # Preprocessor args
+ CCARGS => [], # Compiler args
+ LINKARGS => [], # Linker args
+ NATIVECAML => 1, # this causes the native code boxer to be used
+ RELEASELIB => 0, # if true, use the release runtime library (if any)
+ # IDASHI => 1, # if true, pass "-I-" to gcc's preprocessor
+ IDASHDOT => 1, # if true, pass "-I." to gcc's preprocessor
+ VERBOSE => 0, # when true, print extra detail
+ TRACE_COMMANDS => 1, # when true, echo commands being run
+ SEPARATE => ! $::default_is_merge,
+ LIBDIR => [],
+ OPERATION => 'TOEXE', # This is the default for all compilers
+ };
+ my $self = bless $ref, $class;
+
+ if(! @args) {
+ print "No arguments passed\n";
+ $self->printHelp();
+ exit 0;
+ }
+ # Look for the --mode argument first. If not found it is GCC
+ my $mode = $::default_mode;
+ {
+ my @args1 = ();
+ foreach my $arg (@args) {
+ if($arg =~ m|--mode=(.+)$|) {
+ $mode = $1;
+ } else {
+ push @args1, $arg;
+ }
+ }
+ @args = @args1; # These are the argument after we extracted the --mode
+
+ }
+ if(defined $self->{MODENAME} && $self->{MODENAME} ne $mode) {
+ die "Cannot re-specify the compiler";
+ }
+ {
+ my $compiler;
+ if($mode eq "MSVC") {
+ unshift @Cilly::ISA, qw(MSVC);
+ $compiler = MSVC->new($self);
+ } elsif($mode eq "GNUCC") {
+ unshift @Cilly::ISA, qw(GNUCC);
+ $compiler = GNUCC->new($self);
+ } elsif($mode eq "MSLINK") {
+ unshift @Cilly::ISA, qw(MSLINK);
+ $compiler = MSLINK->new($self);
+ } elsif($mode eq "MSLIB") {
+ unshift @Cilly::ISA, qw(MSLIB);
+ $compiler = MSLIB->new($self);
+ } elsif($mode eq "AR") {
+ unshift @Cilly::ISA, qw(AR);
+ $compiler = AR->new($self);
+ } else {
+ die "Don't know about compiler $mode\n";
+ }
+ # Now grab the fields from the compiler and put them inside self
+ my $key;
+ foreach $key (keys %{$compiler}) {
+ $self->{$key} = $compiler->{$key};
+ }
+
+ # For MSVC we have to use --save-temps because otherwise the
+ # temporary files get deleted somehow before CL gets at them !
+ if($mode ne "GNUCC" && $mode ne "AR") {
+ $self->{SAVE_TEMPS} = '.';
+ }
+ }
+
+ # Scan and process the arguments
+ $self->setDefaultArguments;
+ collectArgumentList($self, @args);
+
+ # sm: if an environment variable is set, then do not merge; this
+ # is intended for use in ./configure scripts, where merging delays
+ # the reporting of errors that the script is expecting
+ if (defined($ENV{"CILLY_NOMERGE"})) {
+ $self->{SEPARATE} = 1;
+ if($self->{VERBOSE}) { print STDERR "Merging disabled by CILLY_NOMERGE\n"; }
+ }
+
+# print Dumper($self);
+
+ return $self;
+}
+
+# Hook to let subclasses set/override default arguments
+sub setDefaultArguments {
+}
+
+# work through an array of arguments, processing each one
+sub collectArgumentList {
+ my ($self, @args) = @_;
+
+ # Scan and process the arguments
+ while($#args >= 0) {
+ my $arg = $self->fetchNextArg(\@args);
+
+ if(! defined($arg)) {
+ last;
+ }
+ if($arg eq "") { next; }
+
+ #print("arg: $arg\n");
+#
+# my $arg = shift @args; # Grab the next one
+ if(! $self->collectOneArgument($arg, \@args)) {
+ print "Warning: Unknown argument $arg\n";
+ push @{$self->{CCARGS}}, $arg;
+ }
+ }
+}
+
+# Grab the next argument
+sub fetchNextArg {
+ my ($self, $pargs) = @_;
+ return shift @{$pargs};
+}
+
+# Collecting arguments. Take a look at one argument. If we understand it then
+# we return 1. Otherwise we return 0. Might pop some more arguments from pargs.
+sub collectOneArgument {
+ my($self, $arg, $pargs) = @_;
+ my $res;
+ # Maybe it is a compiler option or a source file
+ if($self->compilerArgument($self->{OPTIONS}, $arg, $pargs)) { return 1; }
+
+ if($arg eq "--help" || $arg eq "-help") {
+ $self->printVersion();
+ $self->printHelp();
+ exit 1;
+ }
+ if($arg eq "--version" || $arg eq "-version") {
+ $self->printVersion(); exit 0;
+ }
+ if($arg eq "--verbose") {
+ $self->{VERBOSE} = 1; return 1;
+ }
+ if($arg eq "--flatten_linker_scripts") {
+ $self->{FLATTEN_LINKER_SCRIPTS} = 1; return 1;
+ }
+ if($arg eq '--nomerge') {
+ $self->{SEPARATE} = 1;
+ return 1;
+ }
+ if($arg eq '--merge') {
+ $self->{SEPARATE} = 0;
+ return 1;
+ }
+ if($arg =~ "--ccargs=(.+)\$") {
+ push @{$self->{CCARGS}}, $1;
+ return 1;
+ }
+ if($arg eq '--trueobj') {
+ $self->{TRUEOBJ} = 1;
+ return 1;
+ }
+ # zf: force curing when linking to a lib
+ if ($arg eq '--truelib') {
+ $self->{TRUELIB} = 1;
+ return 1;
+ }
+ if($arg eq '--keepmerged') {
+ $self->{KEEPMERGED} = 1;
+ return 1;
+ }
+ if($arg eq '--stdoutpp') {
+ $self->{STDOUTPP} = 1;
+ return 1;
+ }
+ if($arg =~ m|--save-temps=(.+)$|) {
+ if(! -d $1) {
+ die "Cannot find directory $1";
+ }
+ $self->{SAVE_TEMPS} = $1;
+ return 1;
+ }
+ if($arg eq '--save-temps') {
+ $self->{SAVE_TEMPS} = '.';
+ return 1;
+ }
+ if($arg =~ m|--leavealone=(.+)$|) {
+ push @{$self->{LEAVEALONE}}, $1;
+ return 1;
+ }
+ if($arg =~ m|--includedir=(.+)$|) {
+ push @{$self->{INCLUDEDIR}}, $1; return 1;
+ }
+ if($arg =~ m|--stages|) {
+ $self->{SHOWSTAGES} = 1;
+ push @{$self->{CILARGS}}, $arg;
+ return 1;
+ }
+ if($arg eq "--bytecode") {
+ $self->{NATIVECAML} = 0; return 1;
+ }
+# if($arg eq "--no-idashi") {
+# $self->{IDASHI} = 0; return 1;
+# }
+ if($arg eq "--no-idashdot") {
+ $self->{IDASHDOT} = 0; return 1;
+ }
+
+ # sm: response file
+ if($arg =~ m|-@(.+)$| ||
+ (($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") && $arg =~ m|@(.+)$|)) {
+ my $fname = $1; # name of response file
+ &classifyArgDebug("processing response file: $fname\n");
+
+ # read the lines into an array
+ if (!open(RF, "<$fname")) {
+ die("cannot open response file $fname: $!\n");
+ }
+ my @respArgs = ();
+ while(<RF>) {
+ # Drop spaces and empty lines
+ my ($middle) = ($_ =~ m|\s*(\S.*\S)\s*|);
+ if($middle ne "") {
+ # Sometimes we have multiple arguments in one line :-()
+ if($middle =~ m|\s| &&
+ $middle !~ m|[\"]|) {
+ # Contains spaces and no quotes
+ my @middles = split(/\s+/, $middle);
+ push @respArgs, @middles;
+ } else {
+ push @respArgs, $middle;
+ }
+# print "Arg:$middle\n";
+ }
+ }
+ close(RF) or die;
+
+
+ # Scan and process the arguments
+ collectArgumentList($self, @respArgs);
+
+ #print("done with response file: $fname\n");
+ return 1; # argument undestood
+ }
+ if($arg eq "-@" || ($self->{MODENAME} eq "MSVC" && $arg eq "@")) {
+ # sm: I didn't implement the case where it takes the next argument
+ # because I wasn't sure how to grab add'l args (none of the
+ # cases above do..)
+ die("For ccured/cilly, please don't separate the -@ from the\n",
+ "response file name. e.g., use -@", "respfile.\n");
+ }
+
+ # Intercept the --out argument
+ if($arg =~ m|^--out=(\S+)$|) {
+ $self->{CILLY_OUT} = $1;
+ push @{$self->{CILARGS}}, "--out", $1;
+ return 1;
+ }
+ # All other arguments starting with -- are passed to CIL
+ if($arg =~ m|^--|) {
+ # Split the ==
+ if($arg =~ m|^(--\S+)=(.+)$|) {
+ push @{$self->{CILARGS}}, $1, $2; return 1;
+ } else {
+ push @{$self->{CILARGS}}, $arg; return 1;
+ }
+ }
+ return 0;
+}
+
+
+sub printVersion {
+ system ($CilCompiler::compiler, '--version');
+}
+
+sub printHelp {
+ my($self) = @_;
+ $self->usage();
+ print <<EOF;
+
+Options:
+ --mode=xxx What tool to emulate:
+ GNUCC - GNU gcc
+ AR - GNU ar
+ MSVC - MS VC cl compiler
+ MSLINK - MS VC link linker
+ MSLIB - MS VC lib linker
+ This option must be the first one! If it is not found there
+ then GNUCC mode is assumed.
+ --help (or -help) Prints this help message.
+ --verbose Prints a lot of information about what is being done.
+ --save-temps Keep temporary files in the current directory.
+ --save-temps=xxx Keep temporary files in the given directory.
+
+ --nomerge Apply CIL separately to each source file as they are compiled.
+ By default CIL is applied to the whole program during linking.
+ --merge Apply CIL to the merged program.
+ --keepmerged Save the merged file. Only useful if --nomerge is not given.
+ --trueobj Do not write preprocessed sources in .obj/.o files but
+ create some other files (e.g. foo.o_saved.c).
+ --truelib When linking to a library (with -r or -i), output real
+ object files instead of preprocessed sources. This only
+ works for GCC right now.
+ --leavealone=xxx Leave alone files whose base name is xxx. This means
+ they are not merged and not processed with CIL.
+ --includedir=xxx Adds a new include directory to replace existing ones
+ --bytecode Invoke the bytecode (as opposed to native code) system
+
+EOF
+# --no-idashi Do not use '-I-' with the gcc preprocessor.
+ $self->helpMessage();
+}
+
+# For printing the first line of the help message
+sub usage {
+ my ($self) = @_;
+ print "<No usage is defined>";
+}
+
+# The rest of the help message
+sub helpMessage {
+ my ($self) = @_;
+ print <<EOF;
+Send bugs to necula\@cs.berkeley.edu.
+EOF
+}
+
+
+#
+# Normalize a file name to always use slashes
+#
+sub normalizeFileName {
+ my($f) = @_;
+ $f =~ s|\\|/|g;
+ return $f;
+}
+
+#
+# The basic routines: for ech source file preprocess, compile, then link
+# everything
+#
+#
+
+
+# LINKING into a library (with COMPILATION and PREPROCESSING)
+sub straight_linktolib {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
+ my @dest = $dest eq "" ? () : ($self->{OUTLIB} . $dest);
+ # Pass the linkargs last because some libraries must be passed after
+ # the sources
+ my @cmd = (@{$self->{LDLIB}}, @dest, @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
+ return $self->runShell(@cmd);
+}
+
+# Customize the linking into libraries
+sub linktolib {
+ my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ if($self->{VERBOSE}) { print STDERR "Linking into library $dest\n"; }
+
+ # Now collect the files to be merged
+ my ($tomerge, $trueobjs, $ccargs) =
+ $self->separateTrueObjects($psrcs, $ccargs);
+
+ if($self->{SEPARATE} || @{$tomerge} == 0) {
+ # Not merging. Regular linking.
+
+ return $self->straight_linktolib($psrcs, $dest,
+ $ppargs, $ccargs, $ldargs);
+ }
+ # We are merging. Merge all the files into a single one
+
+ if(@{$trueobjs} > 0) {
+ # We have some true objects. Save them into an additional file
+ my $trueobjs_file = "$dest" . "_trueobjs";
+ if($self->{VERBOSE}) {
+ print STDERR
+ "Saving additional true object files in $trueobjs_file\n";
+ }
+ open(TRUEOBJS, ">$trueobjs_file") || die "Cannot write $trueobjs_file";
+ foreach my $true (@{$trueobjs}) {
+ my $abs = File::Spec->rel2abs($true);
+ print TRUEOBJS "$abs\n";
+ }
+ close(TRUEOBJS);
+ }
+ if(@{$tomerge} == 1) { # Just copy the file over
+ (!system('cp', '-f', ${$tomerge}[0], $dest))
+ || die "Cannot copy ${$tomerge}[0] to $dest\n";
+ return ;
+ }
+ #
+ # We must do real merging
+ #
+ # Prepare the name of the CIL output file based on dest
+ my ($base, $dir, $ext) = fileparse($dest, "(\\.[^.]+)");
+
+ # Now prepare the command line for invoking cilly
+ my ($aftercil, @cmd) = $self->MergeCommand ($psrcs, $dir, $base);
+ die unless $cmd[0];
+
+ if($self->{MODENAME} eq "MSVC") {
+ push @cmd, "--MSVC";
+ }
+ if($self->{VERBOSE}) {
+ push @cmd, "--verbose";
+ }
+ if(defined $self->{CILARGS}) {
+ push @cmd, @{$self->{CILARGS}};
+ }
+ # Eliminate duplicates
+
+ # Add the arguments
+ if(@{$tomerge} > 20) {
+ my $extraFile = "___extra_files";
+ open(TOMERGE, ">$extraFile") || die $!;
+ #FRANJO added the following on February 15th, 2005
+ #REASON: extrafiles was TempFIle=HASH(0x12345678)
+ # instead of actual filename
+ my @normalized = @{$tomerge} ;
+ $_ = (ref $_ ? $_->filename : $_) foreach @normalized;
+ foreach my $fl (@normalized) {
+ print TOMERGE "$fl\n";
+ }
+ close(TOMERGE);
+ push @cmd, '--extrafiles', $extraFile;
+ } else {
+ push @cmd, @{$tomerge};
+ }
+ push @cmd, "--mergedout", $dest;
+ # Now run cilly
+ return $self->runShell(@cmd);
+}
+
+############
+############ PREPROCESSING
+############
+#
+# All flavors of preprocessing return the destination file
+#
+
+# THIS IS THE ENTRY POINT FOR COMPILING SOURCE FILES
+sub preprocess_compile {
+ my ($self, $src, $dest, $early_ppargs, $ppargs, $ccargs) = @_;
+ &mydebug("preprocess_compile(src=$src, dest=$dest)\n");
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+
+ my ($base, $dir, $ext) = fileparse($src, "\\.[^.]+");
+ if($ext eq ".c" || $ext eq ".cpp" || $ext eq ".cc") {
+ if($self->leaveAlone($src)) {
+ print "Leaving alone $src\n";
+ # We leave this alone. So just compile as usual
+ return $self->straight_compile($src, $dest, $early_ppargs, $ppargs, $ccargs);
+ }
+ my $out = $self->preprocessOutputFile($src);
+ $out = $self->preprocess($src, $out,
+ [@{$early_ppargs}, @{$ppargs},
+ "$self->{DEFARG}CIL=1"]);
+ return $self->compile($out, $dest, $ppargs, $ccargs);
+ }
+ if($ext eq ".i") {
+ return $self->compile($src, $dest, $ppargs, $ccargs);
+ }
+ if($ext eq ".$::cilbin") {
+ return $self->compile($src, $dest, $ppargs, $ccargs);
+ }
+}
+
+# THIS IS THE ENTRY POINT FOR JUST PREPROCESSING A FILE
+sub preprocess {
+ my($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ return $self->preprocess_before_cil($src, $dest, $ppargs);
+}
+
+# Find the name of the preprocessed file before CIL processing
+sub preprocessOutputFile {
+ my($self, $src) = @_;
+ return $self->outputFile($src, 'i');
+}
+
+# Find the name of the preprocessed file after CIL processing
+sub preprocessAfterOutputFile {
+ my($self, $src) = @_;
+ return $self->outputFile($src, 'cil.i');
+}
+
+# When we use CIL we have two separate preprocessing stages. First is the
+# preprocessing before the CIL sees the code and the is the preprocessing
+# after CIL sees the code
+
+sub preprocess_before_cil {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ my @args = @{$ppargs};
+
+ # See if we must force some includes
+ if(defined $self->{INCLUDEDIR} && !defined($ENV{"CILLY_NOCURE"})) {
+ # And force the other includes. Put them at the begining
+ if(($self->{MODENAME} eq 'GNUCC') &&
+ # sm: m88k doesn't work if I pass -I.
+ $self->{IDASHDOT}) {
+ unshift @args, "-I.";
+ }
+ if(! defined($self->{VERSION})) {
+ $self->setVersion();
+ }
+ unshift @args,
+ map { my $dir = $_;
+ $self->{INCARG} . $dir . "/" . $self->{VERSION} }
+ @{$self->{INCLUDEDIR}};
+ #matth: include the main include dir as well as the compiler-specific directory
+ unshift @args,
+ map { my $dir = $_;
+ $self->{INCARG} . $dir }
+ @{$self->{INCLUDEDIR}};
+ if($self->{MODENAME} eq 'GNUCC') {
+ # sm: this is incompatible with wu-ftpd, but is apparently needed
+ # for apache.. more investigation is needed
+ # update: now when I try it, apache works without -I- also.. but
+ # I'll make this into a switchable flag anyway
+ # matth: this breaks other tests. Let's try without.
+# if ($self->{IDASHI}) {
+# unshift @args, "-I-";
+# }
+ }
+ }
+
+ return $self->straight_preprocess($src, $dest, \@args);
+}
+
+# Preprocessing after CIL
+sub preprocess_after_cil {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ return $self->straight_preprocess($src, $dest, $ppargs);
+}
+
+#
+# This is intended to be the true invocation of the underlying preprocessor
+# You should not override this method
+sub straight_preprocess {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ if($self->{VERBOSE}) {
+ my $srcname = ref $src ? $src->filename : $src;
+ print STDERR "Preprocessing $srcname\n";
+ }
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ $self->MSVC::msvc_preprocess($src, $dest, $ppargs);
+ } else {
+# print Dumper($self);
+ my @cmd = (@{$self->{CPP}}, @{$ppargs},
+ $src, $self->makeOutArguments($self->{OUTCPP}, $dest));
+ $self->runShell(@cmd);
+
+ }
+ return $dest;
+}
+
+
+#
+#
+#
+# COMPILATION
+#
+#
+
+sub compile {
+ my($self, $src, $dest, $ppargs, $ccargs) = @_;
+ &mydebug("Cilly.compile(src=$src, dest=$dest->{filename})\n");
+ Carp::confess "bad dest: $dest->{filename}"
+ unless $dest->isa('OutputFile');
+
+ if($self->{SEPARATE}) {
+ # Now invoke CIL and compile afterwards
+ return $self->applyCilAndCompile([$src], $dest, $ppargs, $ccargs);
+ }
+ # We are merging
+ # If we are merging then we just save the preprocessed source
+ my ($mtime, $res, $outfile);
+ if(! $self->{TRUEOBJ}) {
+ $outfile = $dest->{filename}; $mtime = 0; $res = $dest;
+ } else {
+ # Do the real compilation
+ $res = $self->straight_compile($src, $dest, $ppargs, $ccargs);
+ # Now stat the result
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($dest->{filename});
+ if(! defined($mtime_1)) {
+ die "Cannot stat the result of compilation $dest->{filename}";
+ }
+ $mtime = $mtime_1;
+ $outfile = $dest->{filename} . $Cilly::savedSourceExt;
+ }
+ my $srcname = ref $src ? $src->filename : $src;
+ if($self->{VERBOSE}) {
+ print STDERR "Saving source $srcname into $outfile\n";
+ }
+ open(OUT, ">$outfile") || die "Cannot create $outfile";
+ my $toprintsrc = $srcname;
+ $toprintsrc =~ s|\\|/|g;
+ print OUT "#pragma merger($mtime,\"$toprintsrc\",\"" .
+ join(',', @{$ccargs}), "\")\n";
+ open(IN, '<', $srcname) || die "Cannot read $srcname";
+ while(<IN>) {
+ print OUT $_;
+ }
+ close(OUT);
+ close(IN);
+ return $res;
+}
+
+sub makeOutArguments {
+ my ($self, $which, $dest) = @_;
+ $dest = $dest->{filename} if ref $dest;
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ # A single argument
+ return ("$which$dest");
+ } else {
+ return ($which, $dest);
+ }
+}
+# This is the actual invocation of the underlying compiler. You should not
+# override this
+sub straight_compile {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ if($self->{VERBOSE}) {
+ print STDERR 'Compiling ', ref $src ? $src->filename : $src, ' into ',
+ $dest->filename, "\n";
+ }
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
+ my @forcec = @{$self->{FORCECSOURCE}};
+ my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
+ @dest, @forcec, $src);
+ return $self->runShell(@cmd);
+}
+
+# This is compilation after CIL
+sub compile_cil {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ return $self->straight_compile($src, $dest, $ppargs, $ccargs);
+}
+
+
+
+# THIS IS THE ENTRY POINT FOR JUST ASSEMBLING FILES
+sub assemble {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ if($self->{VERBOSE}) { print STDERR "Assembling $src\n"; }
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
+ my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
+ @dest, $src);
+ return $self->runShell(@cmd);
+}
+
+
+
+#
+# This is intended to be the true invocation of the underlying linker
+# You should not override this method
+sub straight_link {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTEXE}, $dest);
+ # Pass the linkargs last because some libraries must be passed after
+ # the sources
+ my @cmd = (@{$self->{LD}}, @dest,
+ @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
+ return $self->runShell(@cmd);
+}
+
+#
+# See if some libraries are actually lists of files
+sub expandLibraries {
+ my ($self) = @_;
+
+ my @tolink = @{$self->{OFILES}};
+
+ # Go through the sources and replace all libraries with the files that
+ # they contain
+ my @tolink1 = ();
+ while($#tolink >= 0) {
+ my $src = shift @tolink;
+# print "Looking at $src\n";
+ # See if the source is a library. Then maybe we should get instead the
+ # list of files
+ if($src =~ m|\.$self->{LIBEXT}$| && -f "$src.files") {
+ open(FILES, "<$src.files") || die "Cannot read $src.files";
+ while(<FILES>) {
+ # Put them back in the "tolink" to process them recursively
+ while($_ =~ m|[\r\n]$|) {
+ chop;
+ }
+ unshift @tolink, $_;
+ }
+ close(FILES);
+ next;
+ }
+ # This is not for us
+ push @tolink1, $src;
+ next;
+ }
+ $self->{OFILES} = \@tolink1;
+}
+
+# Go over a list of object files and separate them into those that are
+# actually sources to be merged, and the true object files
+#
+sub separateTrueObjects {
+ my ($self, $psrcs, $ccargs) = @_;
+
+ my @sources = @{$psrcs};
+# print "Sources are @sources\n";
+ my @tomerge = ();
+ my @othersources = ();
+
+ my @ccmerged = @{$ccargs};
+ foreach my $src (@sources) {
+ my ($combsrc, $combsrcname, $mtime);
+ my $srcname = ref $src ? $src->filename : $src;
+ if(! $self->{TRUEOBJ}) {
+ # We are using the object file itself to save the sources
+ $combsrcname = $srcname;
+ $combsrc = $src;
+ $mtime = 0;
+ } else {
+ $combsrcname = $srcname . $Cilly::savedSourceExt;
+ $combsrc = $combsrcname;
+ if(-f $combsrcname) {
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($srcname);
+ $mtime = $mtime_1;
+ } else {
+ $mtime = 0;
+ }
+ }
+ # Look inside and see if it is one of the files created by us
+ open(IN, "<$combsrcname") || die "Cannot read $combsrcname";
+ my $fstline = <IN>;
+ close(IN);
+ if($fstline =~ m|CIL|) {
+ goto ToMerge;
+ }
+ if($fstline =~ m|^\#pragma merger\((\d+),\".*\",\"(.*)\"\)$|) {
+ my $mymtime = $1;
+ # Get the CC flags
+ my @thisccargs = split(/,/, $2);
+ foreach my $arg (@thisccargs) {
+ # print "Looking at $arg\n ccmerged=@ccmerged\n";
+ if(! grep(/$arg/, @ccmerged)) {
+ # print " adding it\n";
+ push @ccmerged, $arg
+ }
+ }
+ ToMerge:
+ if($mymtime == $mtime) { # It is ours
+ # See if we have this already
+ if(! grep { $_ eq $srcname } @tomerge) { # It is ours
+ push @tomerge, $combsrc;
+ # See if there is a a trueobjs file also
+ my $trueobjs = $combsrcname . "_trueobjs";
+ if(-f $trueobjs) {
+ open(TRUEOBJS, "<$trueobjs")
+ || die "Cannot read $trueobjs";
+ while(<TRUEOBJS>) {
+ chop;
+ push @othersources, $_;
+ }
+ close(TRUEOBJS);
+ }
+ }
+ next;
+ }
+ }
+ push @othersources, $combsrc;
+ }
+ # If we are merging, turn off "warnings are errors" flag
+ if(grep(/$self->{WARNISERROR}/, @ccmerged)) {
+ @ccmerged = grep(!/$self->{WARNISERROR}/, @ccmerged);
+ print STDERR "Turning off warn-is-error flag $self->{WARNISERROR}\n";
+ }
+
+ return (\@tomerge, \@othersources, \@ccmerged);
+}
+
+
+# Customize the linking
+sub link {
+ my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my $destname = ref $dest ? $dest->filename : $dest;
+ if($self->{SEPARATE}) {
+ if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
+ if($self->{VERBOSE}) { print STDERR "Linking into $destname\n"; }
+ # Not merging. Regular linking.
+ return $self->link_after_cil($psrcs, $dest,
+ $ppargs, $ccargs, $ldargs);
+ }
+ else {
+ return 0; # sm: is this value used??
+ }
+ }
+ my $mergedobj = new OutputFile($destname,
+ "${destname}_comb.$self->{OBJEXT}");
+
+ # We must merge
+ if($self->{VERBOSE}) {
+ print STDERR "Merging saved sources into $mergedobj->{filename} (in process of linking $destname)\n";
+ }
+
+ # Now collect the files to be merged
+
+ my ($tomerge, $trueobjs, $ccargs) =
+ $self->separateTrueObjects($psrcs, $ccargs);
+
+ if($self->{VERBOSE}) {
+ print STDERR "Will merge the following: ",
+ join(' ', @{$tomerge}), "\n";
+ print STDERR "Will just link the genuine object files: ",
+ join(' ', @{$trueobjs}), "\n";
+ print STDERR "After merge compile flags: @{$ccargs}\n";
+ }
+ # Check the modification times and see if we can just use the combined
+ # file instead of merging all over again
+ if(@{$tomerge} > 1 && $self->{KEEPMERGED}) {
+ my $canReuse = 1;
+ my $combFile = new OutputFile($destname,
+ "${destname}_comb.c");
+ my @tmp = stat($combFile);
+ my $combFileMtime = $tmp[9] || 0;
+ foreach my $mrg (@{$tomerge}) {
+ my @tmp = stat($mrg); my $mtime = $tmp[9];
+ if($mtime >= $combFileMtime) { goto DoMerge; }
+ }
+ if($self->{VERBOSE}) {
+ print STDERR "Reusing merged file $combFile\n";
+ }
+ $self->applyCilAndCompile([$combFile], $mergedobj, $ppargs, $ccargs);
+ } else {
+ DoMerge:
+ $self->applyCilAndCompile($tomerge, $mergedobj, $ppargs, $ccargs);
+ }
+
+ # Put the merged OBJ at the beginning because maybe some of the trueobjs
+ # are libraries which like to be at the end
+ unshift @{$trueobjs}, $mergedobj;
+
+ # And finally link
+ # zf: hack for linking linux stuff
+ if ($self->{TRUELIB}) {
+ my @cmd = (@{$self->{LDLIB}}, ($dest),
+ @{$ppargs}, @{$ccargs}, @{$trueobjs}, @{$ldargs});
+ return $self->runShell(@cmd);
+ }
+
+ # sm: hack: made this conditional for dsw
+ if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
+ $self->link_after_cil($trueobjs, $dest, $ppargs, $ccargs, $ldargs);
+ }
+
+}
+
+sub applyCil {
+ my ($self, $ppsrc, $dest) = @_;
+
+ # The input files
+ my @srcs = @{$ppsrc};
+
+ # Now prepare the command line for invoking cilly
+ my ($aftercil, @cmd) = $self->CillyCommand ($ppsrc, $dest);
+ Carp::confess "$self produced bad output file: $aftercil"
+ unless $aftercil->isa('OutputFile');
+
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ push @cmd, '--MSVC';
+ }
+ if($self->{VERBOSE}) {
+ push @cmd, '--verbose';
+ }
+ if(defined $self->{CILARGS}) {
+ push @cmd, @{$self->{CILARGS}};
+ }
+
+ # Add the arguments
+ if(@srcs > 20) {
+ my $extraFile = "___extra_files";
+ open(TOMERGE, ">$extraFile") || die $!;
+ foreach my $fl (@srcs) {
+ my $fname = ref $fl ? $fl->filename : $fl;
+ print TOMERGE "$fname\n";
+ }
+ close(TOMERGE);
+ push @cmd, '--extrafiles', $extraFile;
+ } else {
+ push @cmd, @srcs;
+ }
+ if(@srcs > 1 && $self->{KEEPMERGED}) {
+ my ($base, $dir, undef) = fileparse($dest->filename, qr{\.[^.]+});
+ push @cmd, '--mergedout', "$dir$base" . '.c';
+ }
+ # Now run cilly
+ $self->runShell(@cmd);
+
+ # Tell the caller where we put the output
+ return $aftercil;
+}
+
+
+sub applyCilAndCompile {
+ my ($self, $ppsrc, $dest, $ppargs, $ccargs) = @_;
+ Carp::confess "$self produced bad destination file: $dest"
+ unless $dest->isa('OutputFile');
+
+ # The input files
+ my @srcs = @{$ppsrc};
+ &mydebug("Cilly.PM.applyCilAndCompile(srcs=[",join(',',@{$ppsrc}),"])\n");
+
+ # Now run cilly
+ my $aftercil = $self->applyCil($ppsrc, $dest);
+ Carp::confess "$self produced bad output file: $aftercil"
+ unless $aftercil->isa('OutputFile');
+
+ # Now preprocess
+ my $aftercilpp = $self->preprocessAfterOutputFile($aftercil);
+ $self->preprocess_after_cil($aftercil, $aftercilpp, $ppargs);
+
+ if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
+ # Now compile
+ return $self->compile_cil($aftercilpp, $dest, $ppargs, $ccargs);
+ }
+}
+
+# Linking after CIL
+sub link_after_cil {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
+ return $self->straight_link($psrcs, $dest, $ppargs, $ccargs, $ldargs);
+ }
+}
+
+# See if we must merge this one
+sub leaveAlone {
+ my($self, $filename) = @_;
+ my ($base, $dir, $ext) = fileparse($filename, "(\\.[^.]+)");
+ if(grep { $_ eq $base } @{$self->{LEAVEALONE}}) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+
+# DO EVERYTHING
+sub doit {
+ my ($self) = @_;
+ my $file;
+ my $out;
+
+# print Dumper($self);
+
+ # Maybe we must preprocess only
+ if($self->{OPERATION} eq "TOI" || $self->{OPERATION} eq 'SPECIAL') {
+ # Then we do not do anything
+ my @cmd = (@{$self->{CPP}},
+ @{$self->{EARLY_PPARGS}},
+ @{$self->{PPARGS}}, @{$self->{CCARGS}},
+ @{$self->{CFILES}}, @{$self->{SFILES}});
+ push @cmd, @{$self->{OUTARG}} if defined $self->{OUTARG};
+
+ return $self->runShell(@cmd);
+ }
+ # We expand some libraries names. Maybe they just contain some
+ # new object files
+ $self->expandLibraries();
+
+ # Try to guess whether to run in the separate mode. In that case
+ # we can go ahead with the compilation, without having to save
+ # files
+ if(! $self->{SEPARATE} && # Not already separate mode
+ $self->{OPERATION} eq "TOEXE" && # We are linking to an executable
+ @{$self->{CFILES}} + @{$self->{IFILES}} <= 1) { # At most one source
+ # If we have object files, we should keep merging if at least one
+ # object file is a disguised source
+ my $turnOffMerging = 0;
+ if(@{$self->{OFILES}}) {
+ my ($tomerge, $trueobjs, $mergedccargs) =
+ $self->separateTrueObjects($self->{OFILES}, $self->{CCARGS});
+ $self->{CCARGS} = $mergedccargs;
+ $turnOffMerging = (@{$tomerge} == 0);
+ } else {
+ $turnOffMerging = 1;
+ }
+ if($turnOffMerging) {
+ if($self->{VERBOSE}) {
+ print STDERR
+ "Turn off merging because the program contains one file\n";
+ }
+ $self->{SEPARATE} = 1;
+ }
+ }
+
+ # Turn everything into OBJ files
+ my @tolink = ();
+
+ foreach $file (@{$self->{IFILES}}, @{$self->{CFILES}}) {
+ $out = $self->compileOutputFile($file);
+ $self->preprocess_compile($file, $out,
+ $self->{EARLY_PPARGS},
+ $self->{PPARGS}, $self->{CCARGS});
+ push @tolink, $out;
+ }
+ # Now do the assembly language file
+ foreach $file (@{$self->{SFILES}}) {
+ $out = $self->assembleOutputFile($file);
+ $self->assemble($file, $out, $self->{PPARGS}, $self->{CCARGS});
+ push @tolink, $out;
+ }
+ # Now add the original object files. Put them last because libraries like
+ # to be last.
+ push @tolink, @{$self->{OFILES}};
+
+ # See if we must stop after compilation
+ if($self->{OPERATION} eq "TOOBJ") {
+ return;
+ }
+
+ # See if we must create a library only
+ if($self->{OPERATION} eq "TOLIB") {
+ if (!$self->{TRUELIB}) {
+ # zf: Creating a library containing merged source
+ $out = $self->linkOutputFile(@tolink);
+ $self->linktolib(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS},
+ $self->{LINKARGS});
+ return;
+ } else {
+ # zf: Linking to a true library. Do real curing.
+ # Only difference from TOEXE is that we use "partial linking" of the
+ # underlying linker
+ if ($self->{VERBOSE}) {
+ print STDERR "Linking to a true library!";
+ }
+ push @{$self->{CCARGS}}, "-r";
+ $out = $self->linkOutputFile(@tolink);
+ $self->link(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
+ return;
+ }
+
+ }
+
+ # Now link all of the files into an executable
+ if($self->{OPERATION} eq "TOEXE") {
+ $out = $self->linkOutputFile(@tolink);
+ $self->link(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
+ return;
+ }
+
+ die "I don't understand OPERATION:$self->{OPERATION}\n";
+}
+
+sub classifyArgDebug {
+ if(0) { print @_; }
+}
+
+sub mydebug {
+ if(0) { print @_; }
+}
+
+sub compilerArgument {
+ my($self, $options, $arg, $pargs) = @_;
+ &classifyArgDebug("Classifying arg: $arg\n");
+ my $idx = 0;
+ for($idx=0; $idx < $#$options; $idx += 2) {
+ my $key = ${$options}[$idx];
+ my $action = ${$options}[$idx + 1];
+ &classifyArgDebug("Try match with $key\n");
+ if($arg =~ m|^$key|) {
+ &classifyArgDebug(" match with $key\n");
+ my @fullarg = ($arg);
+ my $onemore;
+ if(defined $action->{'ONEMORE'}) {
+ &classifyArgDebug(" expecting one more\n");
+ # Maybe the next arg is attached
+ my $realarg;
+ ($realarg, $onemore) = ($arg =~ m|^($key)(.+)$|);
+ if(! defined $onemore) {
+ # Grab the next argument
+ $onemore = $self->fetchNextArg($pargs);
+ $onemore = &quoteIfNecessary($onemore);
+ push @fullarg, $onemore;
+ } else {
+ $onemore = &quoteIfNecessary($onemore);
+ }
+ &classifyArgDebug(" onemore=$onemore\n");
+ }
+ # Now see what action we must perform
+ my $argument_done = 1;
+ if(defined $action->{'RUN'}) {
+ &{$action->{'RUN'}}($self, @fullarg, $onemore, $pargs);
+ $argument_done = 1;
+ }
+ # Quote special SHELL caracters
+ @fullarg = map { $_ =~ s%([<>;&|])%'$1'%g; $_ } @fullarg;
+ # print "fullarg = ", @fullarg, "\n";
+ if(defined $action->{'TYPE'}) {
+ &classifyArgDebug(" type=$action->{TYPE}\n");
+ if($action->{TYPE} eq 'EARLY_PREPROC') {
+ push @{$self->{EARLY_PPARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "PREPROC") {
+ push @{$self->{PPARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq 'SPECIAL') {
+ push @{$self->{PPARGS}}, @fullarg;
+ $self->{OPERATION} = 'SPECIAL';
+ return 1;
+ }
+ elsif($action->{TYPE} eq "CC") {
+ push @{$self->{CCARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "LINKCC") {
+ push @{$self->{CCARGS}}, @fullarg;
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ALLARGS") {
+ push @{$self->{PPARGS}}, @fullarg;
+ push @{$self->{CCARGS}}, @fullarg;
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "LINK") {
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "CSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{CFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ASMSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{SFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "OSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{OFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ISOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{IFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq 'OUT') {
+ if(defined($self->{OUTARG})) {
+ print "Warning: output file is multiply defined: @{$self->{OUTARG}} and @fullarg\n";
+ }
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ $self->{OUTARG} = [@fullarg]; return 1;
+ }
+ print " Do not understand TYPE\n"; return 1;
+ }
+ if($argument_done) { return 1; }
+ print "Don't know what to do with option $arg\n";
+ return 0;
+ }
+ }
+ return 0;
+}
+
+
+sub runShell {
+ my ($self, @cmd) = @_;
+
+ my $msvcFriends =
+ ($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB");
+
+ foreach (@cmd) {
+ $_ = $_->filename if ref;
+ # If we are in MSVC mode then we might have to convert the files
+ # from cygwin names to the actual Windows names
+ if($msvcFriends && $^O eq "cygwin") {
+ my $arg = $_;
+ if ($arg =~ m|^/| && -f $arg) {
+ my $mname = `cygpath -m $arg`;
+ chop $mname;
+ if($mname ne "") { $_ = $mname; }
+ }
+ }
+ }
+
+ # sm: I want this printed to stderr instead of stdout
+ # because the rest of 'make' output goes there and this
+ # way I can capture to a coherent file
+ # sm: removed conditional on verbose since there's already
+ # so much noise in the output, and this is the *one* piece
+ # of information I *always* end up digging around for..
+ if($self->{TRACE_COMMANDS}) { print STDERR "@cmd\n"; }
+
+ # weimer: let's have a sanity check
+ my $code = system { $cmd[0] } @cmd;
+ if ($code != 0) {
+ # sm: now that we always print, don't echo the command again,
+ # since that makes the output more confusing
+ #die "Possible error with @cmd!\n";
+ $code >>= 8; # extract exit code portion
+
+ exit $code;
+ }
+ return $code;
+}
+
+sub quoteIfNecessary {
+ my($arg) = @_;
+ # If it contains spaces or "" then it must be quoted
+ if($arg =~ m|\s| || $arg =~ m|\"|) {
+ return "\'$arg\'";
+ } else {
+ return $arg;
+ }
+}
+
+
+sub cilOutputFile {
+ Carp::croak 'bad argument count' unless @_ == 3;
+ my ($self, $basis, $suffix) = @_;
+
+ if (defined $self->{SAVE_TEMPS}) {
+ return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
+ } else {
+ return $self->outputFile($basis, $suffix);
+ }
+}
+
+
+sub outputFile {
+ Carp::confess 'bad argument count' unless @_ == 3;
+ my ($self, $basis, $suffix) = @_;
+
+ if (defined $self->{SAVE_TEMPS}) {
+ return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
+ } else {
+ return new TempFile($basis, $suffix);
+ }
+}
+
+
+###########################################################################
+####
+#### MS CL specific code
+####
+package MSVC;
+
+use strict;
+use File::Basename;
+use Data::Dumper;
+
+# For MSVC we remember which was the first source, because we use that to
+# determine the name of the output file
+sub setFirstSource {
+ my ($self, $src) = @_;
+
+ if(! defined ($self->{FIRST_SOURCE})) {
+ $self->{FIRST_SOURCE} = $src;
+ }
+}
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my $self =
+ { NAME => 'Microsoft cl compiler',
+ MODENAME => 'MSVC',
+ CC => ['cl', '/nologo', '/D_MSVC', '/c'],
+ CPP => ['cl', '/nologo', '/D_MSVC', '/P'],
+ LD => ['cl', '/nologo', '/D_MSVC'],
+ DEFARG => "/D",
+ INCARG => "/I",
+ DEBUGARG => ['/Zi', '/MLd', '/DEBUG'],
+ OPTIMARG => ['/Ox', '/G6'],
+ OBJEXT => "obj",
+ LIBEXT => "lib", # Library extension (without the .)
+ EXEEXT => ".exe", # Executable extension (with the .)
+ OUTOBJ => "/Fo",
+ OUTEXE => "/Fe",
+ WARNISERROR => "/WX",
+ FORCECSOURCE => ['/Tc'],
+ LINEPATTERN => "^#line\\s+(\\d+)\\s+\"(.+)\"",
+
+ OPTIONS =>
+# Describe the compiler options as a list of patterns and associated actions.
+# The patterns are matched in order against the _begining_ of the argument.
+#
+# If the action contains ONEMORE => 1 then the argument is expected to be
+# parameterized by a following word. The word can be attached immediately to
+# the end of the argument or in a separate word.
+#
+# If the action contains TYPE => "..." then the argument is put into
+# one of several lists, as follows: "PREPROC" in ppargs; "CC" in
+# ccargs; "LINK" in linkargs; "LINKCC" both in ccargs and linkargs;
+# "ALLARGS" in ppargs, ccargs, and linkargs; "CSOURCE" in cfiles;
+# "ASMSOURCE" in sfiles; "OSOURCE" in ofiles; "ISOURCE" in ifiles;
+# "OUT" in outarg. "SPECIAL" flags indicate that the compiler should
+# be run directly so that it can perform some special action other
+# than generating code (e.g. printing out version or configuration
+# information).
+#
+# If the TYPE is not defined but the RUN => sub { ... } is defined then the
+# given subroutine is invoked with the self, the argument and the (possibly
+# empty) additional word and a pointer to the list of remaining arguments
+#
+ ["^[^/\\-@].*\\.($::cilbin|c|cpp|cc)\$" =>
+ { TYPE => 'CSOURCE',
+ RUN => sub { &MSVC::setFirstSource(@_); } },
+ "[^/].*\\.(asm)\$" => { TYPE => 'ASMSOURCE' },
+ "[^/].*\\.i\$" => { TYPE => 'ISOURCE' },
+ "[^/\\-@]" => { TYPE => "OSOURCE" },
+ "[/\\-]O" => { TYPE => "CC" },
+ "[/\\-][DI]" => { TYPE => "PREPROC"},
+ "[/\\-]EH" => { TYPE => "CC" },
+ "[/\\-]G" => { TYPE => "CC" },
+ "[/\\-]F[aA]" => { TYPE => 'CC' },
+ "[/\\-]Fo" => { TYPE => 'OUT' },
+ "/Fe" => { TYPE => 'OUT',
+ RUN => sub { $stub->{OPERATION} = "TOEXE" }},
+ "[/\\-]F[dprR]" => { TYPE => "CC" },
+ "[/\\-]FI" => { TYPE => "PREPROC" },
+ "[/\\-][CXu]" => { TYPE => "PREPROC" },
+ "[/\\-]U" => { ONEMORE => 1, TYPE => "PREPROC" },
+ "[/\\-](E|EP|P)" => { RUN => sub { push @{$stub->{PPARGS}}, $_[1];
+ $stub->{OPERATION} = "PREPROC"; }},
+ "[/\\-]c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
+ "[/\\-](Q|Z|J|nologo|w|W|Zm)" => { TYPE => "CC" },
+ "[/\\-]Y(u|c|d|l|X)" => { TYPE => "CC" },
+ "[/\\-]T(C|P)" => { TYPE => "PREPROC" },
+ "[/\\-]Tc(.+)\$" =>
+ { RUN => sub {
+ my $arg = $_[1];
+ my ($fname) = ($arg =~ m|[/\\-]Tc(.+)$|);
+ $fname = &normalizeFileName($fname);
+ push @{$stub->{CFILES}}, $fname;
+ }},
+ "[/\\-]v(d|m)" => { TYPE => "CC" },
+ "[/\\-]F" => { TYPE => "CC" },
+ "[/\\-]M" => { TYPE => 'LINKCC' },
+ "/link" => { RUN => sub { push @{$stub->{LINKARGS}}, "/link",
+ @{$_[3]};
+ @{$_[3]} = (); } },
+ "-cbstring" => { TYPE => "CC" },
+ "/" => { RUN =>
+ sub { print "Unimplemented MSVC argument $_[1]\n";}},
+ ],
+ };
+ bless $self, $class;
+ return $self;
+}
+
+
+sub msvc_preprocess {
+ my($self, $src, $dest, $ppargs) = @_;
+ my $res;
+ my $srcname = ref $src ? $src->filename : $src;
+ my ($sbase, $sdir, $sext) =
+ fileparse($srcname,
+ "(\\.c)|(\\.cc)|(\\.cpp)|(\\.i)");
+ # If this is a .cpp file we still hope it is C. Pass the /Tc argument to
+ # cl to force this file to be interpreted as a C one
+ my @cmd = @{$ppargs};
+
+ if($sext eq ".cpp") {
+ push @cmd, "/Tc";
+ }
+ # MSVC cannot be told where to put the output. But we know that it
+ # puts it in the current directory
+ my $msvcout = "./$sbase.i";
+ if($self->{STDOUTPP}) {
+ @cmd = ('cmd', '/c', 'cl', '/nologo', '/E', ">$msvcout", '/D_MSVC',
+ @cmd);
+
+ } else {
+ @cmd = ('cl', '/nologo', '/P', '/D_MSVC', @cmd);
+ }
+ $res = $self->runShell(@cmd, $srcname);
+ # Check file equivalence by making sure that all elements of the stat
+ # structure are the same, except for the access time.
+ my @st1 = stat $msvcout; $st1[8] = 0;
+ my @st2 = stat $dest->{filename}; $st2[8] = 0;
+ # print Dumper(\@st1, \@st2);
+ if($msvcout ne $dest->{filename}) {
+ while($#st1 >= 0) {
+ if(shift @st1 != shift @st2) {
+# print "$msvcout is NOT the same as $afterpp\n";
+ if($self->{VERBOSE}) {
+ print STDERR "Copying $msvcout to $dest->{filename} (MSVC_preprocess)\n";
+ }
+ unlink $dest;
+ File::Copy::copy($msvcout, $dest->filename);
+ unlink $msvcout;
+ return $res;
+ }
+ }
+ }
+ return $res;
+}
+
+sub forceIncludeArg {
+ my($self, $what) = @_;
+ return "/FI$what";
+}
+
+
+ # MSVC does not understand the extension .i, so we tell it it is a C file
+sub fixupCsources {
+ my (@csources) = @_;
+ my @mod_csources = ();
+ my $src;
+ foreach $src (@csources) {
+ my ($sbase, $sdir, $sext) = fileparse($src,
+ "\\.[^.]+");
+ if($sext eq ".i") {
+ push @mod_csources, "/Tc";
+ }
+ push @mod_csources, $src;
+ }
+ return @mod_csources;
+}
+
+
+# Emit a line # directive
+sub lineDirective {
+ my ($self, $fileName, $lineno) = @_;
+ return "#line $lineno \"$fileName\"\n";
+}
+
+# The name of the output file
+sub compileOutputFile {
+ my($self, $src) = @_;
+
+ die "compileOutputFile: not a C source file: $src\n"
+ unless $src =~ /\.($::cilbin|c|cc|cpp|i|asm)$/;
+
+ Carp::carp ("compileOutputFile: $self->{OPERATION}, $src",
+ Dumper($self->{OUTARG})) if 0;
+ if ($self->{OPERATION} eq 'TOOBJ') {
+ if(defined $self->{OUTARG}
+ && "@{$self->{OUTARG}}" =~ m|[/\\-]Fo(.+)|) {
+ my $dest = $1;
+ # Perhaps $dest is a directory
+ if(-d $dest) {
+ return new KeptFile($src, $self->{OBJEXT}, $dest);
+ } else {
+ return new OutputFile($src, $1);
+ }
+ } else {
+ return new KeptFile($src, $self->{OBJEXT}, '.');
+ }
+ } else {
+# die "compileOutputfile: operation is not TOOBJ";
+ return $self->outputFile($src, $self->{OBJEXT});
+ }
+}
+
+sub assembleOutputFile {
+ my($self, $src) = @_;
+ return $self->compileOutputFile($src);
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ $src = $src->filename if ref $src;
+ if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|/Fe(.+)|) {
+ return $1;
+ }
+ # Use the name of the first source file, in the current directory
+ my ($base, $dir, $ext) = fileparse ($src, "\\.[^.]+");
+ return "./$base.exe";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "cl 2>&1|") || die "Cannot start Microsoft CL\n";
+ while(<VER>) {
+ if($_ =~ m|Compiler Version (\S+) |) {
+ $cversion = "cl_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft CL version\n";
+}
+
+########################################################################
+##
+## MS LINK specific code
+##
+###
+package MSLINK;
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+
+ # Create a MSVC compiler object
+ my $msvc = MSVC->new($stub);
+
+ # Create $self
+
+ my $self =
+ { NAME => 'Microsoft linker',
+ MODENAME => 'MSLINK',
+ CC => $msvc->{CC},
+ CPP => $msvc->{CPP},
+ LD => ['link'],
+ DEFARG => $msvc->{DEFARG},
+ INCARG => $msvc->{INCARG},
+ DEBUGARG => ['/DEBUG'],
+ OPTIMARG => [],
+ LDLIB => ['lib'],
+ OBJEXT => "obj",
+ LIBEXT => "lib", # Library extension (without the .)
+ EXEEXT => ".exe", # Executable extension (with the .)
+ OUTOBJ => $msvc->{OUTOBJ},
+ OUTEXE => "-out:", # Keep this form because build.exe looks for it
+ WARNISERROR => "/WX",
+ LINEPATTERN => "",
+ FORCECSOURCE => $msvc->{FORCECSOURCE},
+
+ MSVC => $msvc,
+
+ OPTIONS =>
+ ["[^/\\-@]" => { TYPE => 'OSOURCE' },
+ "[/\\-](OUT|out):" => { TYPE => 'OUT' },
+ "^((/)|(\\-[^\\-]))" => { TYPE => 'LINK' },
+ ],
+ };
+ bless $self, $class;
+ return $self;
+}
+
+
+sub forceIncludeArg { # Same as for CL
+ my($self, $what) = @_;
+ return "/FI$what";
+}
+
+
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+# print Dumper($self);
+ Carp::confess "Cannot compute the linker output file"
+ if ! defined $self->{OUTARG};
+
+ if("@{$self->{OUTARG}}" =~ m|.+:(.+)|) {
+ return $1;
+ }
+ die "I do not know what is the link output file\n";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "link 2>&1|") || die "Cannot start Microsoft LINK\n";
+ while(<VER>) {
+ if($_ =~ m|Linker Version (\S+)|) {
+ $cversion = "link_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft LINK version\n";
+}
+
+########################################################################
+##
+## MS LIB specific code
+##
+###
+package MSLIB;
+
+our @ISA = qw(MSLINK);
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+
+ # Create a MSVC linker object
+ my $self = MSLINK->new($stub);
+
+ $self->{NAME} = 'Microsoft librarian';
+ $self->{MODENAME} = 'MSLIB';
+ $self->{OPERATION} = "TOLIB";
+ $self->{LDLIB} = ['lib'];
+ bless $self, $class;
+ return $self;
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "lib 2>&1|") || die "Cannot start Microsoft LIB\n";
+ while(<VER>) {
+ if($_ =~ m|Library Manager Version (\S+)|) {
+ $cversion = "lib_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft LINK version\n";
+}
+
+########################################################################
+##
+## GNU ar specific code
+##
+###
+package AR;
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my $self =
+ { NAME => 'Archiver',
+ MODENAME => 'ar',
+ CC => ['no_compiler_in_ar_mode'],
+ CPP => ['no_compiler_in_ar_mode'],
+ LDLIB => ['ar', 'crv'],
+ DEFARG => "??DEFARG",
+ INCARG => '??INCARG',
+ DEBUGARG => ['??DEBUGARG'],
+ OPTIMARG => [],
+ OBJEXT => "o",
+ LIBEXT => "a", # Library extension (without the .)
+ EXEEXT => "", # Executable extension (with the .)
+ OUTOBJ => "??OUTOBJ",
+ OUTLIB => "", # But better be first
+ LINEPATTERN => "",
+
+ OPTIONS =>
+ ["^[^-]" => { RUN => \&arArguments } ]
+
+ };
+ bless $self, $class;
+ return $self;
+}
+
+# We handle arguments in a special way for AR
+sub arArguments {
+ my ($self, $arg, $onemore, $pargs) = @_;
+ # If the first argument starts with -- pass it on
+ if($arg =~ m|^--|) {
+ return 0;
+ }
+ # We got here for the first non -- argument.
+ # Will handle all arguments at once
+ if($self->{VERBOSE}) {
+ print "AR called with $arg @{$pargs}\n";
+ }
+
+ #The r flag is required:
+ if($arg !~ m|r| || $#{$pargs} < 0) {
+ die "Error: CCured's AR mode implements only the r and cr operations.";
+ }
+ if($arg =~ /[^crvus]/) {
+ die "Error: CCured's AR mode supports only the c, r, u, s, and v flags.";
+ }
+ if($arg =~ /v/) {
+ $self->{VERBOSE} = 1;
+ }
+
+ if($arg =~ /c/)
+ {
+ # Command is "cr":
+ # Get the name of the library
+ my $out = shift @{$pargs};
+ $self->{OUTARG} = [$out];
+ unlink $out;
+ }
+ else
+ {
+ # if the command is "r" alone, we should add to the current library,
+ # not replace it, unless the library does not exist
+
+ # Get the name of the library
+ my $out = shift @{$pargs};
+ $self->{OUTARG} = [$out];
+
+ #The library is both an input and an output.
+ #To avoid problems with reading and writing the same file, move the
+ #current version of the library out of the way first.
+ if(-f $out) {
+
+ my $temp_name = $out . "_old.a";
+ if($self->{VERBOSE}) {
+ print "Copying $out to $temp_name so we can add "
+ . "to it.\n";
+ }
+ if(-f $temp_name) {
+ unlink $temp_name;
+ }
+ rename $out, $temp_name;
+
+ #now use $temp_name as the input. $self->{OUTARG} will,
+ # as usual, be the output.
+ push @{$self->{OFILES}}, $temp_name;
+ } else {
+ warn "Library $out not found; creating.";
+ }
+
+ }
+
+ # The rest of the arguments must be object files
+ push @{$self->{OFILES}}, @{$pargs};
+ $self->{OPERATION} = 'TOLIB';
+ @{$pargs} = ();
+# print Dumper($self);
+ return 1;
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ if(defined $self->{OUTARG}) {
+ return "@{$self->{OUTARG}}";
+ }
+ die "I do not know what is the link output file\n";
+}
+
+sub setVersion {
+ # sm: bin/cilly wants this for all "compilers"
+}
+
+
+#########################################################################
+##
+## GNUCC specific code
+##
+package GNUCC;
+
+use strict;
+
+use File::Basename;
+
+# The variable $::cc is inherited from the main script!!
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my @native_cc = Text::ParseWords::shellwords($ENV{CILLY_NATIVE_CC} || $::cc);
+
+ my $self =
+ { NAME => 'GNU CC',
+ MODENAME => 'GNUCC', # do not change this since it is used in code
+ # sm: added -O since it's needed for inlines to be merged instead of causing link errors
+ # sm: removed -O to ease debugging; will address "inline extern" elsewhere
+ CC => [@native_cc, '-D_GNUCC', '-c'],
+ LD => [@native_cc, '-D_GNUCC'],
+ LDLIB => ['ld', '-r', '-o'],
+ CPP => [@native_cc, '-D_GNUCC', '-E'],
+ DEFARG => "-D",
+ INCARG => "-I",
+ DEBUGARG => ['-g', '-ggdb'],
+ OPTIMARG => ['-O4'],
+ CPROFILEARG => '-pg',
+ LPROFILEARG => '-pg',
+ OBJEXT => "o",
+ LIBEXT => "a",
+ EXEEXT => "",
+ OUTOBJ => '-o',
+ OUTEXE => '-o',
+ OUTCPP => '-o',
+ WARNISERROR => "-Werror",
+ FORCECSOURCE => [],
+ LINEPATTERN => "^#\\s+(\\d+)\\s+\"(.+)\"",
+
+ OPTIONS =>
+ [ "[^-].*\\.($::cilbin|c|cpp|cc)\$" => { TYPE => 'CSOURCE' },
+ "[^-].*\\.(s|S)\$" => { TYPE => 'ASMSOURCE' },
+ "[^-].*\\.i\$" => { TYPE => 'ISOURCE' },
+ # .o files can be linker scripts
+ "[^-]" => { RUN => sub { &GNUCC::parseLinkerScript(@_); }},
+ "-E" => { RUN => sub { $stub->{OPERATION} = "TOI"; }},
+ "-pipe\$" => { TYPE => 'ALLARGS' },
+ "-[DIU]" => { ONEMORE => 1, TYPE => "PREPROC" },
+ "-isystem" => { ONEMORE => 1, TYPE => "PREPROC" },
+ '-undef$' => { TYPE => 'PREPROC' },
+ '-w$' => { TYPE => 'PREPROC' },
+ '-M$' => { TYPE => 'SPECIAL' },
+ '-MM$' => { TYPE => 'SPECIAL' },
+ '-MF$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-C$' => { TYPE => 'EARLY_PREPROC'}, # zra
+ '-MG$' => { TYPE => 'EARLY_PREPROC' },
+ '-MP$' => { TYPE => 'EARLY_PREPROC' },
+ '-MT$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-MQ$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-MD$' => { TYPE => 'EARLY_PREPROC' },
+ '-MMD$' => { TYPE => 'EARLY_PREPROC' },
+ "-include" => { ONEMORE => 1, TYPE => "PREPROC" }, # sm
+ "-iwithprefix" => { ONEMORE => 1, TYPE => "PREPROC" },
+ '-Wp,' => { TYPE => 'PREPROC' },
+ "-ansi" => { TYPE => 'ALLARGS' },
+ "-c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
+ "-x" => { ONEMORE => 1, TYPE => "CC" },
+ "-v" => { TYPE => 'ALLARGS',
+ RUN => sub { $stub->{TRACE_COMMANDS} = 1; } },
+ "^-e\$" => { ONEMORE => 1, TYPE => 'LINK' },
+ "^-T\$" => { ONEMORE => 1, TYPE => 'LINK' },
+ # GCC defines some more macros if the optimization is On so pass
+ # the -O to the preprocessor and the compiler
+ '-O' => { TYPE => 'ALLARGS' },
+ "-S" => { RUN => sub { $stub->{OPERATION} = "TOOBJ";
+ push @{$stub->{CCARGS}}, $_[1]; }},
+ "-o" => { ONEMORE => 1, TYPE => 'OUT' },
+ "-p\$" => { TYPE => 'LINKCC' },
+ "-pg" => { TYPE => 'LINKCC' },
+ "-a" => { TYPE => 'LINKCC' },
+ "-pedantic\$" => { TYPE => 'ALLARGS' },
+ "-Wall" => { TYPE => 'CC',
+ RUN => sub { push @{$stub->{CILARGS}},"--warnall";}},
+ "-W[-a-z]*\$" => { TYPE => 'CC' },
+ '-g' => { TYPE => 'ALLARGS' },
+ "-save-temps" => { TYPE => 'ALLARGS',
+ RUN => sub { if(! defined $stub->{SAVE_TEMPS}) {
+ $stub->{SAVE_TEMPS} = '.'; } }},
+ '--?print-' => { TYPE => 'SPECIAL' },
+ '-dump' => { TYPE => 'SPECIAL' },
+ "-l" =>
+ { RUN => sub {
+ my ($libname) = ($_[1] =~ m|-l(.+)$|);
+ # See if we can find this library in the LIBDIR
+ my @libdirs = @{$stub->{LIBDIR}};
+ if($#libdirs == -1) {
+ push @libdirs, '.';
+ }
+ foreach my $d (@libdirs) {
+ if(-f "$d/lib$libname.a") {
+ # Pretend that we had a straight argument
+ push @{$stub->{OFILES}}, "$d/lib$libname.a";
+ return;
+ }
+ }
+ # We get here when we cannot find the library in the LIBDIR
+ push @{$stub->{LINKARGS}}, $_[1];
+ }},
+ "-L" =>
+ { RUN => sub {
+ # Remember these directories in LIBDIR
+ my ($dir) = ($_[1] =~ m|-L(.+)$|);
+ push @{$stub->{LIBDIR}}, $dir;
+ push @{$stub->{LINKARGS}}, $_[1];
+ }},
+ "-f" => { TYPE => 'LINKCC' },
+ "-r\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
+ "-i\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
+ "-m" => { TYPE => 'LINKCC', ONEMORE => 1 },
+ "-s\$" => { TYPE => 'LINKCC' },
+ "-Xlinker" => { ONEMORE => 1, TYPE => 'LINK' },
+ "-nostdlib" => { TYPE => 'LINK' },
+ "-nostdinc" => { TYPE => 'PREPROC' },
+ '-rdynamic$' => { TYPE => 'LINK' },
+ "-static" => { TYPE => 'LINK' },
+ "-shared" => { TYPE => 'LINK' },
+ "-static-libgcc" => { TYPE => 'LINK' },
+ "-shared-libgcc" => { TYPE => 'LINK' },
+ '-Wl,--(no-)?whole-archive$' => { TYPE => 'OSOURCE' },
+ '-Wl,' => { TYPE => 'LINK' },
+ "-traditional" => { TYPE => 'PREPROC' },
+ '-std=' => { TYPE => 'ALLARGS' },
+ "--start-group" => { RUN => sub { } },
+ "--end-group" => { RUN => sub { }},
+ "-pthread\$" => { TYPE => 'ALLARGS' },
+ ],
+
+ };
+ bless $self, $class;
+ return $self;
+}
+# '
+
+my $linker_script_debug = 0;
+sub parseLinkerScript {
+ my($self, $filename, $onemore, $pargs) = @_;
+
+ if(! defined($self->{FLATTEN_LINKER_SCRIPTS}) ||
+ $filename !~ /\.o$/) {
+ NotAScript:
+ warn "$filename is not a linker script\n" if $linker_script_debug;
+ push @{$self->{OFILES}}, $filename;
+ return 1;
+ }
+ warn "parsing OBJECT FILE:$filename ****************\n" if
+ $linker_script_debug;
+ open OBJFILE, $filename or die $!;
+ my $line = <OBJFILE>;
+ if ($line !~ /^INPUT/) {
+ close OBJFILE or die $!;
+ goto NotAScript;
+ }
+ warn "\tYES an INPUT file.\n" if $linker_script_debug;
+ my @lines = <OBJFILE>; # Read it all and close it
+ unshift @lines, $line;
+ close OBJFILE or die $!;
+ # Process recursively each line from the file
+ my @tokens = ();
+ my $incomment = 0; # Whether we are in a comment
+ foreach my $line (@lines) {
+ chomp $line;
+ if($incomment) {
+ # See where the comment ends
+ my $endcomment = index($line, "*/");
+ if($endcomment < 0) { # No end on this line
+ next; # next line
+ } else {
+ $line = substr($line, $endcomment + 2);
+ $incomment = 0;
+ }
+ }
+ # Drop the comments that are on a single line
+ $line =~ s|/\*.*\*/| |g;
+ # Here if outside comment. See if a comment starts
+ my $startcomment = index($line, "/*");
+ if($startcomment >= 0) {
+ $incomment = 1;
+ $line = substr($line, 0, $startcomment);
+ }
+ # Split the line into tokens. Sicne we use parentheses in the pattern
+ # the separators will be tokens as well
+ push @tokens, split(/([(),\s])/, $line);
+ }
+ print "Found tokens:", join(':', @tokens), "\n"
+ if $linker_script_debug;
+ # Now parse the file
+ my $state = 0;
+ foreach my $token (@tokens) {
+ if($token eq "" || $token =~ /\s+/) { next; } # Skip spaces
+ if($state == 0) {
+ if($token eq "INPUT") { $state = 1; next; }
+ else { die "Error in script: expecting INPUT"; }
+ }
+ if($state == 1) {
+ if($token eq "(") { $state = 2; next; }
+ else { die "Error in script: expecting ( after INPUT"; }
+ }
+ if($state == 2) {
+ if($token eq ")") { $state = 0; next; }
+ if($token eq ",") { next; } # Comma could be a separator
+ # Now we better see a filename
+ if(! -f $token) {
+ warn "Linker script mentions inexistent file:$token.Ignoring\n";
+ next;
+ }
+ # Process it recursively because it could be a script itself
+ warn "LISTED FILE:$token.\n" if $linker_script_debug;
+ $self->parseLinkerScript($token, $onemore, $pargs);
+ next;
+ }
+ die "Invalid linker script parser state\n";
+
+ }
+}
+
+sub forceIncludeArg {
+ my($self, $what) = @_;
+ return ('-include', $what);
+}
+
+
+# Emit a line # directive
+sub lineDirective {
+ my ($self, $fileName, $lineno) = @_;
+ return "# $lineno \"$fileName\"\n";
+}
+
+# The name of the output file
+sub compileOutputFile {
+ my($self, $src) = @_;
+
+ die "objectOutputFile: not a C source file: $src\n"
+ unless $src =~ /\.($::cilbin|c|cc|cpp|i|s|S)$/;
+
+ if ($self->{OPERATION} eq 'TOOBJ') {
+ if (defined $self->{OUTARG}
+ && "@{$self->{OUTARG}}" =~ m|^-o\s*(\S.+)$|) {
+ return new OutputFile($src, $1);
+ } else {
+ return new KeptFile($src, $self->{OBJEXT}, '.');
+ }
+ } else {
+ return $self->outputFile($src, $self->{OBJEXT});
+ }
+}
+
+sub assembleOutputFile {
+ my($self, $src) = @_;
+ return $self->compileOutputFile($src);
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|-o\s*(\S.+)|) {
+ return $1;
+ }
+ return "a.out";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "@{$self->{CC}} -dumpversion "
+ . join(' ', @{$self->{PPARGS}}) ." |")
+ || die "Cannot start GNUCC";
+ while(<VER>) {
+ if($_ =~ m|^(\d+\S+)| || $_ =~ m|^(egcs-\d+\S+)|) {
+ $cversion = "gcc_$1";
+ close(VER) || die "Cannot start GNUCC\n";
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find GNUCC version\n";
+}
+
+1;
+
+
+__END__
+
+
+
generated by cgit (git 2.34.1) at 2024-06-02 19:49:47 +0000