From a5f03d96eee482cd84861fc8cefff9eb451c0cad Mon Sep 17 00:00:00 2001 From: xleroy Date: Sun, 29 Mar 2009 09:47:11 +0000 Subject: Cleaned up configure script. Distribution of CIL as an expanded source tree with changes applied (instead of original .tar.gz + patches to be applied at config time). git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1020 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- cil/bin/patcher | 605 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 605 insertions(+) create mode 100755 cil/bin/patcher (limited to 'cil/bin/patcher') diff --git a/cil/bin/patcher b/cil/bin/patcher new file mode 100755 index 00000000..6eb7d154 --- /dev/null +++ b/cil/bin/patcher @@ -0,0 +1,605 @@ +#!/usr/bin/perl +# A Perl script that patches a bunch of files +# +# +# +# Copyright (c) 2001-2002, +# George C. Necula +# Scott McPeak +# Wes Weimer +# 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. +# +use strict; +use File::Basename; +use File::Copy; +use Getopt::Long; # Command-line option processing +use Data::Dumper; +use FindBin; +use lib "$FindBin::Bin"; +use lib "$FindBin::Bin/../lib"; +# Read the configuration script +use CilConfig; + +$::iswin32 = $^O eq 'MSWin32' || $^O eq 'cygwin'; +# matth: On cygwin, ^O is either MSWin32 or cygwin, depending on how you build +# perl. We don't care about the distinction, so just treat all windows +# platforms the same when looking at "system=cygwin" tags on patches. +$::platform = $::iswin32 ? 'cygwin' : $^O; + + +# Set filename parsing according to current operating system. +File::Basename::fileparse_set_fstype($^O); + +sub printHelp { + print <) + + --clean Remove all files in the destination directory + --dumpversion Print the version name used for the current compiler + + All of the other arguments are passed to the preprocessor. + +We will use \"$::platform\" as your system type. + +Send bugs to necula\@cs.berkeley.edu. +EOL +} + + +my %option; +&Getopt::Long::Configure("pass_through"); +&Getopt::Long::GetOptions + (\%option, + "--help", # Display help information + "--verbose|v", # Display information about programs invoked + "--mode=s", # The mode (GNUCC, MSVC) + "--dest=s", # The destination directory + "--patch=s@", # Patch files + "--ufile=s@", # User include files + "--sfile=s@", # System include files + "--dumpversion", + "--clean", + ); + +if($option{help}) { + &printHelp(); + exit 0; +} + +# print Dumper({"option" => \%option, "ARGV" => \@ARGV}); + +my $cversion; # Compiler version +my $cname; # Compiler name +my @patches; # A list of the patches to apply + +my $ppargs = join(' ', @ARGV); + +my %groups; + +&findCompilerVersion(); + +if($option{dumpversion}) { + print $cversion; + exit 0; +} + +# Find the destination directory +if(!defined($option{dest})) { + die "Must give a --dest directory\n"; +} +if(! -d $option{dest}) { + die "The destination directory $option{dest} does not exist\n"; +} + +if($option{clean}) { + # Find the destination directory for a dummy file + my $dest = &destinationFileName(""); + chop $dest; # The final / + print "Cleaning all files in $dest\n"; + (!system("rm -rf $dest")) || die "Cannot remove directory\n"; + exit 0; +} + +print "Patching files for $cname version $cversion\n"; + +# Prepare the patches +if(defined($option{patch})) { + my $pFile; + foreach $pFile (@{$option{patch}}) { + &preparePatchFile($pFile); + } +} + +# print Dumper(\@patches); + +my $file; +foreach $file (@{$option{ufile}}) { + &patchOneFile($file, 0); +} +foreach $file (@{$option{sfile}}) { + &patchOneFile($file, 1); +} + +# Now check whether we have used all the patches +my $hadError = 0; +foreach my $patch (@patches) { + # It was optional + if(defined $patch->{FLAGS}->{optional} || + defined $patch->{FLAGS}->{disabled}) { next; } + # It was for another system + if(defined $patch->{FLAGS}->{system} && + $patch->{FLAGS}->{system} ne $::platform) { next; } + # Its group was done + if(defined $patch->{FLAGS}->{group}) { + if(! defined $groups{$patch->{FLAGS}->{group}}) { + $hadError = 1; + print "None of the following patches from group $patch->{FLAGS}->{group} was used:\n"; + foreach my $gp (@patches) { + if($gp->{FLAGS}->{group} eq $patch->{FLAGS}->{group}) { + print "\tfrom $gp->{PATCHFILE} at $gp->{PATCHLINENO}\n"; + } + } + $groups{$patch->{FLAGS}->{group}} = 1; # We're done with it + } + next; + } + # It was not in a group and was not optional + if(! defined $patch->{USED}) { + $hadError = 1; + print "Non-optional patch was not used:\n\tfrom $patch->{PATCHFILE} at $patch->{PATCHLINENO}\n"; + next; + } +} +exit $hadError; + + +############# SUBROUTINES +sub findCompilerVersion { + $cname = ""; + $cversion = 0; + if($option{mode} eq "GNUCC") { + $cname = "GNU CC"; + open(VER, "$::cc -dumpversion $ppargs|") + || die "Cannot start $cname"; + while() { + # sm: had to modify this to match "egcs-2.91.66", which is + # how egcs responds to the -dumpversion request + if($_ =~ m|^(\d+\S+)| || + $_ =~ m|^(egcs-\d+\S+)|) { + $cversion = "gcc_$1"; + close(VER) || die "Cannot start $cname\n"; + return; + } + } + die "Cannot find the version for GCC\n"; + } + if($option{mode} eq "MSVC") { + $cname = "Microsoft cl"; + $ppargs =~ s|/nologo||g; + open(VER, "cl $ppargs 2>&1|") || die "Cannot start $cname: cl $ppargs\n"; + while() { + if($_ =~ m|Compiler Version (\S+) |) { + $cversion = "cl_$1"; + close(VER); + return; + } + } + die "Cannot find the version for Microsoft CL\n"; + } + die "You must specify a --mode (either GNUCC or MSVC)"; +} + +sub lineDirective { + my ($fileName, $lineno) = @_; + if($::iswin32) { + $fileName =~ s|\\|/|g; + } + if($option{mode} eq "MSVC") { + return "#line $lineno \"$fileName\"\n"; + } + if($option{mode} eq "GNUCC" || $option{mode} eq "EDG") { + return "# $lineno \"$fileName\"\n"; + } + die "lineDirective: invalid mode"; +} + +# Find the absolute name for a file +sub patchOneFile { + my ($fname, $issys) = @_; + my $fname1 = $issys ? "<$fname>" : "\"$fname\""; + print "Patching $fname1\n"; + my $preprocfile = "__topreproc"; + unlink "$preprocfile.i"; + open(TOPREPROC, ">$preprocfile.c") || die "Cannot open preprocessor file"; + print TOPREPROC "#include $fname1\n"; + close(TOPREPROC); + # Do not test for error while running the preprocessor because the + # error might be due to an #error directive + my $preproccmd = ""; + if($option{mode} eq "GNUCC") { + $preproccmd = "$::cc -E $ppargs $preprocfile.c >$preprocfile.i"; + if ($^O ne 'MSWin32') { # Windows has no /dev/null + # ignore stderr (e.g. #error directives) + $preproccmd .= " 2>/dev/null"; + } + } elsif($option{mode} eq "MSVC") { + $preproccmd = "cl /nologo /P $ppargs $preprocfile.c"; + } else { die "Invalid --mode"; } + + if(system($preproccmd) && $option{mode} eq "MSVC" ) { + # For some reason the gcc returns spurious error codes + die "Error running preprocessor: $preproccmd" + } + + # Now scan the resulting file and get the real name of the file + my $absname = ""; + open(PPOUT, "<$preprocfile.i") || die "Cannot find $preprocfile.i"; + while() { + if($_ =~ m|^\#.+\"(.+$fname)\"|) { + $absname = $1; + last; + } + } + close(PPOUT); + if($absname eq "") { + die "Cannot find the absolute name of $fname1 in $preprocfile.i\n"; + } + unlink "$preprocfile.c"; + unlink "$preprocfile.i"; + # If we fail then maybe we are using cygwin paths in a Win32 system + if($option{mode} eq "GNUCC" && $::iswin32) { + open(WINNAME, "cygpath -w $absname|") + || die "Cannot run cygpath to convert $absname to a Windows name"; + $absname = ; + if($absname =~ m|\n$|) { + chop $absname; + } + # print "Converted $fileName to $newName\n"; + close(WINNAME) || die "Cannot run cygpath to convert $absname"; + } + if(! -f $absname) { #matth: we need to do this test after calling cygpath + die "Cannot find the absolute name of $fname1 (\"$absname\")\n"; + } + print " Absolute name is $absname\n"; + # Decide where to put the result + my $dest = &destinationFileName($fname); + print " Destination is $dest\n"; + &applyPatches($absname, $dest); +} + +# Is absolute path name? +sub isAbsolute { + my($name) = @_; + if($::iswin32) { + return ($name =~ m%^([a-zA-Z]:)?[/\\]%); + } else { + return ($name =~ m%^[/\\]%); + } +} + +# Compute the destination file name and create all necessary directories +sub destinationFileName { + my ($fname) = @_; + if(&isAbsolute($fname)) { + die "Cannot process files that have absolute names\n"; + } + my $dest = $option{dest} . "/" . $cversion; + # Break the file name into components + my @fnamecomp = split(m%[/\\]%, $fname); + # Add one component at a time + do { + if(! -d $dest) { + (mkdir $dest, 0777) || die "Cannot create directory $dest\n"; + } + my $comp = shift @fnamecomp; + $dest .= ('/' . $comp); + } while($#fnamecomp >= 0); + return $dest; +} +##################################################################### +# Patching of files +# +sub preparePatchFile { + my ($pFile) = @_; + open(PFILE, "<$pFile") || + die "Cannot read patch file $pFile\n"; + my $patchLineNo = 0; + my $patchStartLine = 0; + NextPattern: + while() { + $patchLineNo ++; + if($_ !~ m|^<<<(.*)$|) { + next; + } + # Process the flags + my @patchflags = split(/\s*,\s*/, $1); + my %valueflags; + foreach my $flg (@patchflags) { + $flg = &trimSpaces($flg); + if($flg =~ m|^(.+)\s*=\s*(.+)$|) { + $valueflags{$1} = $2; + } else { + $valueflags{$flg} = 1; + } + } + # Now we have found the start + $_ = ; + $patchLineNo ++; + my $current_pattern = []; + my @all_patterns = (); + if($_ =~ m|^===|) { + if(! defined $valueflags{ateof} && + ! defined $valueflags{atsof}) { + die "A pattern is missing in $pFile"; + } + goto AfterPattern; + } + if($_ eq "") { + die "A pattern is missing in $pFile"; + } + push @{$current_pattern}, $_; + + while() { + $patchLineNo ++; + if($_ =~ m|^===|) { + last; + } + if($_ =~ m%^\|\|\|%) { + # This is an alternate pattern + push @all_patterns, $current_pattern; + $current_pattern = []; + next; + } + push @{$current_pattern}, $_; + } + AfterPattern: + # Finish off the last pattern + push @all_patterns, $current_pattern; + if($_ !~ m|^===|) { + die "No separator found after pattern in $pFile"; + } + $patchStartLine = $patchLineNo + 1; + my $replacement = ""; + # If we have more than one non-optional pattern with no group + # specified, then create a group + if(@all_patterns > 1 && + ! defined $valueflags{group} && + ! defined $valueflags{optional}) { + $valueflags{group} = $pFile . "_$patchStartLine"; + } + while() { + $patchLineNo ++; + if($_ =~ m|^>>>|) { + # For each alternate pattern + my $patt; + foreach $patt (@all_patterns) { + # Maybe the @__pattern__@ string appears in the replacement + my $pattern_repl = join('', @{$patt}); + my $nrlines = int(@{$patt}); + my $local_repl = $replacement; + $local_repl =~ s/\@__pattern__\@/$pattern_repl/g; + # Strip the spaces from patterns + my @pattern_no_space = (); + my $i; + foreach $i (@{$patt}) { + $i =~ s/\s+//g; + push @pattern_no_space, $i; + } + push @patches, { HEAD => $pattern_no_space[0], + FLAGS => \%valueflags, + NRLINES => $nrlines, + PATTERNS => \@pattern_no_space, + REPLACE => $local_repl, + PATCHFILE => $pFile, + PATCHLINENO => $patchStartLine, + }; + } + next NextPattern; + } + $replacement .= $_; + } + die "Unfinished replacement for pattern in $pFile"; + } + close(PFILE) || + die "Cannot close patch file $pFile\n"; + print "Loaded patches from $pFile\n"; + # print Dumper(\@patches); die "Here\n"; + +} + +sub trimSpaces { + my($str) = @_; + if($str =~ m|^\s+(\S.*)$|) { + $str = $1; + } + if($str =~ m|^(.*\S)\s+$|) { + $str = $1; + } + return $str; +} + + +my @includeReadAhead = (); +sub readIncludeLine { + my($infile) = @_; + if($#includeReadAhead < 0) { + my $newLine = <$infile>; + return $newLine; + } else { + return shift @includeReadAhead; + } +} + +sub undoReadIncludeLine { + my($line) = @_; + push @includeReadAhead, $line; +} + +sub applyPatches { + my($in, $out) = @_; + # Initialize all the patches + my $patch; + # And remember the EOF patches that are applicable here + my @eof_patches = (); + foreach $patch (@patches) { + $patch->{USE} = 1; + my $infile = $patch->{FLAGS}->{file}; + if(defined $infile && $in !~ m|$infile$|) { +# print "Will not use patch ", +# &lineDirective($patch->{PATCHFILE},$patch->{PATCHLINENO}); + $patch->{USE} = 0; + next; + } + # Disable the system specific patterns + if(defined $patch->{FLAGS}->{system} && + $patch->{FLAGS}->{system} ne $::platform) { + $patch->{USE} = 0; + next; + } + # Disable also (for now) the patches that must be applied at EOF + if(defined $patch->{FLAGS}->{ateof} || + defined $patch->{FLAGS}->{atsof} || + defined $patch->{FLAGS}->{disabled} ) { + $patch->{USE} = 0; + push @eof_patches, $patch; + } + + } + + open(OUT, ">$out") || die "Cannot open patch output file $out"; + open(IN, "<$in") || die "Cannot open patch input file $in"; + + @includeReadAhead = (); + + my $lineno = 0; + my $line; # The current line + + # the file name that should be printed in the line directives + my $lineDirectiveFile = $in; + # Now apply the SOF patches + foreach my $patch (@eof_patches) { + if(defined $patch->{FLAGS}->{atsof}) { + my $line = &applyOnePatch($patch, &lineDirective($in, $lineno)); + print OUT $line; + } + } + + while($line = &readIncludeLine(\*IN)) { + $lineno ++; + # Now we have a line to print out. See if it needs patching + my $patch; + my @lines = ($line); # A number of lines + my $nrLines = 1; # How many lines + my $toundo = 0; + NextPatch: + foreach $patch (@patches) { + if(! $patch->{USE}) { next; } # We are not using this patch + my $line_no_spaces = $line; + $line_no_spaces =~ s/\s+//g; + if($line_no_spaces eq $patch->{HEAD}) { + # Now see if all the lines match + my $patNrLines = $patch->{NRLINES}; + if($patNrLines > 1) { + # Make sure we have enough lines + while($nrLines < $patNrLines) { + push @lines, &readIncludeLine(\*IN); + $nrLines ++; + $toundo ++; + } + my @checkLines = @{$patch->{PATTERNS}}; + my $i; + # print "check: ", join(":", @checkLines); + # print "with $nrLines lines: ", join("+", @lines); + for($i=0;$i<$patNrLines;$i++) { + $line_no_spaces = $lines[$i]; + $line_no_spaces =~ s/\s+//g; + if($checkLines[$i] ne $line_no_spaces) { + # print "No match for $patch->{HEAD}\n"; + next NextPatch; + } + } + } + # print "Using patch from $patch->{PATCHFILE}:$patch->{PATCHLINENO} at $in:$lineno\n"; + # Now replace + $lineno += ($patNrLines - 1); + $toundo -= ($patNrLines - 1); + $line = &applyOnePatch($patch, &lineDirective($in, $lineno + 1)); + last; + } + } + print OUT $line; + # Now undo all but the first line + my $i; + for($i=$nrLines - $toundo;$i<$nrLines;$i++) { + &undoReadIncludeLine($lines[$i]); + } + } + close(IN) || die "Cannot close file $in"; + # Now apply the EOF patches + foreach $patch (@eof_patches) { + if(defined $patch->{FLAGS}->{ateof}) { + my $line = &applyOnePatch($patch, &lineDirective($in, $lineno)); + print OUT $line; + } + } + + close(OUT); + return 1; +} + + +sub applyOnePatch { + my($patch, $after) = @_; + my $line = &lineDirective($patch->{PATCHFILE}, + $patch->{PATCHLINENO}); + $line .= $patch->{REPLACE}; + $line .= $after; + # Mark that we have used this group + $patch->{USED} = 1; + if(defined $patch->{FLAGS}->{group}) { + $groups{$patch->{FLAGS}->{group}} = 1; + } + return $line; +} -- cgit