#!/usr/bin/perl -w

  # (c) 2001, Dave Jones. (the file handling bit)

  # (c) 2005, Joel Schopp <jschopp@austin.ibm.com> (the ugly bit)

  # (c) 2007,2008, Andy Whitcroft <apw@uk.ibm.com> (new conditions, test suite)

  # (c) 2008-2010 Andy Whitcroft <apw@canonical.com>

  # Licensed under the terms of the GNU GPL License version 2
  
  use strict;

  use POSIX;

  
  my $P = $0;

  $P =~ s@(.*)/@@g;
  my $D = $1;

  my $V = '0.32';

  
  use Getopt::Long qw(:config no_auto_abbrev);
  
  my $quiet = 0;
  my $tree = 1;
  my $chk_signoff = 1;
  my $chk_patch = 1;

  my $tst_only;

  my $emacs = 0;

  my $terse = 0;

  my $file = 0;
  my $check = 0;

  my $check_orig = 0;

  my $summary = 1;
  my $mailback = 0;

  my $summary_file = 0;

  my $show_types = 0;

  my $fix = 0;

  my $fix_inplace = 0;

  my $root;

  my %debug;

  my %camelcase = ();

  my %use_type = ();
  my @use = ();
  my %ignore_type = ();

  my @ignore = ();

  my $help = 0;

  my $configuration_file = ".checkpatch.conf";

  my $max_line_length = 80;

  my $ignore_perl_version = 0;
  my $minimum_perl_version = 5.10.0;

  my $min_conf_desc_length = 4;

  my $spelling_file = "$D/spelling.txt";

  
  sub help {
  	my ($exitcode) = @_;
  
  	print << "EOM";
  Usage: $P [OPTION]... [FILE]...
  Version: $V
  
  Options:
    -q, --quiet                quiet
    --no-tree                  run without a kernel tree
    --no-signoff               do not check for 'Signed-off-by' line
    --patch                    treat FILE as patchfile (default)
    --emacs                    emacs compile window format
    --terse                    one line per report
    -f, --file                 treat FILE as regular source file
    --subjective, --strict     enable more subjective tests

    --types TYPE(,TYPE2...)    show only these comma separated message types

    --ignore TYPE(,TYPE2...)   ignore various comma separated message types

    --max-line-length=n        set the maximum line length, if exceeded, warn

    --min-conf-desc-length=n   set the min description length, if shorter, warn

    --show-types               show the message "types" in the output

    --root=PATH                PATH to the kernel tree root
    --no-summary               suppress the per-file summary
    --mailback                 only produce a report in case of warnings/errors
    --summary-file             include the filename in summary
    --debug KEY=[0|1]          turn on/off debugging of KEY, where KEY is one of
                               'values', 'possible', 'type', and 'attr' (default
                               is all off)
    --test-only=WORD           report only warnings/errors containing WORD
                               literally

    --fix                      EXPERIMENTAL - may create horrible results
                               If correctable single-line errors exist, create
                               "<inputfile>.EXPERIMENTAL-checkpatch-fixes"
                               with potential errors corrected to the preferred
                               checkpatch style

    --fix-inplace              EXPERIMENTAL - may create horrible results
                               Is the same as --fix, but overwrites the input
                               file.  It's your fault if there's no backup or git

    --ignore-perl-version      override checking of perl version.  expect
                               runtime errors.

    -h, --help, --version      display this help and exit
  
  When FILE is - read standard input.
  EOM
  
  	exit($exitcode);
  }

  my $conf = which_conf($configuration_file);
  if (-f $conf) {
  	my @conf_args;
  	open(my $conffile, '<', "$conf")
  	    or warn "$P: Can't find a readable $configuration_file file $!
  ";
  
  	while (<$conffile>) {
  		my $line = $_;
  
  		$line =~ s/\s*
  ?$//g;
  		$line =~ s/^\s*//g;
  		$line =~ s/\s+/ /g;
  
  		next if ($line =~ m/^\s*#/);
  		next if ($line =~ m/^\s*$/);
  
  		my @words = split(" ", $line);
  		foreach my $word (@words) {
  			last if ($word =~ m/^#/);
  			push (@conf_args, $word);
  		}
  	}
  	close($conffile);
  	unshift(@ARGV, @conf_args) if @conf_args;
  }

  GetOptions(

  	'q|quiet+'	=> \$quiet,

  	'tree!'		=> \$tree,
  	'signoff!'	=> \$chk_signoff,
  	'patch!'	=> \$chk_patch,

  	'emacs!'	=> \$emacs,

  	'terse!'	=> \$terse,

  	'f|file!'	=> \$file,

  	'subjective!'	=> \$check,
  	'strict!'	=> \$check,

  	'ignore=s'	=> \@ignore,

  	'types=s'	=> \@use,

  	'show-types!'	=> \$show_types,

  	'max-line-length=i' => \$max_line_length,

  	'min-conf-desc-length=i' => \$min_conf_desc_length,

  	'root=s'	=> \$root,

  	'summary!'	=> \$summary,
  	'mailback!'	=> \$mailback,

  	'summary-file!'	=> \$summary_file,

  	'fix!'		=> \$fix,

  	'fix-inplace!'	=> \$fix_inplace,

  	'ignore-perl-version!' => \$ignore_perl_version,

  	'debug=s'	=> \%debug,

  	'test-only=s'	=> \$tst_only,

  	'h|help'	=> \$help,
  	'version'	=> \$help
  ) or help(1);
  
  help(0) if ($help);

  $fix = 1 if ($fix_inplace);

  $check_orig = $check;

  my $exit = 0;

  if ($^V && $^V lt $minimum_perl_version) {
  	printf "$P: requires at least perl version %vd
  ", $minimum_perl_version;
  	if (!$ignore_perl_version) {
  		exit(1);
  	}
  }

  if ($#ARGV < 0) {

  	print "$P: no input files
  ";

  	exit(1);
  }

  sub hash_save_array_words {
  	my ($hashRef, $arrayRef) = @_;
  
  	my @array = split(/,/, join(',', @$arrayRef));
  	foreach my $word (@array) {
  		$word =~ s/\s*
  ?$//g;
  		$word =~ s/^\s*//g;
  		$word =~ s/\s+/ /g;
  		$word =~ tr/[a-z]/[A-Z]/;
  
  		next if ($word =~ m/^\s*#/);
  		next if ($word =~ m/^\s*$/);
  
  		$hashRef->{$word}++;
  	}
  }

  sub hash_show_words {
  	my ($hashRef, $prefix) = @_;

  	if ($quiet == 0 && keys %$hashRef) {

  		print "NOTE: $prefix message types:";

  		foreach my $word (sort keys %$hashRef) {

  			print " $word";
  		}
  		print "
  
  ";
  	}

  }

  hash_save_array_words(\%ignore_type, \@ignore);
  hash_save_array_words(\%use_type, \@use);

  my $dbg_values = 0;
  my $dbg_possible = 0;

  my $dbg_type = 0;

  my $dbg_attr = 0;

  for my $key (keys %debug) {

  	## no critic
  	eval "\${dbg_$key} = '$debug{$key}';";
  	die "$@" if ($@);

  }

  my $rpt_cleaners = 0;

  if ($terse) {
  	$emacs = 1;
  	$quiet++;
  }

  if ($tree) {
  	if (defined $root) {
  		if (!top_of_kernel_tree($root)) {
  			die "$P: $root: --root does not point at a valid tree
  ";
  		}
  	} else {
  		if (top_of_kernel_tree('.')) {
  			$root = '.';
  		} elsif ($0 =~ m@(.*)/scripts/[^/]*$@ &&
  						top_of_kernel_tree($1)) {
  			$root = $1;
  		}
  	}
  
  	if (!defined $root) {
  		print "Must be run from the top-level dir. of a kernel tree
  ";
  		exit(2);
  	}

  }

  my $emitted_corrupt = 0;

  our $Ident	= qr{
  			[A-Za-z_][A-Za-z\d_]*
  			(?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*
  		}x;

  our $Storage	= qr{extern|static|asmlinkage};
  our $Sparse	= qr{
  			__user|
  			__kernel|
  			__force|
  			__iomem|
  			__must_check|
  			__init_refok|

  			__kprobes|

  			__ref|
  			__rcu

  		}x;

  our $InitAttributePrefix = qr{__(?:mem|cpu|dev|net_|)};
  our $InitAttributeData = qr{$InitAttributePrefix(?:initdata\b)};
  our $InitAttributeConst = qr{$InitAttributePrefix(?:initconst\b)};
  our $InitAttributeInit = qr{$InitAttributePrefix(?:init\b)};
  our $InitAttribute = qr{$InitAttributeData|$InitAttributeConst|$InitAttributeInit};

  # Notes to $Attribute:
  # We need \b after 'init' otherwise 'initconst' will cause a false positive in a check

  our $Attribute	= qr{
  			const|

  			__percpu|
  			__nocast|
  			__safe|
  			__bitwise__|
  			__packed__|
  			__packed2__|
  			__naked|
  			__maybe_unused|
  			__always_unused|
  			__noreturn|
  			__used|
  			__cold|
  			__noclone|
  			__deprecated|

  			__read_mostly|
  			__kprobes|

  			$InitAttribute|

  			____cacheline_aligned|
  			____cacheline_aligned_in_smp|

  			____cacheline_internodealigned_in_smp|
  			__weak

  		  }x;

  our $Modifier;

  our $Inline	= qr{inline|__always_inline|noinline|__inline|__inline__};

  our $Member	= qr{->$Ident|\.$Ident|\[[^]]*\]};
  our $Lval	= qr{$Ident(?:$Member)*};

  our $Int_type	= qr{(?i)llu|ull|ll|lu|ul|l|u};
  our $Binary	= qr{(?i)0b[01]+$Int_type?};
  our $Hex	= qr{(?i)0x[0-9a-f]+$Int_type?};
  our $Int	= qr{[0-9]+$Int_type?};

  our $Octal	= qr{0[0-7]+$Int_type?};

  our $Float_hex	= qr{(?i)0x[0-9a-f]+p-?[0-9]+[fl]?};
  our $Float_dec	= qr{(?i)(?:[0-9]+\.[0-9]*|[0-9]*\.[0-9]+)(?:e-?[0-9]+)?[fl]?};
  our $Float_int	= qr{(?i)[0-9]+e-?[0-9]+[fl]?};

  our $Float	= qr{$Float_hex|$Float_dec|$Float_int};

  our $Constant	= qr{$Float|$Binary|$Octal|$Hex|$Int};

  our $Assignment	= qr{\*\=|/=|%=|\+=|-=|<<=|>>=|&=|\^=|\|=|=};

  our $Compare    = qr{<=|>=|==|!=|<|(?<!-)>};

  our $Arithmetic = qr{\+|-|\*|\/|%};

  our $Operators	= qr{
  			<=|>=|==|!=|
  			=>|->|<<|>>|<|>|!|~|

  			&&|\|\||,|\^|\+\+|--|&|\||$Arithmetic

  		  }x;

  our $c90_Keywords = qr{do|for|while|if|else|return|goto|continue|switch|default|case|break}x;

  our $NonptrType;

  our $NonptrTypeMisordered;

  our $NonptrTypeWithAttr;

  our $Type;

  our $TypeMisordered;

  our $Declare;

  our $DeclareMisordered;

  our $NON_ASCII_UTF8	= qr{
  	[\xC2-\xDF][\x80-\xBF]               # non-overlong 2-byte

  	|  \xE0[\xA0-\xBF][\x80-\xBF]        # excluding overlongs
  	| [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straight 3-byte
  	|  \xED[\x80-\x9F][\x80-\xBF]        # excluding surrogates
  	|  \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3
  	| [\xF1-\xF3][\x80-\xBF]{3}          # planes 4-15
  	|  \xF4[\x80-\x8F][\x80-\xBF]{2}     # plane 16
  }x;

  our $UTF8	= qr{
  	[\x09\x0A\x0D\x20-\x7E]              # ASCII
  	| $NON_ASCII_UTF8
  }x;

  our $typeTypedefs = qr{(?x:

  	(?:__)?(?:u|s|be|le)(?:8|16|32|64)|

  	atomic_t
  )};

  our $logFunctions = qr{(?x:

  	printk(?:_ratelimited|_once|)|

  	(?:[a-z0-9]+_){1,2}(?:printk|emerg|alert|crit|err|warning|warn|notice|info|debug|dbg|vdbg|devel|cont|WARN)(?:_ratelimited|_once|)|

  	WARN(?:_RATELIMIT|_ONCE|)|

  	panic|

  	MODULE_[A-Z_]+|
  	seq_vprintf|seq_printf|seq_puts

  )};

  our $signature_tags = qr{(?xi:
  	Signed-off-by:|
  	Acked-by:|
  	Tested-by:|
  	Reviewed-by:|
  	Reported-by:|

  	Suggested-by:|

  	To:|
  	Cc:
  )};

  our @typeListMisordered = (
  	qr{char\s+(?:un)?signed},
  	qr{int\s+(?:(?:un)?signed\s+)?short\s},
  	qr{int\s+short(?:\s+(?:un)?signed)},
  	qr{short\s+int(?:\s+(?:un)?signed)},
  	qr{(?:un)?signed\s+int\s+short},
  	qr{short\s+(?:un)?signed},
  	qr{long\s+int\s+(?:un)?signed},
  	qr{int\s+long\s+(?:un)?signed},
  	qr{long\s+(?:un)?signed\s+int},
  	qr{int\s+(?:un)?signed\s+long},
  	qr{int\s+(?:un)?signed},
  	qr{int\s+long\s+long\s+(?:un)?signed},
  	qr{long\s+long\s+int\s+(?:un)?signed},
  	qr{long\s+long\s+(?:un)?signed\s+int},
  	qr{long\s+long\s+(?:un)?signed},
  	qr{long\s+(?:un)?signed},
  );

  our @typeList = (
  	qr{void},

  	qr{(?:(?:un)?signed\s+)?char},
  	qr{(?:(?:un)?signed\s+)?short\s+int},
  	qr{(?:(?:un)?signed\s+)?short},
  	qr{(?:(?:un)?signed\s+)?int},
  	qr{(?:(?:un)?signed\s+)?long\s+int},
  	qr{(?:(?:un)?signed\s+)?long\s+long\s+int},
  	qr{(?:(?:un)?signed\s+)?long\s+long},
  	qr{(?:(?:un)?signed\s+)?long},
  	qr{(?:un)?signed},

  	qr{float},
  	qr{double},
  	qr{bool},

  	qr{struct\s+$Ident},
  	qr{union\s+$Ident},
  	qr{enum\s+$Ident},
  	qr{${Ident}_t},
  	qr{${Ident}_handler},
  	qr{${Ident}_handler_fn},

  	@typeListMisordered,

  );

  our @typeListWithAttr = (
  	@typeList,
  	qr{struct\s+$InitAttribute\s+$Ident},
  	qr{union\s+$InitAttribute\s+$Ident},
  );

  our @modifierList = (
  	qr{fastcall},
  );

  our @mode_permission_funcs = (
  	["module_param", 3],
  	["module_param_(?:array|named|string)", 4],
  	["module_param_array_named", 5],
  	["debugfs_create_(?:file|u8|u16|u32|u64|x8|x16|x32|x64|size_t|atomic_t|bool|blob|regset32|u32_array)", 2],
  	["proc_create(?:_data|)", 2],
  	["(?:CLASS|DEVICE|SENSOR)_ATTR", 2],
  );

  #Create a search pattern for all these functions to speed up a loop below
  our $mode_perms_search = "";
  foreach my $entry (@mode_permission_funcs) {
  	$mode_perms_search .= '|' if ($mode_perms_search ne "");
  	$mode_perms_search .= $entry->[0];
  }

  our $allowed_asm_includes = qr{(?x:
  	irq|

  	memory|
  	time|
  	reboot

  )};
  # memory.h: ARM has a custom one

  # Load common spelling mistakes and build regular expression list.
  my $misspellings;
  my @spelling_list;
  my %spelling_fix;
  open(my $spelling, '<', $spelling_file)
      or die "$P: Can't open $spelling_file for reading: $!
  ";
  while (<$spelling>) {
  	my $line = $_;
  
  	$line =~ s/\s*
  ?$//g;
  	$line =~ s/^\s*//g;
  
  	next if ($line =~ m/^\s*#/);
  	next if ($line =~ m/^\s*$/);
  
  	my ($suspect, $fix) = split(/\|\|/, $line);
  
  	push(@spelling_list, $suspect);
  	$spelling_fix{$suspect} = $fix;
  }
  close($spelling);
  $misspellings = join("|", @spelling_list);

  sub build_types {

  	my $mods = "(?x:  
  " . join("|
    ", @modifierList) . "
  )";
  	my $all = "(?x:  
  " . join("|
    ", @typeList) . "
  )";

  	my $Misordered = "(?x:  
  " . join("|
    ", @typeListMisordered) . "
  )";

  	my $allWithAttr = "(?x:  
  " . join("|
    ", @typeListWithAttr) . "
  )";

  	$Modifier	= qr{(?:$Attribute|$Sparse|$mods)};

  	$NonptrType	= qr{

  			(?:$Modifier\s+|const\s+)*

  			(?:

  				(?:typeof|__typeof__)\s*\([^\)]*\)|

  				(?:$typeTypedefs\b)|

  				(?:${all}\b)

  			)

  			(?:\s+$Modifier|\s+const)*

  		  }x;

  	$NonptrTypeMisordered	= qr{
  			(?:$Modifier\s+|const\s+)*
  			(?:
  				(?:${Misordered}\b)
  			)
  			(?:\s+$Modifier|\s+const)*
  		  }x;

  	$NonptrTypeWithAttr	= qr{
  			(?:$Modifier\s+|const\s+)*
  			(?:
  				(?:typeof|__typeof__)\s*\([^\)]*\)|
  				(?:$typeTypedefs\b)|
  				(?:${allWithAttr}\b)
  			)
  			(?:\s+$Modifier|\s+const)*
  		  }x;

  	$Type	= qr{

  			$NonptrType

  			(?:(?:\s|\*|\[\])+\s*const|(?:\s|\*\s*(?:const\s*)?|\[\])+|(?:\s*\[\s*\])+)?

  			(?:\s+$Inline|\s+$Modifier)*

  		  }x;

  	$TypeMisordered	= qr{
  			$NonptrTypeMisordered
  			(?:(?:\s|\*|\[\])+\s*const|(?:\s|\*\s*(?:const\s*)?|\[\])+|(?:\s*\[\s*\])+)?
  			(?:\s+$Inline|\s+$Modifier)*
  		  }x;

  	$Declare	= qr{(?:$Storage\s+(?:$Inline\s+)?)?$Type};

  	$DeclareMisordered	= qr{(?:$Storage\s+(?:$Inline\s+)?)?$TypeMisordered};

  }
  build_types();

  our $Typecast	= qr{\s*(\(\s*$NonptrType\s*\)){0,1}\s*};

  
  # Using $balanced_parens, $LvalOrFunc, or $FuncArg
  # requires at least perl version v5.10.0
  # Any use must be runtime checked with $^V
  
  our $balanced_parens = qr/(\((?:[^\(\)]++|(?-1))*\))/;

  our $LvalOrFunc	= qr{((?:[\&\*]\s*)?$Lval)\s*($balanced_parens{0,1})\s*};

  our $FuncArg = qr{$Typecast{0,1}($LvalOrFunc|$Constant)};

  our $declaration_macros = qr{(?x:
  	(?:$Storage\s+)?(?:[A-Z_][A-Z0-9]*_){0,2}(?:DEFINE|DECLARE)(?:_[A-Z0-9]+){1,2}\s*\(|
  	(?:$Storage\s+)?LIST_HEAD\s*\(|
  	(?:$Storage\s+)?${Type}\s+uninitialized_var\s*\(
  )};

  sub deparenthesize {
  	my ($string) = @_;
  	return "" if (!defined($string));

  
  	while ($string =~ /^\s*\(.*\)\s*$/) {
  		$string =~ s@^\s*\(\s*@@;
  		$string =~ s@\s*\)\s*$@@;
  	}

  	$string =~ s@\s+@ @g;

  	return $string;
  }

  sub seed_camelcase_file {
  	my ($file) = @_;
  
  	return if (!(-f $file));
  
  	local $/;
  
  	open(my $include_file, '<', "$file")
  	    or warn "$P: Can't read '$file' $!
  ";
  	my $text = <$include_file>;
  	close($include_file);
  
  	my @lines = split('
  ', $text);
  
  	foreach my $line (@lines) {
  		next if ($line !~ /(?:[A-Z][a-z]|[a-z][A-Z])/);
  		if ($line =~ /^[ \t]*(?:#[ \t]*define|typedef\s+$Type)\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)/) {
  			$camelcase{$1} = 1;

  		} elsif ($line =~ /^\s*$Declare\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)\s*[\(\[,;]/) {
  			$camelcase{$1} = 1;
  		} elsif ($line =~ /^\s*(?:union|struct|enum)\s+(\w*(?:[A-Z][a-z]|[a-z][A-Z])\w*)\s*[;\{]/) {

  			$camelcase{$1} = 1;
  		}
  	}
  }
  
  my $camelcase_seeded = 0;
  sub seed_camelcase_includes {
  	return if ($camelcase_seeded);
  
  	my $files;

  	my $camelcase_cache = "";
  	my @include_files = ();
  
  	$camelcase_seeded = 1;

  	if (-e ".git") {

  		my $git_last_include_commit = `git log --no-merges --pretty=format:"%h%n" -1 -- include`;
  		chomp $git_last_include_commit;

  		$camelcase_cache = ".checkpatch-camelcase.git.$git_last_include_commit";

  	} else {

  		my $last_mod_date = 0;

  		$files = `find $root/include -name "*.h"`;

  		@include_files = split('
  ', $files);
  		foreach my $file (@include_files) {
  			my $date = POSIX::strftime("%Y%m%d%H%M",
  						   localtime((stat $file)[9]));
  			$last_mod_date = $date if ($last_mod_date < $date);
  		}
  		$camelcase_cache = ".checkpatch-camelcase.date.$last_mod_date";
  	}
  
  	if ($camelcase_cache ne "" && -f $camelcase_cache) {
  		open(my $camelcase_file, '<', "$camelcase_cache")
  		    or warn "$P: Can't read '$camelcase_cache' $!
  ";
  		while (<$camelcase_file>) {
  			chomp;
  			$camelcase{$_} = 1;
  		}
  		close($camelcase_file);
  
  		return;

  	}

  	if (-e ".git") {

  		$files = `git ls-files "include/*.h"`;
  		@include_files = split('
  ', $files);
  	}

  	foreach my $file (@include_files) {
  		seed_camelcase_file($file);
  	}

  	if ($camelcase_cache ne "") {

  		unlink glob ".checkpatch-camelcase.*";

  		open(my $camelcase_file, '>', "$camelcase_cache")
  		    or warn "$P: Can't write '$camelcase_cache' $!
  ";

  		foreach (sort { lc($a) cmp lc($b) } keys(%camelcase)) {
  			print $camelcase_file ("$_
  ");
  		}
  		close($camelcase_file);
  	}

  }

  sub git_commit_info {
  	my ($commit, $id, $desc) = @_;
  
  	return ($id, $desc) if ((which("git") eq "") || !(-e ".git"));
  
  	my $output = `git log --no-color --format='%H %s' -1 $commit 2>&1`;
  	$output =~ s/^\s*//gm;
  	my @lines = split("
  ", $output);
  
  	if ($lines[0] =~ /^error: short SHA1 $commit is ambiguous\./) {
  # Maybe one day convert this block of bash into something that returns
  # all matching commit ids, but it's very slow...
  #
  #		echo "checking commits $1..."
  #		git rev-list --remotes | grep -i "^$1" |
  #		while read line ; do
  #		    git log --format='%H %s' -1 $line |
  #		    echo "commit $(cut -c 1-12,41-)"
  #		done
  	} elsif ($lines[0] =~ /^fatal: ambiguous argument '$commit': unknown revision or path not in the working tree\./) {
  	} else {
  		$id = substr($lines[0], 0, 12);
  		$desc = substr($lines[0], 41);
  	}
  
  	return ($id, $desc);
  }

  $chk_signoff = 0 if ($file);

  my @rawlines = ();

  my @lines = ();

  my @fixed = ();

  my @fixed_inserted = ();
  my @fixed_deleted = ();

  my $fixlinenr = -1;

  my $vname;

  for my $filename (@ARGV) {

  	my $FILE;

  	if ($file) {

  		open($FILE, '-|', "diff -u /dev/null $filename") ||

  			die "$P: $filename: diff failed - $!
  ";

  	} elsif ($filename eq '-') {
  		open($FILE, '<&STDIN');

  	} else {

  		open($FILE, '<', "$filename") ||

  			die "$P: $filename: open failed - $!
  ";

  	}

  	if ($filename eq '-') {
  		$vname = 'Your patch';
  	} else {
  		$vname = $filename;
  	}

  	while (<$FILE>) {

  		chomp;
  		push(@rawlines, $_);
  	}

  	close($FILE);

  	if (!process($filename)) {

  		$exit = 1;
  	}
  	@rawlines = ();

  	@lines = ();

  	@fixed = ();

  	@fixed_inserted = ();
  	@fixed_deleted = ();

  	$fixlinenr = -1;

  }
  
  exit($exit);
  
  sub top_of_kernel_tree {

  	my ($root) = @_;
  
  	my @tree_check = (
  		"COPYING", "CREDITS", "Kbuild", "MAINTAINERS", "Makefile",
  		"README", "Documentation", "arch", "include", "drivers",
  		"fs", "init", "ipc", "kernel", "lib", "scripts",
  	);
  
  	foreach my $check (@tree_check) {
  		if (! -e $root . '/' . $check) {
  			return 0;
  		}

  	}

  	return 1;

  }

  sub parse_email {
  	my ($formatted_email) = @_;
  
  	my $name = "";
  	my $address = "";
  	my $comment = "";
  
  	if ($formatted_email =~ /^(.*)<(\S+\@\S+)>(.*)$/) {
  		$name = $1;
  		$address = $2;
  		$comment = $3 if defined $3;
  	} elsif ($formatted_email =~ /^\s*<(\S+\@\S+)>(.*)$/) {
  		$address = $1;
  		$comment = $2 if defined $2;
  	} elsif ($formatted_email =~ /(\S+\@\S+)(.*)$/) {
  		$address = $1;
  		$comment = $2 if defined $2;
  		$formatted_email =~ s/$address.*$//;
  		$name = $formatted_email;

  		$name = trim($name);

  		$name =~ s/^\"|\"$//g;
  		# If there's a name left after stripping spaces and
  		# leading quotes, and the address doesn't have both
  		# leading and trailing angle brackets, the address
  		# is invalid. ie:
  		#   "joe smith joe@smith.com" bad
  		#   "joe smith <joe@smith.com" bad
  		if ($name ne "" && $address !~ /^<[^>]+>$/) {
  			$name = "";
  			$address = "";
  			$comment = "";
  		}
  	}

  	$name = trim($name);

  	$name =~ s/^\"|\"$//g;

  	$address = trim($address);

  	$address =~ s/^\<|\>$//g;
  
  	if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
  		$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
  		$name = "\"$name\"";
  	}
  
  	return ($name, $address, $comment);
  }
  
  sub format_email {
  	my ($name, $address) = @_;
  
  	my $formatted_email;

  	$name = trim($name);

  	$name =~ s/^\"|\"$//g;

  	$address = trim($address);

  
  	if ($name =~ /[^\w \-]/i) { ##has "must quote" chars
  		$name =~ s/(?<!\\)"/\\"/g; ##escape quotes
  		$name = "\"$name\"";
  	}
  
  	if ("$name" eq "") {
  		$formatted_email = "$address";
  	} else {
  		$formatted_email = "$name <$address>";
  	}
  
  	return $formatted_email;
  }

  sub which {

  	my ($bin) = @_;

  	foreach my $path (split(/:/, $ENV{PATH})) {
  		if (-e "$path/$bin") {
  			return "$path/$bin";
  		}

  	}

  	return "";

  }

  sub which_conf {
  	my ($conf) = @_;
  
  	foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
  		if (-e "$path/$conf") {
  			return "$path/$conf";
  		}
  	}
  
  	return "";
  }

  sub expand_tabs {
  	my ($str) = @_;
  
  	my $res = '';
  	my $n = 0;
  	for my $c (split(//, $str)) {
  		if ($c eq "\t") {
  			$res .= ' ';
  			$n++;
  			for (; ($n % 8) != 0; $n++) {
  				$res .= ' ';
  			}
  			next;
  		}
  		$res .= $c;
  		$n++;
  	}
  
  	return $res;
  }

  sub copy_spacing {

  	(my $res = shift) =~ tr/\t/ /c;

  	return $res;
  }

  sub line_stats {
  	my ($line) = @_;
  
  	# Drop the diff line leader and expand tabs
  	$line =~ s/^.//;
  	$line = expand_tabs($line);
  
  	# Pick the indent from the front of the line.
  	my ($white) = ($line =~ /^(\s*)/);
  
  	return (length($line), length($white));
  }

  my $sanitise_quote = '';
  
  sub sanitise_line_reset {
  	my ($in_comment) = @_;
  
  	if ($in_comment) {
  		$sanitise_quote = '*/';
  	} else {
  		$sanitise_quote = '';
  	}
  }

  sub sanitise_line {
  	my ($line) = @_;
  
  	my $res = '';
  	my $l = '';

  	my $qlen = 0;

  	my $off = 0;
  	my $c;

  	# Always copy over the diff marker.
  	$res = substr($line, 0, 1);
  
  	for ($off = 1; $off < length($line); $off++) {
  		$c = substr($line, $off, 1);
  
  		# Comments we are wacking completly including the begin
  		# and end, all to $;.
  		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {
  			$sanitise_quote = '*/';
  
  			substr($res, $off, 2, "$;$;");
  			$off++;
  			next;

  		}

  		if ($sanitise_quote eq '*/' && substr($line, $off, 2) eq '*/') {

  			$sanitise_quote = '';
  			substr($res, $off, 2, "$;$;");
  			$off++;
  			next;

  		}

  		if ($sanitise_quote eq '' && substr($line, $off, 2) eq '//') {
  			$sanitise_quote = '//';
  
  			substr($res, $off, 2, $sanitise_quote);
  			$off++;
  			next;
  		}

  
  		# A \ in a string means ignore the next character.
  		if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&
  		    $c eq "\\") {
  			substr($res, $off, 2, 'XX');
  			$off++;
  			next;

  		}

  		# Regular quotes.
  		if ($c eq "'" || $c eq '"') {
  			if ($sanitise_quote eq '') {
  				$sanitise_quote = $c;

  				substr($res, $off, 1, $c);
  				next;
  			} elsif ($sanitise_quote eq $c) {
  				$sanitise_quote = '';
  			}
  		}

  		#print "c<$c> SQ<$sanitise_quote>
  ";

  		if ($off != 0 && $sanitise_quote eq '*/' && $c ne "\t") {
  			substr($res, $off, 1, $;);

  		} elsif ($off != 0 && $sanitise_quote eq '//' && $c ne "\t") {
  			substr($res, $off, 1, $;);

  		} elsif ($off != 0 && $sanitise_quote && $c ne "\t") {
  			substr($res, $off, 1, 'X');
  		} else {
  			substr($res, $off, 1, $c);
  		}

  	}

  	if ($sanitise_quote eq '//') {
  		$sanitise_quote = '';
  	}

  	# The pathname on a #include may be surrounded by '<' and '>'.

  	if ($res =~ /^.\s*\#\s*include\s+\<(.*)\>/) {

  		my $clean = 'X' x length($1);
  		$res =~ s@\<.*\>@<$clean>@;
  
  	# The whole of a #error is a string.

  	} elsif ($res =~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {

  		my $clean = 'X' x length($1);

  		$res =~ s@(\#\s*(?:error|warning)\s+).*@$1$clean@;

  	}

  	return $res;
  }

  sub get_quoted_string {
  	my ($line, $rawline) = @_;
  
  	return "" if ($line !~ m/(\"[X]+\")/g);
  	return substr($rawline, $-[0], $+[0] - $-[0]);
  }

  sub ctx_statement_block {
  	my ($linenr, $remain, $off) = @_;
  	my $line = $linenr - 1;
  	my $blk = '';
  	my $soff = $off;
  	my $coff = $off - 1;

  	my $coff_set = 0;

  	my $loff = 0;

  	my $type = '';
  	my $level = 0;

  	my @stack = ();

  	my $p;

  	my $c;
  	my $len = 0;

  
  	my $remainder;

  	while (1) {

  		@stack = (['', 0]) if ($#stack == -1);

  		#warn "CSB: blk<$blk> remain<$remain>
  ";

  		# If we are about to drop off the end, pull in more
  		# context.
  		if ($off >= $len) {
  			for (; $remain > 0; $line++) {

  				last if (!defined $lines[$line]);

  				next if ($lines[$line] =~ /^-/);

  				$remain--;

  				$loff = $len;

  				$blk .= $lines[$line] . "
  ";

  				$len = length($blk);
  				$line++;
  				last;
  			}
  			# Bail if there is no further context.
  			#warn "CSB: blk<$blk> off<$off> len<$len>
  ";

  			if ($off >= $len) {

  				last;
  			}

  			if ($level == 0 && substr($blk, $off) =~ /^.\s*#\s*define/) {
  				$level++;
  				$type = '#';
  			}

  		}

  		$p = $c;

  		$c = substr($blk, $off, 1);

  		$remainder = substr($blk, $off);

  		#warn "CSB: c<$c> type<$type> level<$level> remainder<$remainder> coff_set<$coff_set>
  ";

  
  		# Handle nested #if/#else.
  		if ($remainder =~ /^#\s*(?:ifndef|ifdef|if)\s/) {
  			push(@stack, [ $type, $level ]);
  		} elsif ($remainder =~ /^#\s*(?:else|elif)\b/) {
  			($type, $level) = @{$stack[$#stack - 1]};
  		} elsif ($remainder =~ /^#\s*endif\b/) {
  			($type, $level) = @{pop(@stack)};
  		}

  		# Statement ends at the ';' or a close '}' at the
  		# outermost level.
  		if ($level == 0 && $c eq ';') {
  			last;
  		}

  		# An else is really a conditional as long as its not else if

  		if ($level == 0 && $coff_set == 0 &&
  				(!defined($p) || $p =~ /(?:\s|\}|\+)/) &&
  				$remainder =~ /^(else)(?:\s|{)/ &&
  				$remainder !~ /^else\s+if\b/) {
  			$coff = $off + length($1) - 1;
  			$coff_set = 1;
  			#warn "CSB: mark coff<$coff> soff<$soff> 1<$1>
  ";
  			#warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]
  ";

  		}

  		if (($type eq '' || $type eq '(') && $c eq '(') {
  			$level++;
  			$type = '(';
  		}
  		if ($type eq '(' && $c eq ')') {
  			$level--;
  			$type = ($level != 0)? '(' : '';
  
  			if ($level == 0 && $coff < $soff) {
  				$coff = $off;

  				$coff_set = 1;
  				#warn "CSB: mark coff<$coff>
  ";

  			}
  		}
  		if (($type eq '' || $type eq '{') && $c eq '{') {
  			$level++;
  			$type = '{';
  		}
  		if ($type eq '{' && $c eq '}') {
  			$level--;
  			$type = ($level != 0)? '{' : '';
  
  			if ($level == 0) {

  				if (substr($blk, $off + 1, 1) eq ';') {
  					$off++;
  				}

  				last;
  			}
  		}

  		# Preprocessor commands end at the newline unless escaped.
  		if ($type eq '#' && $c eq "
  " && $p ne "\\") {
  			$level--;
  			$type = '';
  			$off++;
  			last;
  		}

  		$off++;
  	}

  	# We are truly at the end, so shuffle to the next line.

  	if ($off == $len) {

  		$loff = $len + 1;

  		$line++;
  		$remain--;
  	}

  
  	my $statement = substr($blk, $soff, $off - $soff + 1);
  	my $condition = substr($blk, $soff, $coff - $soff + 1);
  
  	#warn "STATEMENT<$statement>
  ";
  	#warn "CONDITION<$condition>
  ";

  	#print "coff<$coff> soff<$off> loff<$loff>
  ";

  
  	return ($statement, $condition,
  			$line, $remain + 1, $off - $loff + 1, $level);
  }

  sub statement_lines {
  	my ($stmt) = @_;
  
  	# Strip the diff line prefixes and rip blank lines at start and end.
  	$stmt =~ s/(^|
  )./$1/g;
  	$stmt =~ s/^\s*//;
  	$stmt =~ s/\s*$//;
  
  	my @stmt_lines = ($stmt =~ /
  /g);
  
  	return $#stmt_lines + 2;
  }
  
  sub statement_rawlines {
  	my ($stmt) = @_;
  
  	my @stmt_lines = ($stmt =~ /
  /g);
  
  	return $#stmt_lines + 2;
  }
  
  sub statement_block_size {
  	my ($stmt) = @_;
  
  	$stmt =~ s/(^|
  )./$1/g;
  	$stmt =~ s/^\s*{//;
  	$stmt =~ s/}\s*$//;
  	$stmt =~ s/^\s*//;
  	$stmt =~ s/\s*$//;
  
  	my @stmt_lines = ($stmt =~ /
  /g);
  	my @stmt_statements = ($stmt =~ /;/g);
  
  	my $stmt_lines = $#stmt_lines + 2;
  	my $stmt_statements = $#stmt_statements + 1;
  
  	if ($stmt_lines > $stmt_statements) {
  		return $stmt_lines;
  	} else {
  		return $stmt_statements;
  	}
  }

  sub ctx_statement_full {
  	my ($linenr, $remain, $off) = @_;
  	my ($statement, $condition, $level);
  
  	my (@chunks);

  	# Grab the first conditional/block pair.

  	($statement, $condition, $linenr, $remain, $off, $level) =
  				ctx_statement_block($linenr, $remain, $off);

  	#print "F: c<$condition> s<$statement> remain<$remain>
  ";

  	push(@chunks, [ $condition, $statement ]);
  	if (!($remain > 0 && $condition =~ /^\s*(?:
  [+-])?\s*(?:if|else|do)\b/s)) {
  		return ($level, $linenr, @chunks);
  	}
  
  	# Pull in the following conditional/block pairs and see if they
  	# could continue the statement.

  	for (;;) {

  		($statement, $condition, $linenr, $remain, $off, $level) =
  				ctx_statement_block($linenr, $remain, $off);

  		#print "C: c<$condition> s<$statement> remain<$remain>
  ";

  		last if (!($remain > 0 && $condition =~ /^(?:\s*
  [+-])*\s*(?:else|do)\b/s));

  		#print "C: push
  ";
  		push(@chunks, [ $condition, $statement ]);

  	}
  
  	return ($level, $linenr, @chunks);

  }

  sub ctx_block_get {

  	my ($linenr, $remain, $outer, $open, $close, $off) = @_;

  	my $line;
  	my $start = $linenr - 1;

  	my $blk = '';
  	my @o;
  	my @c;
  	my @res = ();

  	my $level = 0;

  	my @stack = ($level);

  	for ($line = $start; $remain > 0; $line++) {
  		next if ($rawlines[$line] =~ /^-/);
  		$remain--;
  
  		$blk .= $rawlines[$line];

  
  		# Handle nested #if/#else.

  		if ($lines[$line] =~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {

  			push(@stack, $level);

  		} elsif ($lines[$line] =~ /^.\s*#\s*(?:else|elif)\b/) {

  			$level = $stack[$#stack - 1];

  		} elsif ($lines[$line] =~ /^.\s*#\s*endif\b/) {

  			$level = pop(@stack);
  		}

  		foreach my $c (split(//, $lines[$line])) {

  			##print "C<$c>L<$level><$open$close>O<$off>
  ";
  			if ($off > 0) {
  				$off--;
  				next;
  			}

  			if ($c eq $close && $level > 0) {
  				$level--;
  				last if ($level == 0);
  			} elsif ($c eq $open) {
  				$level++;
  			}
  		}

  		if (!$outer || $level <= 1) {

  			push(@res, $rawlines[$line]);

  		}

  		last if ($level == 0);

  	}

  	return ($level, @res);

  }
  sub ctx_block_outer {
  	my ($linenr, $remain) = @_;

  	my ($level, @r) = ctx_block_get($linenr, $remain, 1, '{', '}', 0);
  	return @r;

  }
  sub ctx_block {
  	my ($linenr, $remain) = @_;

  	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '{', '}', 0);
  	return @r;

  }
  sub ctx_statement {

  	my ($linenr, $remain, $off) = @_;
  
  	my ($level, @r) = ctx_block_get($linenr, $remain, 0, '(', ')', $off);
  	return @r;
  }
  sub ctx_block_level {

  	my ($linenr, $remain) = @_;

  	return ctx_block_get($linenr, $remain, 0, '{', '}', 0);

  }

  sub ctx_statement_level {
  	my ($linenr, $remain, $off) = @_;
  
  	return ctx_block_get($linenr, $remain, 0, '(', ')', $off);
  }

  
  sub ctx_locate_comment {
  	my ($first_line, $end_line) = @_;
  
  	# Catch a comment on the end of the line itself.

  	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@.*(/\*.*\*/)\s*(?:\\\s*)?$@);

  	return $current_comment if (defined $current_comment);
  
  	# Look through the context and try and figure out if there is a
  	# comment.
  	my $in_comment = 0;
  	$current_comment = '';
  	for (my $linenr = $first_line; $linenr < $end_line; $linenr++) {

  		my $line = $rawlines[$linenr - 1];
  		#warn "           $line
  ";

  		if ($linenr == $first_line and $line =~ m@^.\s*\*@) {
  			$in_comment = 1;
  		}
  		if ($line =~ m@/\*@) {
  			$in_comment = 1;
  		}
  		if (!$in_comment && $current_comment ne '') {
  			$current_comment = '';
  		}
  		$current_comment .= $line . "
  " if ($in_comment);
  		if ($line =~ m@\*/@) {
  			$in_comment = 0;
  		}
  	}
  
  	chomp($current_comment);
  	return($current_comment);
  }
  sub ctx_has_comment {
  	my ($first_line, $end_line) = @_;
  	my $cmt = ctx_locate_comment($first_line, $end_line);

  	##print "LINE: $rawlines[$end_line - 1 ]
  ";

  	##print "CMMT: $cmt
  ";
  
  	return ($cmt ne '');
  }

  sub raw_line {
  	my ($linenr, $cnt) = @_;
  
  	my $offset = $linenr - 1;
  	$cnt++;
  
  	my $line;
  	while ($cnt) {
  		$line = $rawlines[$offset++];
  		next if (defined($line) && $line =~ /^-/);
  		$cnt--;
  	}
  
  	return $line;
  }

  sub cat_vet {
  	my ($vet) = @_;
  	my ($res, $coded);

  	$res = '';
  	while ($vet =~ /([^[:cntrl:]]*)([[:cntrl:]]|$)/g) {
  		$res .= $1;
  		if ($2 ne '') {
  			$coded = sprintf("^%c", unpack('C', $2) + 64);
  			$res .= $coded;

  		}
  	}

  	$res =~ s/$/\$/;

  	return $res;

  }

  my $av_preprocessor = 0;

  my $av_pending;

  my @av_paren_type;

  my $av_pend_colon;

  
  sub annotate_reset {
  	$av_preprocessor = 0;

  	$av_pending = '_';
  	@av_paren_type = ('E');

  	$av_pend_colon = 'O';

  }

  sub annotate_values {
  	my ($stream, $type) = @_;

  	my $res;

  	my $var = '_' x length($stream);

  	my $cur = $stream;

  	print "$stream
  " if ($dbg_values > 1);

  	while (length($cur)) {

  		@av_paren_type = ('E') if ($#av_paren_type < 0);

  		print " <" . join('', @av_paren_type) .

  				"> <$type> <$av_pending>" if ($dbg_values > 1);

  		if ($cur =~ /^(\s+)/o) {

  			print "WS($1)
  " if ($dbg_values > 1);
  			if ($1 =~ /
  / && $av_preprocessor) {

  				$type = pop(@av_paren_type);

  				$av_preprocessor = 0;

  			}

  		} elsif ($cur =~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {

  			print "CAST($1)
  " if ($dbg_values > 1);
  			push(@av_paren_type, $type);

  			$type = 'c';

  		} elsif ($cur =~ /^($Type)\s*(?:$Ident|,|\)|\(|\s*$)/) {

  			print "DECLARE($1)
  " if ($dbg_values > 1);

  			$type = 'T';

  		} elsif ($cur =~ /^($Modifier)\s*/) {
  			print "MODIFIER($1)
  " if ($dbg_values > 1);
  			$type = 'T';

  		} elsif ($cur =~ /^(\#\s*define\s*$Ident)(\(?)/o) {

  			print "DEFINE($1,$2)
  " if ($dbg_values > 1);

  			$av_preprocessor = 1;

  			push(@av_paren_type, $type);
  			if ($2 ne '') {
  				$av_pending = 'N';
  			}
  			$type = 'E';

  		} elsif ($cur =~ /^(\#\s*(?:undef\s*$Ident|include\b))/o) {

  			print "UNDEF($1)
  " if ($dbg_values > 1);
  			$av_preprocessor = 1;
  			push(@av_paren_type, $type);

  		} elsif ($cur =~ /^(\#\s*(?:ifdef|ifndef|if))/o) {

  			print "PRE_START($1)
  " if ($dbg_values > 1);

  			$av_preprocessor = 1;

  
  			push(@av_paren_type, $type);
  			push(@av_paren_type, $type);

  			$type = 'E';

  		} elsif ($cur =~ /^(\#\s*(?:else|elif))/o) {

  			print "PRE_RESTART($1)
  " if ($dbg_values > 1);
  			$av_preprocessor = 1;
  
  			push(@av_paren_type, $av_paren_type[$#av_paren_type]);

  			$type = 'E';

  		} elsif ($cur =~ /^(\#\s*(?:endif))/o) {

  			print "PRE_END($1)
  " if ($dbg_values > 1);
  
  			$av_preprocessor = 1;
  
  			# Assume all arms of the conditional end as this
  			# one does, and continue as if the #endif was not here.
  			pop(@av_paren_type);
  			push(@av_paren_type, $type);

  			$type = 'E';

  
  		} elsif ($cur =~ /^(\\
  )/o) {

  			print "PRECONT($1)
  " if ($dbg_values > 1);

  		} elsif ($cur =~ /^(__attribute__)\s*\(?/o) {
  			print "ATTR($1)
  " if ($dbg_values > 1);
  			$av_pending = $type;
  			$type = 'N';

  		} elsif ($cur =~ /^(sizeof)\s*(\()?/o) {

  			print "SIZEOF($1)
  " if ($dbg_values > 1);

  			if (defined $2) {

  				$av_pending = 'V';

  			}
  			$type = 'N';

  		} elsif ($cur =~ /^(if|while|for)\b/o) {

  			print "COND($1)
  " if ($dbg_values > 1);

  			$av_pending = 'E';

  			$type = 'N';

  		} elsif ($cur =~/^(case)/o) {
  			print "CASE($1)
  " if ($dbg_values > 1);
  			$av_pend_colon = 'C';
  			$type = 'N';

  		} elsif ($cur =~/^(return|else|goto|typeof|__typeof__)\b/o) {

  			print "KEYWORD($1)
  " if ($dbg_values > 1);

  			$type = 'N';
  
  		} elsif ($cur =~ /^(\()/o) {

  			print "PAREN('$1')
  " if ($dbg_values > 1);

  			push(@av_paren_type, $av_pending);
  			$av_pending = '_';

  			$type = 'N';
  
  		} elsif ($cur =~ /^(\))/o) {

  			my $new_type = pop(@av_paren_type);
  			if ($new_type ne '_') {
  				$type = $new_type;

  				print "PAREN('$1') -> $type
  "
  							if ($dbg_values > 1);

  			} else {

  				print "PAREN('$1')
  " if ($dbg_values > 1);

  			}

  		} elsif ($cur =~ /^($Ident)\s*\(/o) {

  			print "FUNC($1)
  " if ($dbg_values > 1);

  			$type = 'V';

  			$av_pending = 'V';

  		} elsif ($cur =~ /^($Ident\s*):(?:\s*\d+\s*(,|=|;))?/) {
  			if (defined $2 && $type eq 'C' || $type eq 'T') {

  				$av_pend_colon = 'B';

  			} elsif ($type eq 'E') {
  				$av_pend_colon = 'L';

  			}
  			print "IDENT_COLON($1,$type>$av_pend_colon)
  " if ($dbg_values > 1);
  			$type = 'V';

  		} elsif ($cur =~ /^($Ident|$Constant)/o) {

  			print "IDENT($1)
  " if ($dbg_values > 1);

  			$type = 'V';
  
  		} elsif ($cur =~ /^($Assignment)/o) {

  			print "ASSIGN($1)
  " if ($dbg_values > 1);

  			$type = 'N';

  		} elsif ($cur =~/^(;|{|})/) {

  			print "END($1)
  " if ($dbg_values > 1);

  			$type = 'E';

  			$av_pend_colon = 'O';

  		} elsif ($cur =~/^(,)/) {
  			print "COMMA($1)
  " if ($dbg_values > 1);
  			$type = 'C';

  		} elsif ($cur =~ /^(\?)/o) {
  			print "QUESTION($1)
  " if ($dbg_values > 1);
  			$type = 'N';
  
  		} elsif ($cur =~ /^(:)/o) {
  			print "COLON($1,$av_pend_colon)
  " if ($dbg_values > 1);
  
  			substr($var, length($res), 1, $av_pend_colon);
  			if ($av_pend_colon eq 'C' || $av_pend_colon eq 'L') {
  				$type = 'E';
  			} else {
  				$type = 'N';
  			}
  			$av_pend_colon = 'O';

  		} elsif ($cur =~ /^(\[)/o) {

  			print "CLOSE($1)
  " if ($dbg_values > 1);

  			$type = 'N';

  		} elsif ($cur =~ /^(-(?![->])|\+(?!\+)|\*|\&\&|\&)/o) {

  			my $variant;
  
  			print "OPV($1)
  " if ($dbg_values > 1);
  			if ($type eq 'V') {
  				$variant = 'B';
  			} else {
  				$variant = 'U';
  			}
  
  			substr($var, length($res), 1, $variant);
  			$type = 'N';

  		} elsif ($cur =~ /^($Operators)/o) {

  			print "OP($1)
  " if ($dbg_values > 1);

  			if ($1 ne '++' && $1 ne '--') {
  				$type = 'N';
  			}
  
  		} elsif ($cur =~ /(^.)/o) {

  			print "C($1)
  " if ($dbg_values > 1);

  		}
  		if (defined $1) {
  			$cur = substr($cur, length($1));
  			$res .= $type x length($1);
  		}

  	}

  	return ($res, $var);

  }

  sub possible {

  	my ($possible, $line) = @_;

  	my $notPermitted = qr{(?:

  		^(?:
  			$Modifier|
  			$Storage|
  			$Type|

  			DEFINE_\S+
  		)$|
  		^(?:

  			goto|
  			return|
  			case|
  			else|
  			asm|__asm__|

  			do|
  			\#|
  			\#\#|

  		)(?:\s|$)|

  		^(?:typedef|struct|enum)\b

  	    )}x;
  	warn "CHECK<$possible> ($line)
  " if ($dbg_possible > 2);
  	if ($possible !~ $notPermitted) {

  		# Check for modifiers.
  		$possible =~ s/\s*$Storage\s*//g;
  		$possible =~ s/\s*$Sparse\s*//g;
  		if ($possible =~ /^\s*$/) {
  
  		} elsif ($possible =~ /\s/) {
  			$possible =~ s/\s*$Type\s*//g;

  			for my $modifier (split(' ', $possible)) {

  				if ($modifier !~ $notPermitted) {
  					warn "MODIFIER: $modifier ($possible) ($line)
  " if ($dbg_possible);
  					push(@modifierList, $modifier);
  				}

  			}

  
  		} else {
  			warn "POSSIBLE: $possible ($line)
  " if ($dbg_possible);
  			push(@typeList, $possible);
  		}

  		build_types();

  	} else {
  		warn "NOTPOSS: $possible ($line)
  " if ($dbg_possible > 1);

  	}
  }

  my $prefix = '';

  sub show_type {

  	my ($type) = @_;

  	return defined $use_type{$type} if (scalar keys %use_type > 0);
  
  	return !defined $ignore_type{$type};

  }

  sub report {

  	my ($level, $type, $msg) = @_;
  
  	if (!show_type($type) ||
  	    (defined $tst_only && $msg !~ /\Q$tst_only\E/)) {

  		return 0;
  	}

  	my $line;
  	if ($show_types) {

  		$line = "$prefix$level:$type: $msg
  ";

  	} else {

  		$line = "$prefix$level: $msg
  ";

  	}

  	$line = (split('
  ', $line))[0] . "
  " if ($terse);

  	push(our @report, $line);

  
  	return 1;

  }

  sub report_dump {

  	our @report;

  }

  sub fixup_current_range {
  	my ($lineRef, $offset, $length) = @_;
  
  	if ($$lineRef =~ /^\@\@ -\d+,\d+ \+(\d+),(\d+) \@\@/) {
  		my $o = $1;
  		my $l = $2;
  		my $no = $o + $offset;
  		my $nl = $l + $length;
  		$$lineRef =~ s/\+$o,$l \@\@/\+$no,$nl \@\@/;
  	}
  }
  
  sub fix_inserted_deleted_lines {
  	my ($linesRef, $insertedRef, $deletedRef) = @_;
  
  	my $range_last_linenr = 0;
  	my $delta_offset = 0;
  
  	my $old_linenr = 0;
  	my $new_linenr = 0;
  
  	my $next_insert = 0;
  	my $next_delete = 0;
  
  	my @lines = ();
  
  	my $inserted = @{$insertedRef}[$next_insert++];
  	my $deleted = @{$deletedRef}[$next_delete++];
  
  	foreach my $old_line (@{$linesRef}) {
  		my $save_line = 1;
  		my $line = $old_line;	#don't modify the array
  		if ($line =~ /^(?:\+\+\+\|\-\-\-)\s+\S+/) {	#new filename
  			$delta_offset = 0;
  		} elsif ($line =~ /^\@\@ -\d+,\d+ \+\d+,\d+ \@\@/) {	#new hunk
  			$range_last_linenr = $new_linenr;
  			fixup_current_range(\$line, $delta_offset, 0);
  		}
  
  		while (defined($deleted) && ${$deleted}{'LINENR'} == $old_linenr) {
  			$deleted = @{$deletedRef}[$next_delete++];
  			$save_line = 0;
  			fixup_current_range(\$lines[$range_last_linenr], $delta_offset--, -1);
  		}
  
  		while (defined($inserted) && ${$inserted}{'LINENR'} == $old_linenr) {
  			push(@lines, ${$inserted}{'LINE'});
  			$inserted = @{$insertedRef}[$next_insert++];
  			$new_linenr++;
  			fixup_current_range(\$lines[$range_last_linenr], $delta_offset++, 1);
  		}
  
  		if ($save_line) {
  			push(@lines, $line);
  			$new_linenr++;
  		}
  
  		$old_linenr++;
  	}
  
  	return @lines;
  }

  sub fix_insert_line {
  	my ($linenr, $line) = @_;
  
  	my $inserted = {
  		LINENR => $linenr,
  		LINE => $line,
  	};
  	push(@fixed_inserted, $inserted);
  }
  
  sub fix_delete_line {
  	my ($linenr, $line) = @_;
  
  	my $deleted = {
  		LINENR => $linenr,
  		LINE => $line,
  	};
  
  	push(@fixed_deleted, $deleted);
  }

  sub ERROR {

  	my ($type, $msg) = @_;
  
  	if (report("ERROR", $type, $msg)) {

  		our $clean = 0;
  		our $cnt_error++;

  		return 1;

  	}

  	return 0;

  }
  sub WARN {

  	my ($type, $msg) = @_;
  
  	if (report("WARNING", $type, $msg)) {

  		our $clean = 0;
  		our $cnt_warn++;

  		return 1;

  	}

  	return 0;

  }
  sub CHK {

  	my ($type, $msg) = @_;
  
  	if ($check && report("CHECK", $type, $msg)) {

  		our $clean = 0;
  		our $cnt_chk++;

  		return 1;

  	}

  	return 0;

  }

  sub check_absolute_file {
  	my ($absolute, $herecurr) = @_;
  	my $file = $absolute;
  
  	##print "absolute<$absolute>
  ";
  
  	# See if any suffix of this path is a path within the tree.
  	while ($file =~ s@^[^/]*/@@) {
  		if (-f "$root/$file") {
  			##print "file<$file>
  ";
  			last;
  		}
  	}
  	if (! -f _)  {
  		return 0;
  	}
  
  	# It is, so see if the prefix is acceptable.
  	my $prefix = $absolute;
  	substr($prefix, -length($file)) = '';
  
  	##print "prefix<$prefix>
  ";
  	if ($prefix ne ".../") {

  		WARN("USE_RELATIVE_PATH",
  		     "use relative pathname instead of absolute in changelog text
  " . $herecurr);

  	}
  }

  sub trim {
  	my ($string) = @_;

  	$string =~ s/^\s+|\s+$//g;
  
  	return $string;
  }
  
  sub ltrim {
  	my ($string) = @_;
  
  	$string =~ s/^\s+//;
  
  	return $string;
  }
  
  sub rtrim {
  	my ($string) = @_;
  
  	$string =~ s/\s+$//;

  
  	return $string;
  }

  sub string_find_replace {
  	my ($string, $find, $replace) = @_;
  
  	$string =~ s/$find/$replace/g;
  
  	return $string;
  }

  sub tabify {
  	my ($leading) = @_;
  
  	my $source_indent = 8;
  	my $max_spaces_before_tab = $source_indent - 1;
  	my $spaces_to_tab = " " x $source_indent;
  
  	#convert leading spaces to tabs
  	1 while $leading =~ s@^([\t]*)$spaces_to_tab@$1\t@g;
  	#Remove spaces before a tab
  	1 while $leading =~ s@^([\t]*)( {1,$max_spaces_before_tab})\t@$1\t@g;
  
  	return "$leading";
  }

  sub pos_last_openparen {
  	my ($line) = @_;
  
  	my $pos = 0;
  
  	my $opens = $line =~ tr/\(/\(/;
  	my $closes = $line =~ tr/\)/\)/;
  
  	my $last_openparen = 0;
  
  	if (($opens == 0) || ($closes >= $opens)) {
  		return -1;
  	}
  
  	my $len = length($line);
  
  	for ($pos = 0; $pos < $len; $pos++) {
  		my $string = substr($line, $pos);
  		if ($string =~ /^($FuncArg|$balanced_parens)/) {
  			$pos += length($1) - 1;
  		} elsif (substr($line, $pos, 1) eq '(') {
  			$last_openparen = $pos;
  		} elsif (index($string, '(') == -1) {
  			last;
  		}
  	}

  	return length(expand_tabs(substr($line, 0, $last_openparen))) + 1;

  }

  sub process {
  	my $filename = shift;

  
  	my $linenr=0;
  	my $prevline="";

  	my $prevrawline="";

  	my $stashline="";

  	my $stashrawline="";

  	my $length;

  	my $indent;
  	my $previndent=0;
  	my $stashindent=0;

  	our $clean = 1;

  	my $signoff = 0;
  	my $is_patch = 0;

  	my $in_header_lines = $file ? 0 : 1;

  	my $in_commit_log = 0;		#Scanning lines before patch

  	my $reported_maintainer_file = 0;

  	my $non_utf8_charset = 0;

  	my $last_blank_line = 0;

  	our @report = ();

  	our $cnt_lines = 0;
  	our $cnt_error = 0;
  	our $cnt_warn = 0;
  	our $cnt_chk = 0;

  	# Trace the real file/line as we go.
  	my $realfile = '';
  	my $realline = 0;
  	my $realcnt = 0;
  	my $here = '';
  	my $in_comment = 0;

  	my $comment_edge = 0;

  	my $first_line = 0;

  	my $p1_prefix = '';

  	my $prev_values = 'E';
  
  	# suppression flags

  	my %suppress_ifbraces;

  	my %suppress_whiletrailers;

  	my %suppress_export;

  	my $suppress_statement = 0;

  	my %signatures = ();

  	# Pre-scan the patch sanitizing the lines.

  	# Pre-scan the patch looking for any __setup documentation.

  	#

  	my @setup_docs = ();
  	my $setup_docs = 0;

  	my $camelcase_file_seeded = 0;

  	sanitise_line_reset();

  	my $line;
  	foreach my $rawline (@rawlines) {

  		$linenr++;
  		$line = $rawline;

  		push(@fixed, $rawline) if ($fix);

  		if ($rawline=~/^\+\+\+\s+(\S+)/) {

  			$setup_docs = 0;
  			if ($1 =~ m@Documentation/kernel-parameters.txt$@) {
  				$setup_docs = 1;
  			}

  			#next;
  		}
  		if ($rawline=~/^\@\@ -\d+(?:,\d+)? \+(\d+)(,(\d+))? \@\@/) {
  			$realline=$1-1;
  			if (defined $2) {
  				$realcnt=$3+1;
  			} else {
  				$realcnt=1+1;
  			}

  			$in_comment = 0;

  
  			# Guestimate if this is a continuing comment.  Run
  			# the context looking for a comment "edge".  If this
  			# edge is a close comment then we must be in a comment
  			# at context start.
  			my $edge;

  			my $cnt = $realcnt;
  			for (my $ln = $linenr + 1; $cnt > 0; $ln++) {
  				next if (defined $rawlines[$ln - 1] &&
  					 $rawlines[$ln - 1] =~ /^-/);
  				$cnt--;
  				#print "RAW<$rawlines[$ln - 1]>
  ";

  				last if (!defined $rawlines[$ln - 1]);

  				if ($rawlines[$ln - 1] =~ m@(/\*|\*/)@ &&
  				    $rawlines[$ln - 1] !~ m@"[^"]*(?:/\*|\*/)[^"]*"@) {
  					($edge) = $1;
  					last;
  				}