summaryrefslogtreecommitdiff
path: root/cil/bin/patcher
diff options
context:
space:
mode:
Diffstat (limited to 'cil/bin/patcher')
-rwxr-xr-xcil/bin/patcher605
1 files changed, 0 insertions, 605 deletions
diff --git a/cil/bin/patcher b/cil/bin/patcher
deleted file mode 100755
index 6eb7d15..0000000
--- a/cil/bin/patcher
+++ /dev/null
@@ -1,605 +0,0 @@
-#!/usr/bin/perl
-# A Perl script that patches a bunch of files
-#
-#
-#
-# 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.
-#
-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 <<EOL;
-Patch include files
-Usage: patcher [options] args
-
-options:
- --help Prints this help message
- --verbose Prints a lot of information about what is being done
- --mode=xxx What tool to emulate:
- GNUCC - GNU CC
- MSVC - MS VC cl compiler
- EDG - EDG front end
-
- --dest=xxx The destination directory. Will make one if it does not exist
- --patch=xxx Patch file (can be specified multiple times)
-
- --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
- --sfile=xxx A system-include file to be patched (treated as \#include <xxx>)
-
- --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(<VER>) {
- # 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(<VER>) {
- 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(<PPOUT>) {
- 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 = <WINNAME>;
- 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(<PFILE>) {
- $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
- $_ = <PFILE>;
- $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(<PFILE>) {
- $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(<PFILE>) {
- $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;
-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-29 16:33:18 +0000