#!/usr/bin/env perl

  # SPDX-License-Identifier: GPL-2.0
  #

  # (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>

  # (c) 2010-2018 Joe Perches <joe@perches.com>

  
  use strict;

  use warnings;

  use POSIX;

  use File::Basename;
  use Cwd 'abs_path';

  use Term::ANSIColor qw(:constants);

  use Encode qw(decode encode);

  
  my $P = $0;

  my $D = dirname(abs_path($P));

  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 $showfile = 0;

  my $file = 0;

  my $git = 0;

  my %git_commits = ();

  my $check = 0;

  my $check_orig = 0;

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

  my $summary_file = 0;

  my $show_types = 0;

  my $list_types = 0;

  my $fix = 0;

  my $fix_inplace = 0;

  my $root;

  my $gitroot = $ENV{'GIT_DIR'};
  $gitroot = ".git" if !defined($gitroot);

  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 = 100;

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

  my $min_conf_desc_length = 4;

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

  my $codespell = 0;

  my $codespellfile = "/usr/share/codespell/dictionary.txt";

  my $conststructsfile = "$D/const_structs.checkpatch";

  my $typedefsfile;

  my $color = "auto";

  my $allow_c99_comments = 1; # Can be overridden by --ignore C99_COMMENT_TOLERANCE

  # git output parsing needs US English output, so first set backtick child process LANGUAGE
  my $git_command ='export LANGUAGE=en_US.UTF-8; git';

  my $tabsize = 8;

  my ${CONFIG_} = "CONFIG_";

  
  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

    --showfile                 emit diffed file position, not input file position

    -g, --git                  treat FILE as a single commit or git revision range
                               single git commit with:
                                 <rev>
                                 <rev>^
                                 <rev>~n
                               multiple git commits with:
                                 <rev1>..<rev2>
                                 <rev1>...<rev2>
                                 <rev>-<count>
                               git merges are ignored

    -f, --file                 treat FILE as regular source file
    --subjective, --strict     enable more subjective tests

    --list-types               list the possible message types

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

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

    --show-types               show the specific message type in the output

    --max-line-length=n        set the maximum line length, (default $max_line_length)
                               if exceeded, warn on patches
                               requires --strict for use with --file

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

    --tab-size=n               set the number of spaces for tab (default $tabsize)

    --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.

    --codespell                Use the codespell dictionary for spelling/typos

                               (default:/usr/share/codespell/dictionary.txt)

    --codespellfile            Use this codespell dictionary

    --typedefsfile             Read additional types from this file

    --color[=WHEN]             Use colors 'always', 'never', or only when output
                               is a terminal ('auto'). Default is 'auto'.

    --kconfig-prefix=WORD      use WORD as a prefix for Kconfig symbols (default
                               ${CONFIG_})

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

  sub uniq {
  	my %seen;
  	return grep { !$seen{$_}++ } @_;
  }
  
  sub list_types {
  	my ($exitcode) = @_;
  
  	my $count = 0;
  
  	local $/ = undef;
  
  	open(my $script, '<', abs_path($P)) or
  	    die "$P: Can't read '$P' $!
  ";
  
  	my $text = <$script>;
  	close($script);
  
  	my @types = ();

  	# Also catch when type or level is passed through a variable
  	for ($text =~ /(?:(?:\bCHK|\bWARN|\bERROR|&\{\$msg_level})\s*\(|\$msg_type\s*=)\s*"([^"]+)"/g) {

  		push (@types, $_);
  	}
  	@types = sort(uniq(@types));
  	print("#\tMessage type
  
  ");
  	foreach my $type (@types) {
  		print(++$count . "\t" . $type . "
  ");
  	}
  
  	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;
  }

  # Perl's Getopt::Long allows options to take optional arguments after a space.
  # Prevent --color by itself from consuming other arguments
  foreach (@ARGV) {
  	if ($_ eq "--color" || $_ eq "-color") {
  		$_ = "--color=$color";
  	}
  }

  GetOptions(

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

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

  	'emacs!'	=> \$emacs,

  	'terse!'	=> \$terse,

  	'showfile!'	=> \$showfile,

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

  	'g|git!'	=> \$git,

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

  	'ignore=s'	=> \@ignore,

  	'types=s'	=> \@use,

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

  	'list-types!'	=> \$list_types,

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

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

  	'tab-size=i'	=> \$tabsize,

  	'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,

  	'codespell!'	=> \$codespell,
  	'codespellfile=s'	=> \$codespellfile,

  	'typedefsfile=s'	=> \$typedefsfile,

  	'color=s'	=> \$color,
  	'no-color'	=> \$color,	#keep old behaviors of -nocolor
  	'nocolor'	=> \$color,	#keep old behaviors of -nocolor

  	'kconfig-prefix=s'	=> \${CONFIG_},

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

  list_types(0) if ($list_types);

  $fix = 1 if ($fix_inplace);

  $check_orig = $check;

  die "$P: --git cannot be used with --file or --fix
  " if ($git && ($file || $fix));

  my $exit = 0;

  my $perl_version_ok = 1;

  if ($^V && $^V lt $minimum_perl_version) {

  	$perl_version_ok = 0;

  	printf "$P: requires at least perl version %vd
  ", $minimum_perl_version;

  	exit(1) if (!$ignore_perl_version);

  }

  #if no filenames are given, push '-' to read patch from stdin

  if ($#ARGV < 0) {

  	push(@ARGV, '-');

  }

  if ($color =~ /^[01]$/) {
  	$color = !$color;
  } elsif ($color =~ /^always$/i) {
  	$color = 1;
  } elsif ($color =~ /^never$/i) {
  	$color = 0;
  } elsif ($color =~ /^auto$/i) {
  	$color = (-t STDOUT);
  } else {

  	die "$P: Invalid color mode: $color
  ";

  }

  # skip TAB size 1 to avoid additional checks on $tabsize - 1

  die "$P: Invalid TAB size: $tabsize
  " if ($tabsize < 2);

  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 (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|

  			__kprobes|

  			__ref|

  			__refconst|
  			__refdata|

  			__rcu|
  			__private

  		}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|

  			__pure|

  			__noclone|
  			__deprecated|

  			__read_mostly|

  			__ro_after_init|

  			__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 $String	= qr{"[X\t]*"};

  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 $BasicType;

  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 $typeC99Typedefs = qr{(?:__)?(?:[us]_?)?int_?(?:8|16|32|64)_t};

  our $typeOtherOSTypedefs = qr{(?x:
  	u_(?:char|short|int|long) |          # bsd
  	u(?:nchar|short|int|long)            # sysv
  )};

  our $typeKernelTypedefs = qr{(?x:

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

  	atomic_t
  )};

  our $typeTypedefs = qr{(?x:
  	$typeC99Typedefs\b|
  	$typeOtherOSTypedefs\b|
  	$typeKernelTypedefs\b
  )};

  our $zero_initializer = qr{(?:(?:0[xX])?0+$Int_type?|NULL|false)\b};

  our $logFunctions = qr{(?x:

  	printk(?:_ratelimited|_once|_deferred_once|_deferred|)|

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

  	TP_printk|

  	WARN(?:_RATELIMIT|_ONCE|)|

  	panic|

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

  )};

  our $allocFunctions = qr{(?x:
  	(?:(?:devm_)?
  		(?:kv|k|v)[czm]alloc(?:_node|_array)? |
  		kstrdup(?:_const)? |
  		kmemdup(?:_nul)?) |

  	(?:\w+)?alloc_skb(?:_ip_align)? |

  				# dev_alloc_skb/netdev_alloc_skb, et al
  	dma_alloc_coherent
  )};

  our $signature_tags = qr{(?xi:
  	Signed-off-by:|

  	Co-developed-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 $C90_int_types = qr{(?x:
  	long\s+long\s+int\s+(?:un)?signed|
  	long\s+long\s+(?:un)?signed\s+int|
  	long\s+long\s+(?:un)?signed|
  	(?:(?:un)?signed\s+)?long\s+long\s+int|
  	(?:(?:un)?signed\s+)?long\s+long|
  	int\s+long\s+long\s+(?:un)?signed|
  	int\s+(?:(?:un)?signed\s+)?long\s+long|
  
  	long\s+int\s+(?:un)?signed|
  	long\s+(?:un)?signed\s+int|
  	long\s+(?:un)?signed|
  	(?:(?:un)?signed\s+)?long\s+int|
  	(?:(?:un)?signed\s+)?long|
  	int\s+long\s+(?:un)?signed|
  	int\s+(?:(?:un)?signed\s+)?long|
  
  	int\s+(?:un)?signed|
  	(?:(?:un)?signed\s+)?int
  )};

  our @typeListFile = ();

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

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

  our @modifierListFile = ();

  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|SENSOR_DEVICE|IIO_DEVICE)_ATTR", 2],
  	["IIO_DEV_ATTR_[A-Z_]+", 1],
  	["SENSOR_(?:DEVICE_|)ATTR_2", 2],
  	["SENSOR_TEMPLATE(?:_2|)", 3],
  	["__ATTR", 2],

  );

  my $word_pattern = '\b[A-Z]?[a-z]{2,}\b';

  #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];
  }

  $mode_perms_search = "(?:${mode_perms_search})";

  our %deprecated_apis = (
  	"synchronize_rcu_bh"			=> "synchronize_rcu",
  	"synchronize_rcu_bh_expedited"		=> "synchronize_rcu_expedited",
  	"call_rcu_bh"				=> "call_rcu",
  	"rcu_barrier_bh"			=> "rcu_barrier",
  	"synchronize_sched"			=> "synchronize_rcu",
  	"synchronize_sched_expedited"		=> "synchronize_rcu_expedited",
  	"call_rcu_sched"			=> "call_rcu",
  	"rcu_barrier_sched"			=> "rcu_barrier",
  	"get_state_synchronize_sched"		=> "get_state_synchronize_rcu",
  	"cond_synchronize_sched"		=> "cond_synchronize_rcu",
  );
  
  #Create a search pattern for all these strings to speed up a loop below
  our $deprecated_apis_search = "";
  foreach my $entry (keys %deprecated_apis) {
  	$deprecated_apis_search .= '|' if ($deprecated_apis_search ne "");
  	$deprecated_apis_search .= $entry;
  }
  $deprecated_apis_search = "(?:${deprecated_apis_search})";

  our $mode_perms_world_writable = qr{
  	S_IWUGO		|
  	S_IWOTH		|
  	S_IRWXUGO	|
  	S_IALLUGO	|
  	0[0-7][0-7][2367]
  }x;

  our %mode_permission_string_types = (
  	"S_IRWXU" => 0700,
  	"S_IRUSR" => 0400,
  	"S_IWUSR" => 0200,
  	"S_IXUSR" => 0100,
  	"S_IRWXG" => 0070,
  	"S_IRGRP" => 0040,
  	"S_IWGRP" => 0020,
  	"S_IXGRP" => 0010,
  	"S_IRWXO" => 0007,
  	"S_IROTH" => 0004,
  	"S_IWOTH" => 0002,
  	"S_IXOTH" => 0001,
  	"S_IRWXUGO" => 0777,
  	"S_IRUGO" => 0444,
  	"S_IWUGO" => 0222,
  	"S_IXUGO" => 0111,
  );
  
  #Create a search pattern for all these strings to speed up a loop below
  our $mode_perms_string_search = "";
  foreach my $entry (keys %mode_permission_string_types) {
  	$mode_perms_string_search .= '|' if ($mode_perms_string_search ne "");
  	$mode_perms_string_search .= $entry;
  }

  our $single_mode_perms_string_search = "(?:${mode_perms_string_search})";
  our $multi_mode_perms_string_search = qr{
  	${single_mode_perms_string_search}
  	(?:\s*\|\s*${single_mode_perms_string_search})*
  }x;
  
  sub perms_to_octal {
  	my ($string) = @_;
  
  	return trim($string) if ($string =~ /^\s*0[0-7]{3,3}\s*$/);
  
  	my $val = "";
  	my $oval = "";
  	my $to = 0;
  	my $curpos = 0;
  	my $lastpos = 0;
  	while ($string =~ /\b(($single_mode_perms_string_search)\b(?:\s*\|\s*)?\s*)/g) {
  		$curpos = pos($string);
  		my $match = $2;
  		my $omatch = $1;
  		last if ($lastpos > 0 && ($curpos - length($omatch) != $lastpos));
  		$lastpos = $curpos;
  		$to |= $mode_permission_string_types{$match};
  		$val .= '\s*\|\s*' if ($val ne "");
  		$val .= $match;
  		$oval .= $omatch;
  	}
  	$oval =~ s/^\s*\|\s*//;
  	$oval =~ s/\s*\|\s*$//;
  	return sprintf("%04o", $to);
  }

  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_fix;

  if (open(my $spelling, '<', $spelling_file)) {

  	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);

  		$spelling_fix{$suspect} = $fix;
  	}
  	close($spelling);

  } else {
  	warn "No typos will be found - file '$spelling_file': $!
  ";

  }

  if ($codespell) {
  	if (open(my $spelling, '<', $codespellfile)) {
  		while (<$spelling>) {
  			my $line = $_;
  
  			$line =~ s/\s*
  ?$//g;
  			$line =~ s/^\s*//g;
  
  			next if ($line =~ m/^\s*#/);
  			next if ($line =~ m/^\s*$/);
  			next if ($line =~ m/, disabled/i);
  
  			$line =~ s/,.*$//;
  
  			my ($suspect, $fix) = split(/->/, $line);
  
  			$spelling_fix{$suspect} = $fix;
  		}
  		close($spelling);
  	} else {
  		warn "No codespell typos will be found - file '$codespellfile': $!
  ";
  	}
  }
  
  $misspellings = join("|", sort keys %spelling_fix) if keys %spelling_fix;

  sub read_words {
  	my ($wordsRef, $file) = @_;

  	if (open(my $words, '<', $file)) {
  		while (<$words>) {
  			my $line = $_;

  			$line =~ s/\s*
  ?$//g;
  			$line =~ s/^\s*//g;

  			next if ($line =~ m/^\s*#/);
  			next if ($line =~ m/^\s*$/);
  			if ($line =~ /\s/) {
  				print("$file: '$line' invalid - ignored
  ");
  				next;
  			}

  			$$wordsRef .= '|' if (defined $$wordsRef);

  			$$wordsRef .= $line;
  		}
  		close($file);
  		return 1;

  	}

  
  	return 0;
  }

  my $const_structs;
  if (show_type("CONST_STRUCT")) {
  	read_words(\$const_structs, $conststructsfile)
  	    or warn "No structs that should be const will be found - file '$conststructsfile': $!
  ";
  }

  if (defined($typedefsfile)) {
  	my $typeOtherTypedefs;

  	read_words(\$typeOtherTypedefs, $typedefsfile)
  	    or warn "No additional types will be considered - file '$typedefsfile': $!
  ";

  	$typeTypedefs .= '|' . $typeOtherTypedefs if (defined $typeOtherTypedefs);

  }

  sub build_types {

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

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

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

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

  	$BasicType	= qr{

  				(?:$typeTypedefs\b)|
  				(?:${all}\b)
  		}x;

  	$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*\])+){0,4}

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

  		  }x;

  	$TypeMisordered	= qr{
  			$NonptrTypeMisordered

  			(?:(?:\s|\*|\[\])+\s*const|(?:\s|\*\s*(?:const\s*)?|\[\])+|(?:\s*\[\s*\])+){0,4}

  			(?:\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|$String)};

  our $declaration_macros = qr{(?x:

  	(?:$Storage\s+)?(?:[A-Z_][A-Z0-9]*_){0,2}(?:DEFINE|DECLARE)(?:_[A-Z0-9]+){1,6}\s*\(|

  	(?:$Storage\s+)?[HLP]?LIST_HEAD\s*\(|

  	(?:SKCIPHER_REQUEST|SHASH_DESC|AHASH_REQUEST)_ON_STACK\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;
  		}
  	}
  }

  our %maintained_status = ();

  sub is_maintained_obsolete {
  	my ($filename) = @_;

  	return 0 if (!$tree || !(-e "$root/scripts/get_maintainer.pl"));

  	if (!exists($maintained_status{$filename})) {
  		$maintained_status{$filename} = `perl $root/scripts/get_maintainer.pl --status --nom --nol --nogit --nogit-fallback -f $filename 2>&1`;
  	}

  	return $maintained_status{$filename} =~ /obsolete/i;

  }

  sub is_SPDX_License_valid {
  	my ($license) = @_;

  	return 1 if (!$tree || which("python") eq "" || !(-e "$root/scripts/spdxcheck.py") || !(-e "$gitroot"));

  	my $root_path = abs_path($root);
  	my $status = `cd "$root_path"; echo "$license" | python scripts/spdxcheck.py -`;

  	return 0 if ($status ne "");
  	return 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 "$gitroot") {

  		my $git_last_include_commit = `${git_command} 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 "$gitroot") {

  		$files = `${git_command} 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_is_single_file {
  	my ($filename) = @_;
  
  	return 0 if ((which("git") eq "") || !(-e "$gitroot"));
  
  	my $output = `${git_command} ls-files -- $filename 2>/dev/null`;
  	my $count = $output =~ tr/
  //;
  	return $count eq 1 && $output =~ m{^${filename}$};
  }

  sub git_commit_info {
  	my ($commit, $id, $desc) = @_;

  	return ($id, $desc) if ((which("git") eq "") || !(-e "$gitroot"));

  	my $output = `${git_command} log --no-color --format='%H %s' -1 $commit 2>&1`;

  	$output =~ s/^\s*//gm;
  	my @lines = split("
  ", $output);

  	return ($id, $desc) if ($#lines < 0);

  	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\./) {

  		$id = undef;

  	} 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;

  # If input is git commits, extract all commits from the commit expressions.
  # For example, HEAD-3 means we need check 'HEAD, HEAD~1, HEAD~2'.

  die "$P: No git repository found
  " if ($git && !-e "$gitroot");

  
  if ($git) {
  	my @commits = ();

  	foreach my $commit_expr (@ARGV) {

  		my $git_range;

  		if ($commit_expr =~ m/^(.*)-(\d+)$/) {
  			$git_range = "-$2 $1";

  		} elsif ($commit_expr =~ m/\.\./) {
  			$git_range = "$commit_expr";

  		} else {

  			$git_range = "-1 $commit_expr";
  		}

  		my $lines = `${git_command} log --no-color --no-merges --pretty=format:'%H %s' $git_range`;

  		foreach my $line (split(/
  /, $lines)) {

  			$line =~ /^([0-9a-fA-F]{40,40}) (.*)$/;
  			next if (!defined($1) || !defined($2));

  			my $sha1 = $1;
  			my $subject = $2;
  			unshift(@commits, $sha1);
  			$git_commits{$sha1} = $subject;

  		}
  	}
  	die "$P: no git commits after extraction!
  " if (@commits == 0);
  	@ARGV = @commits;
  }

  my $vname;

  $allow_c99_comments = !defined $ignore_type{"C99_COMMENT_TOLERANCE"};

  for my $filename (@ARGV) {

  	my $FILE;

  	my $is_git_file = git_is_single_file($filename);
  	my $oldfile = $file;
  	$file = 1 if ($is_git_file);

  	if ($git) {
  		open($FILE, '-|', "git format-patch -M --stdout -1 $filename") ||
  			die "$P: $filename: git format-patch failed - $!
  ";
  	} elsif ($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';

  	} elsif ($git) {

  		$vname = "Commit " . substr($filename, 0, 12) . ' ("' . $git_commits{$filename} . '")';

  	} else {
  		$vname = $filename;
  	}

  	while (<$FILE>) {

  		chomp;
  		push(@rawlines, $_);

  		$vname = qq("$1") if ($filename eq '-' && $_ =~ m/^Subject:\s+(.+)/i);

  	}

  	close($FILE);

  
  	if ($#ARGV > 0 && $quiet == 0) {
  		print '-' x length($vname) . "
  ";
  		print "$vname
  ";
  		print '-' x length($vname) . "
  ";
  	}

  	if (!process($filename)) {

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

  	@lines = ();

  	@fixed = ();

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

  	$fixlinenr = -1;

  	@modifierListFile = ();
  	@typeListFile = ();
  	build_types();

  	$file = $oldfile if ($is_git_file);

  }

  if (!$quiet) {

  	hash_show_words(\%use_type, "Used");
  	hash_show_words(\%ignore_type, "Ignored");

  	if (!$perl_version_ok) {

  		print << "EOM"
  
  NOTE: perl $^V is not modern enough to detect all possible issues.

        An upgrade to at least perl $minimum_perl_version is suggested.

  EOM
  	}
  	if ($exit) {
  		print << "EOM"
  
  NOTE: If any of the errors are false positives, please report
        them to the maintainer, see CHECKPATCH in MAINTAINERS.
  EOM
  	}
  }

  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 $name_comment = "";

  	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/\Q$address\E.*$//;

  		$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 = "";
  		}
  	}

  	$comment = trim($comment);

  	$name = trim($name);

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

  	if ($name =~ s/(\s*\([^\)]+\))\s*//) {

  		$name_comment = trim($1);
  	}

  	$address = trim($address);

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

  	return ($name, $name_comment, $address, $comment);

  }
  
  sub format_email {

  	my ($name, $name_comment, $address, $comment) = @_;

  
  	my $formatted_email;

  	$name_comment = trim($name_comment);
  	$comment = trim($comment);

  	$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$name_comment <$address>";

  	}

  	$formatted_email .= "$comment";

  	return $formatted_email;
  }

  sub reformat_email {
  	my ($email) = @_;
  
  	my ($email_name, $name_comment, $email_address, $comment) = parse_email($email);

  	return format_email($email_name, $name_comment, $email_address, $comment);

  }
  
  sub same_email_addresses {

  	my ($email1, $email2, $match_comment) = @_;

  
  	my ($email1_name, $name1_comment, $email1_address, $comment1) = parse_email($email1);
  	my ($email2_name, $name2_comment, $email2_address, $comment2) = parse_email($email2);

  	if ($match_comment != 1) {
  		return $email1_name eq $email2_name &&
  		       $email1_address eq $email2_address;
  	}

  	return $email1_name eq $email2_name &&

  	       $email1_address eq $email2_address &&
  	       $name1_comment eq $name2_comment &&
  	       $comment1 eq $comment2;

  }

  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 % $tabsize) != 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 whacking completely 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@;

  	}

  	if ($allow_c99_comments && $res =~ m@(//.*$)@) {
  		my $match = $1;
  		$res =~ s/\Q$match\E/"$;" x length($match)/e;
  	}

  	return $res;
  }

  sub get_quoted_string {
  	my ($line, $rawline) = @_;

  	return "" if (!defined($line) || !defined($rawline));

  	return "" if ($line !~ m/($String)/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) = @_;

  	# If c99 comment on the current line, or the line before or after
  	my ($current_comment) = ($rawlines[$end_line - 1] =~ m@^\+.*(//.*$)@);
  	return $current_comment if (defined $current_comment);
  	($current_comment) = ($rawlines[$end_line - 2] =~ m@^[\+ ].*(//.*$)@);
  	return $current_comment if (defined $current_comment);
  	($current_comment) = ($rawlines[$end_line] =~ m@^[\+ ].*(//.*$)@);
  	return $current_comment if (defined $current_comment);

  	# Catch a comment on the end of the line itself.

  	($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 get_stat_real {
  	my ($linenr, $lc) = @_;
  
  	my $stat_real = raw_line($linenr, 0);
  	for (my $count = $linenr + 1; $count <= $lc; $count++) {
  		$stat_real = $stat_real . "
  " . raw_line($count, 0);
  	}
  
  	return $stat_real;
  }

  sub get_stat_here {
  	my ($linenr, $cnt, $here) = @_;
  
  	my $herectx = $here . "
  ";
  	for (my $n = 0; $n < $cnt; $n++) {
  		$herectx .= raw_line($linenr, $n) . "
  ";
  	}
  
  	return $herectx;
  }

  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';