summaryrefslogtreecommitdiff
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, 0 insertions, 2137 deletions
diff --git a/cil/lib/Cilly.pm b/cil/lib/Cilly.pm
deleted file mode 100644
index fa7aa53..0000000
--- a/cil/lib/Cilly.pm
+++ /dev/null
@@ -1,2137 +0,0 @@
-#
-#
-# 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 v1.2.3 (git 2.39.1) at 2024-05-28 21:14:36 +0000