Archipelago » qemu

#!/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;

my $P = $0;

$P =~ s@.*/@@g;

my $V = '0.31';

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 $summary = 1;

my $mailback = 0;

my $summary_file = 0;

my $root;

my %debug;

my $help = 0;

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

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

  -h, --help, --version      display this help and exit

When FILE is - read standard input.

EOM

	exit($exitcode);

}

GetOptions(

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

	'tree!'		=> \$tree,

	'signoff!'	=> \$chk_signoff,

	'patch!'	=> \$chk_patch,

	'emacs!'	=> \$emacs,

	'terse!'	=> \$terse,

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

	'subjective!'	=> \$check,

	'strict!'	=> \$check,

	'root=s'	=> \$root,

	'summary!'	=> \$summary,

	'mailback!'	=> \$mailback,

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

	'debug=s'	=> \%debug,

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

	'h|help'	=> \$help,

	'version'	=> \$help

) or help(1);

help(0) if ($help);

my $exit = 0;

if ($#ARGV < 0) {

	print "$P: no input files\n";

	exit(1);

}

my $dbg_values = 0;

my $dbg_possible = 0;

my $dbg_type = 0;

my $dbg_attr = 0;

my $dbg_adv_dcs = 0;

my $dbg_adv_checking = 0;

my $dbg_adv_apw = 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\n";

		}

	} 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\n";

		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

		}x;

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

			__(?:mem|cpu|dev|)(?:initdata|initconst|init\b)|

			____cacheline_aligned|

			____cacheline_aligned_in_smp|

			____cacheline_internodealigned_in_smp|

			__weak

		  }x;

our $Modifier;

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

our $Member	= qr{->$Ident|\.$Ident|\[[^]]*\]};

our $Lval	= qr{$Ident(?:$Member)*};

our $Constant	= qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};

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

our $Compare    = qr{<=|>=|==|!=|<|>};

our $Operators	= qr{

			<=|>=|==|!=|

			=>|->|<<|>>|<|>|!|~|

			&&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%

		  }x;

our $NonptrType;

our $Type;

our $Declare;

our $UTF8	= qr {

	[\x09\x0A\x0D\x20-\x7E]              # ASCII

	| [\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 $typeTypedefs = qr{(?x:

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

	atomic_t

)};

our $logFunctions = qr{(?x:

	printk|

	pr_(debug|dbg|vdbg|devel|info|warning|err|notice|alert|crit|emerg|cont)|

	(dev|netdev|netif)_(printk|dbg|vdbg|info|warn|err|notice|alert|crit|emerg|WARN)|

	WARN|

	panic

)};

our @typeList = (

	qr{void},

	qr{(?:unsigned\s+)?char},

	qr{(?:unsigned\s+)?short},

	qr{(?:unsigned\s+)?int},

	qr{(?:unsigned\s+)?long},

	qr{(?:unsigned\s+)?long\s+int},

	qr{(?:unsigned\s+)?long\s+long},

	qr{(?:unsigned\s+)?long\s+long\s+int},

	qr{unsigned},

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

);

our @modifierList = (

	qr{fastcall},

);

our $allowed_asm_includes = qr{(?x:

	irq|

	memory

)};

# memory.h: ARM has a custom one

sub build_types {

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

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

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

	$NonptrType	= qr{

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

			(?:

				(?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|

				(?:$typeTypedefs\b)|

				(?:${all}\b)

			)

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

		  }x;

	$Type	= qr{

			$NonptrType

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

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

		  }x;

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

}

build_types();

$chk_signoff = 0 if ($file);

my @dep_includes = ();

my @dep_functions = ();

my $removal = "Documentation/feature-removal-schedule.txt";

if ($tree && -f "$root/$removal") {

	open(my $REMOVE, '<', "$root/$removal") ||

				die "$P: $removal: open failed - $!\n";

	while (<$REMOVE>) {

		if (/^Check:\s+(.*\S)/) {

			for my $entry (split(/[, ]+/, $1)) {

				if ($entry =~ m@include/(.*)@) {

					push(@dep_includes, $1);

				} elsif ($entry !~ m@/@) {

					push(@dep_functions, $entry);

				}

			}

		}

	}

	close($REMOVE);

}

my @rawlines = ();

my @lines = ();

my $vname;

for my $filename (@ARGV) {

	my $FILE;

	if ($file) {

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

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

	} elsif ($filename eq '-') {

		open($FILE, '<&STDIN');

	} else {

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

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

	}

	if ($filename eq '-') {

		$vname = 'Your patch';

	} else {

		$vname = $filename;

	}

	while (<$FILE>) {

		chomp;

		push(@rawlines, $_);

	}

	close($FILE);

	if (!process($filename)) {

		$exit = 1;

	}

	@rawlines = ();

	@lines = ();

}

exit($exit);

sub top_of_kernel_tree {

	my ($root) = @_;

	my @tree_check = (

		"COPYING", "MAINTAINERS", "Makefile",

		"README", "docs", "VERSION",

		"vl.c"

	);

	foreach my $check (@tree_check) {

		if (! -e $root . '/' . $check) {

			return 0;

		}

	}

	return 1;

}

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>\n";

		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 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>\n";

		# 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] . "\n";

				$len = length($blk);

				$line++;

				last;

			}

			# Bail if there is no further context.

			#warn "CSB: blk<$blk> off<$off> len<$len>\n";

			if ($off >= $len) {

				last;

			}

		}

		$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>\n";

		# 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>\n";

			#warn "[" . substr($blk, $soff, $coff - $soff + 1) . "]\n";

		}

		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>\n";

			}

		}

		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;

			}

		}

		$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>\n";

	#warn "CONDITION<$condition>\n";

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

	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/(^|\n)./$1/g;

	$stmt =~ s/^\s*//;

	$stmt =~ s/\s*$//;

	my @stmt_lines = ($stmt =~ /\n/g);

	return $#stmt_lines + 2;

}

sub statement_rawlines {

	my ($stmt) = @_;

	my @stmt_lines = ($stmt =~ /\n/g);

	return $#stmt_lines + 2;

}

sub statement_block_size {

	my ($stmt) = @_;

	$stmt =~ s/(^|\n)./$1/g;

	$stmt =~ s/^\s*{//;

	$stmt =~ s/}\s*$//;

	$stmt =~ s/^\s*//;

	$stmt =~ s/\s*$//;

	my @stmt_lines = ($stmt =~ /\n/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>\n";

	push(@chunks, [ $condition, $statement ]);

	if (!($remain > 0 && $condition =~ /^\s*(?:\n[+-])?\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>\n";

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

		#print "C: push\n";

		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>\n";

			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\n";

		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 . "\n" 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 ]\n";

	##print "CMMT: $cmt\n";

	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\n" 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)\n" if ($dbg_values > 1);

			if ($1 =~ /\n/ && $av_preprocessor) {

				$type = pop(@av_paren_type);

				$av_preprocessor = 0;

			}

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

			print "CAST($1)\n" if ($dbg_values > 1);

			push(@av_paren_type, $type);

			$type = 'C';

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

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

			$type = 'T';

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

			print "MODIFIER($1)\n" if ($dbg_values > 1);

			$type = 'T';

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

			print "DEFINE($1,$2)\n" 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)\n" if ($dbg_values > 1);

			$av_preprocessor = 1;

			push(@av_paren_type, $type);

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

			print "PRE_START($1)\n" 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)\n" 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)\n" 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 =~ /^(\\\n)/o) {

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

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

			print "ATTR($1)\n" if ($dbg_values > 1);

			$av_pending = $type;

			$type = 'N';

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

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

			if (defined $2) {

				$av_pending = 'V';

			}

			$type = 'N';

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

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

			$av_pending = 'E';

			$type = 'N';

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

			print "CASE($1)\n" if ($dbg_values > 1);

			$av_pend_colon = 'C';

			$type = 'N';

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

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

			$type = 'N';

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

			print "PAREN('$1')\n" 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\n"

							if ($dbg_values > 1);

			} else {

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

			}

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

			print "FUNC($1)\n" 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)\n" if ($dbg_values > 1);

			$type = 'V';

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

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

			$type = 'V';

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

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

			$type = 'N';

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

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

			$type = 'E';

			$av_pend_colon = 'O';

		} elsif ($cur =~/^(,)/) {