From nobody Sat Mar 25 17:22:21 2023 X-Original-To: dev-commits-src-main@mlmmj.nyi.freebsd.org Received: from mx1.freebsd.org (mx1.freebsd.org [IPv6:2610:1c1:1:606c::19:1]) by mlmmj.nyi.freebsd.org (Postfix) with ESMTP id 4PkQrM2wssz41SnZ; Sat, 25 Mar 2023 17:22:43 +0000 (UTC) (envelope-from gallatin@freebsd.org) Received: from smtp.freebsd.org (smtp.freebsd.org [96.47.72.83]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256 client-signature RSA-PSS (4096 bits) client-digest SHA256) (Client CN "smtp.freebsd.org", Issuer "R3" (verified OK)) by mx1.freebsd.org (Postfix) with ESMTPS id 4PkQrM1wfBz4LVF; Sat, 25 Mar 2023 17:22:43 +0000 (UTC) (envelope-from gallatin@freebsd.org) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=freebsd.org; s=dkim; t=1679764963; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=+jVb+6dWe3ZJlC+84lW8iDn/fiD0U9RasmjUrWjF/bQ=; b=QMhclNRsglsAc+qAFWQqoxOHU4D6jlgIWK2u/abLONZLkUe47k0dYuEkzbdYh5iivzFldo IYZPNn9aNW3ECBCOqc/CpnZSVnzUoj2+5M8n9+//onuTth1NhFGta7efAlxue+bZWFghHC /MF9xyFhPTkaPXPkccVOywpgTPJobKDdfxZ+aQF5UwRQhRtsH01diNXX0d3BL2hrXg70bU 79kQM/TM9sCjsf/dNoJ4lj37cQ2f9gvu3YhYG6UhhVnnF2tkeh+TujqkJJVYw71cm/P5Bv gnd62AsvasqIY5YzrETK4i8or1B5/A2l4N2mTAlQ24RtgoHk1K3e1A1aCpJlxw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=freebsd.org; s=dkim; t=1679764963; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=+jVb+6dWe3ZJlC+84lW8iDn/fiD0U9RasmjUrWjF/bQ=; b=caAxG3usoPoStBIHr+yH6cHl9jTXNkhQU5myU5T4BECe1bRI8YunYnJrIA0i0Iwq1KYQ3L ufuZVQDJC83Xf9Z/UVqRpS+J1hwQmqKdX6q9PiW8h1RFaNNWutAPfEYVBnrAgzHh3Be7xn qzRF5ddwz58r6mRBv8fjeiQjl0oUgENjVi2CcQajKzSCF8aTjJpkVLv4L6TQP+qIJmGgHA R/szWwSEFwlDg+Ji6YLKVQ2PJHyMLZaBbgkSrQTwpTPGkEr2o2lf+26K38Les1HS6Q/Zyc Px/Ci47mRqGakpgfRMid9ZyJU2F2QPQl88QNF8grMSXPPcb3rEaHv9lenOTTZA== ARC-Authentication-Results: i=1; mx1.freebsd.org; none ARC-Seal: i=1; s=dkim; d=freebsd.org; t=1679764963; a=rsa-sha256; cv=none; b=FxHKUzWHOgPh9JlCdg4zI2Xfm8Ru6e0f/1URKpfBCcOqFbhRnzJkYFqMxTGQqpfmaysi5i iHblHnYKOqRCDuUSSxMSnfGkqY9qg3mkpAeVlJlm1M9OBv2SH83wTXf6mp7FyqX2dMdYiq e44KCLcLl5nG8S1RKJ4HxFehDldAOWBnNjNWu42JCoIEysEqf7EcGanCn4bOyyTW0n1Hbk oPjsUOMXNOcUmnBv3sCE5G7Hp7QjCJuwsECbiy5s1us2x2OvT0Z3EJCKry8Ytt0MkuHb4U PygPfkAmaYWCvdRPadX527s5RZ728mMcwRlU0s2EBwguKka4/LasKSwJbjTaaA== Received: from auth1-smtp.messagingengine.com (auth1-smtp.messagingengine.com [66.111.4.227]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (Client did not present a certificate) (Authenticated sender: gallatin) by smtp.freebsd.org (Postfix) with ESMTPSA id 4PkQrM0pTXzZJP; Sat, 25 Mar 2023 17:22:43 +0000 (UTC) (envelope-from gallatin@freebsd.org) Received: from compute5.internal (compute5.nyi.internal [10.202.2.45]) by mailauth.nyi.internal (Postfix) with ESMTP id AC6FB27C0054; Sat, 25 Mar 2023 13:22:42 -0400 (EDT) Received: from imap51 ([10.202.2.101]) by compute5.internal (MEProxy); Sat, 25 Mar 2023 13:22:42 -0400 X-ME-Sender: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvhedrvdegkedguddtvdcutefuodetggdotefrod ftvfcurfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfgh necuuegrihhlohhuthemuceftddtnecunecujfgurhepofgfggfkjghffffhvffutgesrg dtreerreertdenucfhrhhomhepfdffrhgvficuifgrlhhlrghtihhnfdcuoehgrghllhgr thhinhesfhhrvggvsghsugdrohhrgheqnecuggftrfgrthhtvghrnhepvdefhfejledufe egfeejleetieeftdffueduvefggffffedugfeluedvkefhjeeinecuffhomhgrihhnpehf rhgvvggsshgurdhorhhgnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrg hilhhfrhhomhepghgrlhhlrghtihhnodhmvghsmhhtphgruhhthhhpvghrshhonhgrlhhi thihqddufeefheelvddvudeiqddvleehtdegudekgedqghgrlhhlrghtihhnpeepfhhrvg gvsghsugdrohhrghesfhgrshhtmhgrihhlrdgtohhm X-ME-Proxy: Feedback-ID: i41414658:Fastmail Received: by mailuser.nyi.internal (Postfix, from userid 501) id 8435AB60086; Sat, 25 Mar 2023 13:22:42 -0400 (EDT) X-Mailer: MessagingEngine.com Webmail Interface User-Agent: Cyrus-JMAP/3.9.0-alpha0-236-g06c0f70e43-fm-20230313.001-g06c0f70e List-Id: Commit messages for the main branch of the src repository List-Archive: https://lists.freebsd.org/archives/dev-commits-src-main List-Help: List-Post: List-Subscribe: List-Unsubscribe: Sender: owner-dev-commits-src-main@freebsd.org X-BeenThere: dev-commits-src-main@freebsd.org Mime-Version: 1.0 Message-Id: <5b9c31d2-4aaf-4822-b405-cae57164f314@app.fastmail.com> In-Reply-To: <202303251708.32PH8BUq079177@gitrepo.freebsd.org> References: <202303251708.32PH8BUq079177@gitrepo.freebsd.org> Date: Sat, 25 Mar 2023 13:22:21 -0400 From: "Drew Gallatin" To: "Warner Losh" , src-committers@FreeBSD.org, dev-commits-src-all@FreeBSD.org, dev-commits-src-main@FreeBSD.org Subject: Re: git: 3a3c9242739e - main - checkstyle9.pl: Perl script to check if a change is approximately style(9) Content-Type: multipart/alternative; boundary=d2b24846419d49c4ab1b06d629e431e9 X-ThisMailContainsUnwantedMimeParts: N --d2b24846419d49c4ab1b06d629e431e9 Content-Type: text/plain Thanks so much. I've wanted something like this *forever* On Sat, Mar 25, 2023, at 1:08 PM, Warner Losh wrote: > The branch main has been updated by imp: > > URL: https://cgit.FreeBSD.org/src/commit/?id=3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4 > > commit 3a3c9242739efb0c76587ffbaa54c5d10b2cbcb4 > Author: Warner Losh > AuthorDate: 2023-03-14 21:28:05 +0000 > Commit: Warner Losh > CommitDate: 2023-03-25 17:06:13 +0000 > > checkstyle9.pl: Perl script to check if a change is approximately style(9) > > This code is adapted from the QEMU checkpatch.pl script. It can check > either a patch, a file or a git branch. It tries to warn about things > that I believe might be style(9) violations. It's experimental, since I > heavily hacked on the qemu version to get it to not complain (much) > about iconic code in the tree. At the moment, it's use should be > considered expermental. It will likely miss violations, and complain > about code that's perfectly fine. It's offered as an experiment > and to make it easier for contributors to submit patches. > --- > tools/build/checkstyle9.pl | 2748 ++++++++++++++++++++++++++++++++++++++++++++ > 1 file changed, 2748 insertions(+) > > diff --git a/tools/build/checkstyle9.pl b/tools/build/checkstyle9.pl > new file mode 100755 > index 000000000000..5aec3819bf7c > --- /dev/null > +++ b/tools/build/checkstyle9.pl > @@ -0,0 +1,2748 @@ > +#!/usr/bin/env perl > +# (c) 2001, Dave Jones. (the file handling bit) > +# (c) 2005, Joel Schopp (the ugly bit) > +# (c) 2007,2008, Andy Whitcroft (new conditions, test suite) > +# (c) 2008-2010 Andy Whitcroft > +# Licensed under the terms of the GNU GPL License version 2 > + > +use strict; > +use warnings; > +use Term::ANSIColor qw(:constants); > + > +my $P = $0; > +$P =~ s@.*/@@g; > + > +our $SrcFile = qr{\.(?:h|c|cpp|s|S|pl|py|sh)$}; > + > +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 = undef; > +my $chk_branch = undef; > +my $tst_only; > +my $emacs = 0; > +my $terse = 0; > +my $file = undef; > +my $color = "auto"; > +my $no_warnings = 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]... > + $P [OPTION]... [GIT-REV-LIST] > + > +Version: $V > + > +Options: > + -q, --quiet quiet > + --patch treat FILE as patchfile > + --branch treat args as GIT revision list > + --emacs emacs compile window format > + --terse one line per report > + -f, --file treat FILE as regular source file > + --strict fail if only warnings are found > + --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 > + --color[=WHEN] Use colors 'always', 'never', or only when output > + is a terminal ('auto'). Default is 'auto'. > + -h, --help, --version display this help and exit > + > +When FILE is - read standard input. > +EOM > + > + exit($exitcode); > +} > + > +# Use at your own risk > +print "\n", MAGENTA, "WARNING:", RESET, " This code is highly experimental ... likely isn't a great style(9) match yet\n\n"; > + > +# 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, > + 'branch!' => \$chk_branch, > + 'emacs!' => \$emacs, > + 'terse!' => \$terse, > + 'f|file!' => \$file, > + 'strict!' => \$no_warnings, > + 'root=s' => \$root, > + 'summary!' => \$summary, > + 'mailback!' => \$mailback, > + 'summary-file!' => \$summary_file, > + > + 'debug=s' => \%debug, > + 'test-only=s' => \$tst_only, > + 'color=s' => \$color, > + 'no-color' => sub { $color = 'never'; }, > + '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); > +} > + > +if (!defined $chk_branch && !defined $chk_patch && !defined $file) { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0; > + $chk_patch = $chk_branch || $file ? 0 : 1; > +} elsif (!defined $chk_branch && !defined $chk_patch) { > + if ($file) { > + $chk_branch = $chk_patch = 0; > + } else { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $chk_patch = $chk_branch ? 0 : 1; > + } > +} elsif (!defined $chk_branch && !defined $file) { > + if ($chk_patch) { > + $chk_branch = $file = 0; > + } else { > + $chk_branch = $ARGV[0] =~ /.\.\./ ? 1 : 0; > + $file = $chk_branch ? 0 : 1; > + } > +} elsif (!defined $chk_patch && !defined $file) { > + if ($chk_branch) { > + $chk_patch = $file = 0; > + } else { > + $file = $ARGV[0] =~ /$SrcFile/ ? 1 : 0; > + $chk_patch = $file ? 0 : 1; > + } > +} elsif (!defined $chk_branch) { > + $chk_branch = $chk_patch || $file ? 0 : 1; > +} elsif (!defined $chk_patch) { > + $chk_patch = $chk_branch || $file ? 0 : 1; > +} elsif (!defined $file) { > + $file = $chk_patch || $chk_branch ? 0 : 1; > +} > + > +if (($chk_patch && $chk_branch) || > + ($chk_patch && $file) || > + ($chk_branch && $file)) { > + die "Only one of --file, --branch, --patch is permitted\n"; > +} > +if (!$chk_patch && !$chk_branch && !$file) { > + die "One of --file, --branch, --patch is required\n"; > +} > + > +if ($color =~ /^always$/i) { > + $color = 1; > +} elsif ($color =~ /^never$/i) { > + $color = 0; > +} elsif ($color =~ /^auto$/i) { > + $color = (-t STDOUT); > +} else { > + die "Invalid color mode: $color\n"; > +} > + > +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++; > +} > + > +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{ > + __force > + }x; > + > +# Notes to $Attribute: > +our $Attribute = qr{ > + const| > + volatile| > + QEMU_NORETURN| > + QEMU_WARN_UNUSED_RESULT| > + QEMU_SENTINEL| > + QEMU_PACKED| > + GCC_FMT_ATTR > + }x; > +our $Modifier; > +our $Inline = qr{inline}; > +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 $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; > + > +# some readers default to ISO-8859-1 when showing email source. detect > +# when UTF-8 is incorrectly interpreted as ISO-8859-1 and reencoded back. > +# False positives are possible but very unlikely. > +our $UTF8_MOJIBAKE = qr{ > + \xC3[\x82-\x9F] \xC2[\x80-\xBF] # c2-df 80-bf > + | \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF] # e0 a0-bf 80-bf > + | \xC3[\xA1-\xAC\xAE\xAF] (?: \xC2[\x80-\xBF]){2} # e1-ec/ee/ef 80-bf 80-bf > + | \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF] # ed 80-9f 80-bf > + | \xC3\xB0 \xC2[\x90-\xBF] (?: \xC2[\x80-\xBF]){2} # f0 90-bf 80-bf 80-bf > + | \xC3[\xB1-\xB3] (?: \xC2[\x80-\xBF]){3} # f1-f3 80-bf 80-bf 80-bf > + | \xC3\xB4 \xC2[\x80-\x8F] (?: \xC2[\x80-\xBF]){2} # f4 80-b8 80-bf 80-bf > +}x; > + > +# There are still some false positives, but this catches most > +# common cases. > +our $typeTypedefs = qr{(?x: > + (?![KMGTPE]iB) # IEC binary prefix (do not match) > + [A-Z][A-Z\d_]*[a-z][A-Za-z\d_]* # camelcase > + | [A-Z][A-Z\d_]*AIOCB # all uppercase > + | [A-Z][A-Z\d_]*CPU # all uppercase > + | QEMUBH # all uppercase > +)}; > + > +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}, > + qr{target_(?:u)?long}, > + qr{hwaddr}, > +); > + > +# This can be modified by sub possible. Since it can be empty, be careful > +# about regexes that always match, because they can cause infinite loops. > +our @modifierList = ( > +); > + > +sub build_types { > + my $all = "(?x: \n" . join("|\n ", @typeList) . "\n)"; > + if (@modifierList > 0) { > + my $mods = "(?x: \n" . join("|\n ", @modifierList) . "\n)"; > + $Modifier = qr{(?:$Attribute|$Sparse|$mods)}; > + } else { > + $Modifier = qr{(?:$Attribute|$Sparse)}; > + } > + $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 @rawlines = (); > +my @lines = (); > +my $vname; > +if ($chk_branch) { > + my @patches; > + my %git_commits = (); > + my $HASH; > + open($HASH, "-|", "git", "log", "--reverse", "--no-merges", "--format=%H %s", $ARGV[0]) || > + die "$P: git log --reverse --no-merges --format='%H %s' $ARGV[0] failed - $!\n"; > + > + for my $line (<$HASH>) { > + $line =~ /^([0-9a-fA-F]{40,40}) (.*)$/; > + next if (!defined($1) || !defined($2)); > + my $sha1 = $1; > + my $subject = $2; > + push(@patches, $sha1); > + $git_commits{$sha1} = $subject; > + } > + > + close $HASH; > + > + die "$P: no revisions returned for revlist '$ARGV[0]'\n" > + unless @patches; > + > + my $i = 1; > + my $num_patches = @patches; > + for my $hash (@patches) { > + my $FILE; > + open($FILE, '-|', "git", "show", "--patch-with-stat", $hash) || > + die "$P: git show $hash - $!\n"; > + while (<$FILE>) { > + chomp; > + push(@rawlines, $_); > + } > + close($FILE); > + $vname = substr($hash, 0, 12) . ' (' . $git_commits{$hash} . ')'; > + if ($num_patches > 1 && $quiet == 0) { > + my $prefix = "$i/$num_patches"; > + $prefix = BLUE . BOLD . $prefix . RESET if $color; > + print "$prefix Checking commit $vname\n"; > + $vname = "Patch $i/$num_patches"; > + } else { > + $vname = "Commit " . $vname; > + } > + if (!process($hash)) { > + $exit = 1; > + print "\n" if ($num_patches > 1 && $quiet == 0); > + } > + @rawlines = (); > + @lines = (); > + $i++; > + } > +} else { > + 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; > + } > + print "Checking $filename...\n" if @ARGV > 1 && $quiet == 0; > + 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 = ( > + "Makefile.inc1", "README.md", "sys", > + "usr.sbin" > + ); > + > + 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 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>\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); > *** 1791 LINES SKIPPED *** > --d2b24846419d49c4ab1b06d629e431e9 Content-Type: text/html Content-Transfer-Encoding: quoted-printable
Thanks so much.=   I've wanted something like this *forever*

On Sat, Mar 25, 2023, at 1:08 PM, Warner Losh wrote:
The branch main has been= updated by imp:


commit 3a3c9242739efb= 0c76587ffbaa54c5d10b2cbcb4
Author:    = Warner Losh <imp@FreeBSD.org&= gt;
AuthorDate: 2023-03-14 21:28:05 +0000
Co= mmit:     Warner Losh <imp@FreeBSD.org>
CommitDate: 2023-03-25 17= :06:13 +0000

    checkstyle9= .pl: Perl script to check if a change is approximately style(9)
    
    This cod= e is adapted from the QEMU checkpatch.pl script. It can check
<= div>    either a patch, a file or a git branch. It tries = to warn about things
    that I believe mig= ht be style(9) violations. It's experimental, since I
&nbs= p;   heavily hacked on the qemu version to get it to not compl= ain (much)
    about iconic code in the tre= e. At the moment, it's use should be
    co= nsidered expermental. It will likely miss violations, and complain
    about code that's perfectly fine.  It's= offered as an experiment
    and to make i= t easier for contributors to submit patches.
---
=
tools/build/checkstyle9.pl | 2748 +++++++++++++++++++++++++++++++++= +++++++++++
1 file changed, 2748 insertions(+)

diff --git a/tools/build/checkstyle9.pl b/tools/build/= checkstyle9.pl
new file mode 100755
index 00= 0000000000..5aec3819bf7c
--- /dev/null
+++ b= /tools/build/checkstyle9.pl
@@ -0,0 +1,2748 @@
+#!/usr/bin/env perl
+# (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
+
+us= e strict;
+use warnings;
+use Term::ANSIColo= r qw(:constants);
+
+my $P =3D $0;
=
+$P =3D~ s@.*/@@g;
+
+our $SrcFile = ;   =3D qr{\.(?:h|c|cpp|s|S|pl|py|sh)$};
+
+my $V =3D '0.31';
+
+use Getopt::L= ong qw(:config no_auto_abbrev);
+
+my $quiet= =3D 0;
+my $tree =3D 1;
+my $chk_signoff =3D= 1;
+my $chk_patch =3D undef;
+my $chk_branc= h =3D undef;
+my $tst_only;
+my $emacs =3D 0= ;
+my $terse =3D 0;
+my $file =3D undef;
=
+my $color =3D "auto";
+my $no_warnings =3D 0;<= br>
+my $summary =3D 1;
+my $mailback =3D 0;
=
+my $summary_file =3D 0;
+my $root;
+my %debug;
+my $help =3D 0;
+
<= div>+sub help {
+ my ($exitcode) =3D @_;
+
+ print << "EOM";
+Usage:
+
+    $P [OPTION]... [FILE]...
<= div>+    $P [OPTION]... [GIT-REV-LIST]
+
+Version: $V
+
+Options:
+  -q, --quiet       &nbs= p;        quiet
+ = --patch          &nbs= p;         treat FILE as patchfi= le
+  --branch      &nb= sp;            tr= eat args as GIT revision list
+  --emacs  &= nbsp;           &= nbsp;     emacs compile window format
= +  --terse         &nb= sp;          one line per r= eport
+  -f, --file     &nbs= p;           treat FIL= E as regular source file
+  --strict   = ;            = ;    fail if only warnings are found
+ = ; --no-summary         &nbs= p;     suppress the per-file summary
+=   --mailback         &= nbsp;       only produce a report in case = of warnings/errors
+  --summary-file   = ;          include the file= name in summary
+  --debug KEY=3D[0|1]  &nb= sp;       turn on/off debugging of KEY, wh= ere KEY is one of
+      &nb= sp;           &nb= sp;          'values', 'pos= sible', 'type', and 'attr' (default
+   &nb= sp;           &nb= sp;           &nb= sp; is all off)
+  --test-only=3DWORD  &nbs= p;        report only warnings/errors= containing WORD
+      &nbs= p;           &nbs= p;          literally
+  --color[=3DWHEN]      &nb= sp;      Use colors 'always', 'never', or only = when output
+       &nb= sp;           &nb= sp;         is a terminal ('auto= '). Default is 'auto'.
+  -h, --help, --version =      display this help and exit
+
<= /div>
+When FILE is - read standard input.
+EOM
+
+ exit($exitcode);
+}
+
+# Use at your own risk
+print "\n", MAG= ENTA, "WARNING:", RESET, " This code is highly experimental ... likely i= sn't a great style(9) match yet\n\n";
+
+# P= erl's Getopt::Long allows options to take optional arguments after a spa= ce.
+# Prevent --color by itself from consuming other argu= ments
+foreach (@ARGV) {
+ if ($_ eq "--colo= r" || $_ eq "-color") {
+ $_ =3D "--color=3D$color";
<= /div>
+ }
+}
+
+GetOptions= (
+ 'q|quiet+' =3D> \$quiet,
+ 'tree!' =3D= > \$tree,
+ 'signoff!' =3D> \$chk_signoff,
=
+ 'patch!' =3D> \$chk_patch,
+ 'branch!' =3D> \= $chk_branch,
+ 'emacs!' =3D> \$emacs,
+ '= terse!' =3D> \$terse,
+ 'f|file!' =3D> \$file,
+ 'strict!' =3D> \$no_warnings,
+ 'root=3Ds' =3D= > \$root,
+ 'summary!' =3D> \$summary,
+ 'mailback!' =3D> \$mailback,
+ 'summary-file!' =3D&g= t; \$summary_file,
+
+ 'debug=3Ds' =3D> \= %debug,
+ 'test-only=3Ds' =3D> \$tst_only,
+ 'color=3Ds'       =3D> \$color,
=
+ 'no-color'      =3D> sub { $col= or =3D 'never'; },
+ 'h|help' =3D> \$help,
+ 'version' =3D> \$help
+) or help(1);
= +
+help(0) if ($help);
+
+my $= exit =3D 0;
+
+if ($#ARGV < 0) {
+ print "$P: no input files\n";
+ exit(1);
=
+}
+
+if (!defined $chk_branch &&am= p; !defined $chk_patch && !defined $file) {
+ $chk= _branch =3D $ARGV[0] =3D~ /.\.\./ ? 1 : 0;
+ $file =3D $AR= GV[0] =3D~ /$SrcFile/ ? 1 : 0;
+ $chk_patch =3D $chk_branc= h || $file ? 0 : 1;
+} elsif (!defined $chk_branch &&a= mp; !defined $chk_patch) {
+ if ($file) {
+ = $chk_branch =3D $chk_patch =3D 0;
+ } else {
+ $chk_branch =3D $ARGV[0] =3D~ /.\.\./ ? 1 : 0;
+ $ch= k_patch =3D $chk_branch ? 0 : 1;
+ }
+} elsi= f (!defined $chk_branch && !defined $file) {
+ if = ($chk_patch) {
+ $chk_branch =3D $file =3D 0;
+ } else {
+ $chk_branch =3D $ARGV[0] =3D~ /.\.\./ ? 1= : 0;
+ $file =3D $chk_branch ? 0 : 1;
+ }<= br>
+} elsif (!defined $chk_patch && !defined $file) {=
+ if ($chk_branch) {
+ $chk_patch =3D $fil= e =3D 0;
+ } else {
+ $file =3D $ARGV[0] =3D= ~ /$SrcFile/ ? 1 : 0;
+ $chk_patch =3D $file ? 0 : 1;
=
+ }
+} elsif (!defined $chk_branch) {
=
+ $chk_branch =3D $chk_patch || $file ? 0 : 1;
+} els= if (!defined $chk_patch) {
+ $chk_patch =3D $chk_branch ||= $file ? 0 : 1;
+} elsif (!defined $file) {
= + $file =3D $chk_patch || $chk_branch ? 0 : 1;
+}
+
+if (($chk_patch && $chk_branch) ||
+    ($chk_patch && $file) ||
+    ($chk_branch && $file)) {
+= die "Only one of --file, --branch, --patch is permitted\n";
+}
+if (!$chk_patch && !$chk_branch && = !$file) {
+ die "One of --file, --branch, --patch is requi= red\n";
+}
+
+if ($color =3D~ = /^always$/i) {
+ $color =3D 1;
+} elsif ($co= lor =3D~ /^never$/i) {
+ $color =3D 0;
+} el= sif ($color =3D~ /^auto$/i) {
+ $color =3D (-t STDOUT);
+} else {
+ die "Invalid color mode: $color\n"= ;
+}
+
+my $dbg_values =3D 0;<= br>
+my $dbg_possible =3D 0;
+my $dbg_type =3D 0= ;
+my $dbg_attr =3D 0;
+my $dbg_adv_dcs =3D = 0;
+my $dbg_adv_checking =3D 0;
+my $dbg_adv= _apw =3D 0;
+for my $key (keys %debug) {
+ #= # no critic
+ eval "\${dbg_$key} =3D '$debug{$key}';";
=
+ die "$@" if ($@);
+}
+
+my $rpt_cleaners =3D 0;
+
+if ($terse= ) {
+ $emacs =3D 1;
+ $quiet++;
+}
+
+my $emitted_corrupt =3D 0;
=
+
+our $Ident =3D qr{
+ [A-Za-z_][A-Z= a-z\d_]*
+ (?:\s*\#\#\s*[A-Za-z_][A-Za-z\d_]*)*
+ }x;
+our $Storage =3D qr{extern|static|asmlinkage= };
+our $Sparse =3D qr{
+ __force
+ }x;
+
+# Notes to $Attribute:
+our $Attribute =3D qr{
+ const|
= + volatile|
+ QEMU_NORETURN|
+ QEMU_WA= RN_UNUSED_RESULT|
+ QEMU_SENTINEL|
+ QEM= U_PACKED|
+ GCC_FMT_ATTR
+   }x;
=
+our $Modifier;
+our $Inline =3D qr{inline};
+our $Member =3D qr{->$Ident|\.$Ident|\[[^]]*\]};
+our $Lval =3D qr{$Ident(?:$Member)*};
+
<= div>+our $Constant =3D qr{(?:[0-9]+|0x[0-9a-fA-F]+)[UL]*};
+our $Assignment =3D qr{(?:\*\=3D|/=3D|%=3D|\+=3D|-=3D|<<=3D|>= >=3D|&=3D|\^=3D|\|=3D|=3D)};
+our $Compare &nb= sp;  =3D qr{<=3D|>=3D|=3D=3D|!=3D|<|>};
+= our $Operators =3D qr{
+ <=3D|>=3D|=3D=3D|!=3D|
+ =3D>|->|<<|>>|<|>|!|~|
=
+ &&|\|\||,|\^|\+\+|--|&|\||\+|-|\*|\/|%
+   }x;
+
+our $NonptrType;
+our $Type;
+our $Declare;
+
=
+our $NON_ASCII_UTF8 =3D qr{
+ [\xC2-\xDF][\x80-\xBF]=             =    # non-overlong 2-byte
+ |  \xE0[\xA0-\xB= F][\x80-\xBF]        # excluding over= longs
+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straig= ht 3-byte
+ |  \xED[\x80-\x9F][\x80-\xBF]  =       # excluding surrogates
+ |&= nbsp; \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3=
+ | [\xF1-\xF3][\x80-\xBF]{3}    &nbs= p;     # planes 4-15
+ |  \xF4[\x= 80-\x8F][\x80-\xBF]{2}     # plane 16
= +}x;
+
+our $UTF8 =3D qr{
+ [\= x09\x0A\x0D\x20-\x7E]        &nb= sp;     # ASCII
+ | $NON_ASCII_UTF8
+}x;
+
+# some readers default t= o ISO-8859-1 when showing email source. detect
+# when UTF= -8 is incorrectly interpreted as ISO-8859-1 and reencoded back.
+# False positives are possible but very unlikely.
+= our $UTF8_MOJIBAKE =3D qr{
+ \xC3[\x82-\x9F] \xC2[\x80-\xB= F]           &nbs= p;        # c2-df 80-bf
+ | \xC3\xA0 \xC2[\xA0-\xBF] \xC2[\x80-\xBF]    &nb= sp;    # e0 a0-bf 80-bf
+ | \xC3[\xA1-\xAC\= xAE\xAF] (?: \xC2[\x80-\xBF]){2}  # e1-ec/ee/ef 80-bf 80-bf
+ | \xC3\xAD \xC2[\x80-\x9F] \xC2[\x80-\xBF]   &nb= sp;     # ed 80-9f 80-bf
+ | \xC3\xB0 = \xC2[\x90-\xBF] (?: \xC2[\x80-\xBF]){2} # f0 90-bf 80-bf 80-bf
=
+ | \xC3[\xB1-\xB3] (?: \xC2[\x80-\xBF]){3}    =       # f1-f3 80-bf 80-bf 80-bf
+= | \xC3\xB4 \xC2[\x80-\x8F] (?: \xC2[\x80-\xBF]){2} # f4 80-b8 80-bf 80-= bf
+}x;
+
+# There are still s= ome false positives, but this catches most
+# common cases= .
+our $typeTypedefs =3D qr{(?x:
+ &nbs= p;      (?![KMGTPE]iB)    &= nbsp;           &= nbsp;     # IEC binary prefix (do not match)
+        [A-Z][A-Z\d_]*[a-z][A= -Za-z\d_]*     # camelcase
+ &nbs= p;      | [A-Z][A-Z\d_]*AIOCB   =             # all= uppercase
+        | [= A-Z][A-Z\d_]*CPU         &n= bsp;       # all uppercase
+=         | QEMUBH   &nb= sp;           &nb= sp;            # = all uppercase
+)};
+
+our @typ= eList =3D (
+ qr{void},
+ qr{(?:unsigned\s+)= ?char},
+ qr{(?:unsigned\s+)?short},
+ qr{(?= :unsigned\s+)?int},
+ qr{(?:unsigned\s+)?long},
<= div>+ qr{(?:unsigned\s+)?long\s+int},
+ qr{(?:unsigned\s+)= ?long\s+long},
+ qr{(?:unsigned\s+)?long\s+long\s+int},
+ qr{unsigned},
+ qr{float},
+ q= r{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},
+ qr{target_(?:u)?= long},
+ qr{hwaddr},
+);
+
=
+# This can be modified by sub possible.  Since it can b= e empty, be careful
+# about regexes that always match, be= cause they can cause infinite loops.
+our @modifierList =3D= (
+);
+
+sub build_types {
+ my $all =3D "(?x:  \n" . join("|\n  ", @typeList= ) . "\n)";
+ if (@modifierList > 0) {
+ = my $mods =3D "(?x:  \n" . join("|\n  ", @modifierList) . "\n)"= ;
+ $Modifier =3D qr{(?:$Attribute|$Sparse|$mods)};
+ } else {
+ $Modifier =3D qr{(?:$Attribute|$Spa= rse)};
+ }
+ $NonptrType =3D qr{
+ (?:$Modifier\s+|const\s+)*
+ (?:
+ = (?:typeof|__typeof__)\s*\(\s*\**\s*$Ident\s*\)|
+ (?= :$typeTypedefs\b)|
+ (?:${all}\b)
+ )
+ (?:\s+$Modifier|\s+const)*
+   }x;<= br>
+ $Type =3D qr{
+ $NonptrType
+ (?:[\s\*]+\s*const|[\s\*]+|(?:\s*\[\s*\])+)?
+ (?:= \s+$Inline|\s+$Modifier)*
+   }x;
+ $D= eclare =3D qr{(?:$Storage\s+)?$Type};
+}
+bu= ild_types();
+
+$chk_signoff =3D 0 if ($file= );
+
+my @rawlines =3D ();
+my= @lines =3D ();
+my $vname;
+if ($chk_branch= ) {
+ my @patches;
+ my %git_commits =3D ();=
+ my $HASH;
+ open($HASH, "-|", "git", "log= ", "--reverse", "--no-merges", "--format=3D%H %s", $ARGV[0]) ||
+ die "$P: git log --reverse --no-merges --format=3D'%H %s' $ARGV= [0] failed - $!\n";
+
+ for my $line (<$H= ASH>) {
+ $line =3D~ /^([0-9a-fA-F]{40,40}) (.*)$/;
+ next if (!defined($1) || !defined($2));
+ = my $sha1 =3D $1;
+ my $subject =3D $2;
+ p= ush(@patches, $sha1);
+ $git_commits{$sha1} =3D $subject;=
+ }
+
+ close $HASH;
+
+ die "$P: no revisions returned for revlist '$ARG= V[0]'\n"
+     unless @patches;
+
+ my $i =3D 1;
+ my $num_patches =3D @p= atches;
+ for my $hash (@patches) {
+ my $F= ILE;
+ open($FILE, '-|', "git", "show", "--patch-with-sta= t", $hash) ||
+ die "$P: git show $hash - $!\n";
+ while (<$FILE>) {
+ chomp;
+ push(@rawlines, $_);
+ }
+ close($FIL= E);
+ $vname =3D substr($hash, 0, 12) . ' (' . $git_commi= ts{$hash} . ')';
+ if ($num_patches > 1 && $qu= iet =3D=3D 0) {
+ my $prefix =3D "$i/$num_patches";
<= /div>
+ $prefix =3D BLUE . BOLD . $prefix . RESET if $color;
+ print "$prefix Checking commit $vname\n";
+ = $vname =3D "Patch $i/$num_patches";
+ } else {
=
+ $vname =3D "Commit " . $vname;
+ }
+ if (!process($hash)) {
+ $exit =3D 1;
= + print "\n" if ($num_patches > 1 && $quiet =3D=3D 0);
<= /div>
+ }
+ @rawlines =3D ();
+ @line= s =3D ();
+ $i++;
+ }
+} else= {
+ 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 =3D 'Your patch';
+ } else {
+ $vname =3D $filename;
+ }
+ print "Checking $filename...\n" if @ARGV > 1= && $quiet =3D=3D 0;
+ while (<$FILE>) {
+ chomp;
+ push(@rawlines, $_);
<= div>+ }
+ close($FILE);
+ if (!process($f= ilename)) {
+ $exit =3D 1;
+ }
<= div>+ @rawlines =3D ();
+ @lines =3D ();
+= }
+}
+
+exit($exit);
+
+sub top_of_kernel_tree {
+ my ($roo= t) =3D @_;
+
+ my @tree_check =3D (
+     "Makefile.inc1", "README.md", "sys",
+     "usr.sbin"
+ );
+=
+ foreach my $check (@tree_check) {
+ if (= ! -e $root . '/' . $check) {
+ return 0;
+= }
+ }
+ return 1;
+}
+
+sub expand_tabs {
+ my ($str) =3D = @_;
+
+ my $res =3D '';
+ my $= n =3D 0;
+ for my $c (split(//, $str)) {
+ = if ($c eq "\t") {
+ $res .=3D ' ';
+ $n+= +;
+ for (; ($n % 8) !=3D 0; $n++) {
+ = $res .=3D ' ';
+ }
+ next;
+ }
+ $res .=3D $c;
+ $n++;
+ }
+
+ return $res;
+}
<= /div>
+sub copy_spacing {
+ (my $res =3D shift) =3D~ t= r/\t/ /c;
+ return $res;
+}
+<= br>
+sub line_stats {
+ my ($line) =3D @_;
+
+ # Drop the diff line leader and expand tabs
+ $line =3D~ s/^.//;
+ $line =3D expand_tabs(= $line);
+
+ # Pick the indent from the front= of the line.
+ my ($white) =3D ($line =3D~ /^(\s*)/);
=
+
+ return (length($line), length($white));
=
+}
+
+my $sanitise_quote =3D '';<= br>
+
+sub sanitise_line_reset {
+= my ($in_comment) =3D @_;
+
+ if ($in_commen= t) {
+ $sanitise_quote =3D '*/';
+ } else {=
+ $sanitise_quote =3D '';
+ }
+}
+sub sanitise_line {
+ my ($line) =3D @= _;
+
+ my $res =3D '';
+ my $l= =3D '';
+
+ my $qlen =3D 0;
+= my $off =3D 0;
+ my $c;
+
+ #= Always copy over the diff marker.
+ $res =3D substr($line= , 0, 1);
+
+ for ($off =3D 1; $off < leng= th($line); $off++) {
+ $c =3D substr($line, $off, 1);
=
+
+ # Comments we are wacking completely inclu= ding the begin
+ # and end, all to $;.
+ i= f ($sanitise_quote eq '' && substr($line, $off, 2) eq '/*') {
+ $sanitise_quote =3D '*/';
+
= + substr($res, $off, 2, "$;$;");
+ $off++;
+ next;
+ }
+ if ($sanitise_quote eq = '*/' && substr($line, $off, 2) eq '*/') {
+ $san= itise_quote =3D '';
+ substr($res, $off, 2, "$;$;");
=
+ $off++;
+ next;
+ }
+ if ($sanitise_quote eq '' && substr($line, $off, 2) e= q '//') {
+ $sanitise_quote =3D '//';
+
+ substr($res, $off, 2, $sanitise_quote);
+ = $off++;
+ next;
+ }
+
=
+ # A \ in a string means ignore the next character.
+ if (($sanitise_quote eq "'" || $sanitise_quote eq '"') &&a= mp;
+     $c eq "\\") {
+ = substr($res, $off, 2, 'XX');
+ $off++;
+ = next;
+ }
+ # Regular quotes.
+ if ($c eq "'" || $c eq '"') {
+ if ($sanitise_quot= e eq '') {
+ $sanitise_quote =3D $c;
+
+ substr($res, $off, 1, $c);
+ next;
=
+ } elsif ($sanitise_quote eq $c) {
+ $san= itise_quote =3D '';
+ }
+ }
+
+ #print "c<$c> SQ<$sanitise_quote>\n";
+ if ($off !=3D 0 && $sanitise_quote eq '*/' &&= amp; $c ne "\t") {
+ substr($res, $off, 1, $;);
+ } elsif ($off !=3D 0 && $sanitise_quote eq '//' &&a= mp; $c ne "\t") {
+ substr($res, $off, 1, $;);
=
+ } elsif ($off !=3D 0 && $sanitise_quote && $c ne= "\t") {
+ substr($res, $off, 1, 'X');
+ = } else {
+ substr($res, $off, 1, $c);
+ }=
+ }
+
+ if ($sanitise_quote e= q '//') {
+ $sanitise_quote =3D '';
+ }
=
+
+ # The pathname on a #include may be surroun= ded by '<' and '>'.
+ if ($res =3D~ /^.\s*\#\s*inclu= de\s+\<(.*)\>/) {
+ my $clean =3D 'X' x length($1);=
+ $res =3D~ s@\<.*\>@<$clean>@;
+
+ # The whole of a #error is a string.
+= } elsif ($res =3D~ /^.\s*\#\s*(?:error|warning)\s+(.*)\b/) {
<= div>+ my $clean =3D 'X' x length($1);
+ $res =3D~ s@(\#\= s*(?:error|warning)\s+).*@$1$clean@;
+ }
+
+ return $res;
+}
+
+sub ctx_statement_block {
+ my ($linenr, $remain, $off= ) =3D @_;
+ my $line =3D $linenr - 1;
+ my $= blk =3D '';
+ my $soff =3D $off;
+ my $coff = =3D $off - 1;
+ my $coff_set =3D 0;
+
+ my $loff =3D 0;
+
+ my $type =3D '= ';
+ my $level =3D 0;
+ my @stack =3D ();
+ my $p;
+ my $c;
+ my $len =3D = 0;
+
+ my $remainder;
+ while = (1) {
+ @stack =3D (['', 0]) if ($#stack =3D=3D -1);
<= /div>
+
+ #warn "CSB: blk<$blk> remain<$rema= in>\n";
+ # If we are about to drop off the end, pull = in more
+ # context.
+ if ($off >=3D $l= en) {
+ for (; $remain > 0; $line++) {
= + last if (!defined $lines[$line]);
+ next if ($line= s[$line] =3D~ /^-/);
+ $remain--;
+ $l= off =3D $len;
+ $blk .=3D $lines[$line] . "\n";
+ $len =3D length($blk);
+ $line++;
=
+ last;
+ }
+ # Bail if there is= no further context.
+ #warn "CSB: blk<$blk> off&l= t;$off> len<$len>\n";
+ if ($off >=3D $len) = {
+ last;
+ }
+ }
+ $p =3D $c;
+ $c =3D substr($blk, $off, 1);
=
+ $remainder =3D substr($blk, $off);
+
+ #warn "CSB: c<$c> type<$type> level<$level> = remainder<$remainder> coff_set<$coff_set>\n";
= +
+ # Handle nested #if/#else.
+ if ($rema= inder =3D~ /^#\s*(?:ifndef|ifdef|if)\s/) {
+ push(@stack= , [ $type, $level ]);
+ } elsif ($remainder =3D~ /^#\s*(?= :else|elif)\b/) {
+ ($type, $level) =3D @{$stack[$#stack= - 1]};
+ } elsif ($remainder =3D~ /^#\s*endif\b/) {
<= /div>
+ ($type, $level) =3D @{pop(@stack)};
+ }
=
+
+ # Statement ends at the ';' or a close '}'= at the
+ # outermost level.
+ if ($level = =3D=3D 0 && $c eq ';') {
+ last;
+= }
+
+ # An else is really a conditional a= s long as its not else if
+ if ($level =3D=3D 0 &&= ; $coff_set =3D=3D 0 &&
+ (!defined($p) || $p =3D= ~ /(?:\s|\}|\+)/) &&
+ $remainder =3D~ /^(else)= (?:\s|{)/ &&
+ $remainder !~ /^else\s+if\b/) {<= br>
+ $coff =3D $off + length($1) - 1;
+ $co= ff_set =3D 1;
+ #warn "CSB: mark coff<$coff> soff&= lt;$soff> 1<$1>\n";
+ #warn "[" . substr($blk, = $soff, $coff - $soff + 1) . "]\n";
+ }
+
+ if (($type eq '' || $type eq '(') && $c eq '(') {=
+ $level++;
+ $type =3D '(';
<= div>+ }
+ if ($type eq '(' && $c eq ')') {
+ $level--;
+ $type =3D ($level !=3D 0)? '(' = : '';
+
+ if ($level =3D=3D 0 && $= coff < $soff) {
+ $coff =3D $off;
+ = $coff_set =3D 1;
+ #warn "CSB: mark coff<$coff>\= n";
+ }
+ }
+ if (($type e= q '' || $type eq '{') && $c eq '{') {
+ $level++= ;
+ $type =3D '{';
+ }
+ i= f ($type eq '{' && $c eq '}') {
+ $level--;
<= /div>
+ $type =3D ($level !=3D 0)? '{' : '';
+
+ if ($level =3D=3D 0) {
+ if (substr($blk, = $off + 1, 1) eq ';') {
+ $off++;
+ }<= br>
+ last;
+ }
+ }
+ $off++;
+ }
+ # We are truly at the= end, so shuffle to the next line.
+ if ($off =3D=3D $len)= {
+ $loff =3D $len + 1;
+ $line++;
+ $remain--;
+ }
+
+ = my $statement =3D substr($blk, $soff, $off - $soff + 1);
+= my $condition =3D 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);
+}
<= /div>
+
+sub statement_lines {
+ my ($st= mt) =3D @_;
+
+ # Strip the diff line prefix= es and rip blank lines at start and end.
+ $stmt =3D~ s/(^= |\n)./$1/g;
+ $stmt =3D~ s/^\s*//;
+ $stmt =3D= ~ s/\s*$//;
+
+ my @stmt_lines =3D ($stmt =3D= ~ /\n/g);
+
+ return $#stmt_lines + 2;
+}
+
+sub statement_rawlines {
<= /div>
+ my ($stmt) =3D @_;
+
+ my @stmt_= lines =3D ($stmt =3D~ /\n/g);
+
+ return $#s= tmt_lines + 2;
+}
+
+sub state= ment_block_size {
+ my ($stmt) =3D @_;
+
=
+ $stmt =3D~ s/(^|\n)./$1/g;
+ $stmt =3D~ s/^\s= *\{//;
+ $stmt =3D~ s/}\s*$//;
+ $stmt =3D~ = s/^\s*//;
+ $stmt =3D~ s/\s*$//;
+
=
+ my @stmt_lines =3D ($stmt =3D~ /\n/g);
+ my @stmt_s= tatements =3D ($stmt =3D~ /;/g);
+
+ my $stm= t_lines =3D $#stmt_lines + 2;
+ my $stmt_statements =3D $#= stmt_statements + 1;
+
+ if ($stmt_lines >= ; $stmt_statements) {
+ return $stmt_lines;
+ } else {
+ return $stmt_statements;
+ }<= br>
+}
+
+sub ctx_statement_full {=
+ my ($linenr, $remain, $off) =3D @_;
+ my = ($statement, $condition, $level);
+
+ my (@c= hunks);
+
+ # Grab the first conditional/blo= ck pair.
+ ($statement, $condition, $linenr, $remain, $off= , $level) =3D
+ ctx_statement_block($linenr, $remain, $= off);
+ #print "F: c<$condition> s<$statement>= remain<$remain>\n";
+ push(@chunks, [ $condition, $= statement ]);
+ if (!($remain > 0 && $condition= =3D~ /^\s*(?:\n[+-])?\s*(?:if|else|do)\b/s)) {
+ return = ($level, $linenr, @chunks);
+ }
+
<= div>+ # Pull in the following conditional/block pairs and see if they
+ # could continue the statement.
+ for (;;) {=
+ ($statement, $condition, $linenr, $remain, $off, $leve= l) =3D
+ ctx_statement_block($linenr, $remain, $off);
+ #print "C: c<$condition> s<$statement> remai= n<$remain>\n";
+ last if (!($remain > 0 &&am= p; $condition =3D~ /^(?:\s*\n[+-])*\s*(?:else|do)\b/s));
+= #print "C: push\n";
+ push(@chunks, [ $condition, $stat= ement ]);
+ }
+
+ return ($lev= el, $linenr, @chunks);
+}
+
+s= ub ctx_block_get {
+ my ($linenr, $remain, $outer, $open, = $close, $off) =3D @_;
+ my $line;
+ my $star= t =3D $linenr - 1;
+ my $blk =3D '';
+ my @o= ;
+ my @c;
+ my @res =3D ();
+=
+ my $level =3D 0;
+ my @stack =3D ($level)= ;
+ for ($line =3D $start; $remain > 0; $line++) {
<= /div>
+ next if ($rawlines[$line] =3D~ /^-/);
+ $rem= ain--;
+
+ $blk .=3D $rawlines[$line];
<= /div>
+
+ # Handle nested #if/#else.
+ = if ($lines[$line] =3D~ /^.\s*#\s*(?:ifndef|ifdef|if)\s/) {
+ push(@stack, $level);
+ } elsif ($lines[$line] =3D~= /^.\s*#\s*(?:else|elif)\b/) {
+ $level =3D $stack[$#sta= ck - 1];
+ } elsif ($lines[$line] =3D~ /^.\s*#\s*endif\b/= ) {
+ $level =3D pop(@stack);
+ }
+
+ foreach my $c (split(//, $lines[$line])) {
=
+ ##print "C<$c>L<$level><$open$close>O&l= t;$off>\n";
+ if ($off > 0) {
+ $= off--;
+ next;
+ }
+
<= /div>
+ if ($c eq $close && $level > 0) {
+ $level--;
+ last if ($level =3D=3D 0);
<= div>+ } elsif ($c eq $open) {
+ $level++;
+ }
+ }
+
+ if (!$outer= || $level <=3D 1) {
+ push(@res, $rawlines[$line]);<= br>
+ }
+
+ last if ($level =3D=3D= 0);
+ }
+
+ return ($level, @= res);
+}
+sub ctx_block_outer {
+ my ($linenr, $remain) =3D @_;
+
+ my ($l= evel, @r) =3D ctx_block_get($linenr, $remain, 1, '{', '}', 0);
=
+ return @r;
+}
+sub ctx_block {
+ my ($linenr, $remain) =3D @_;
+
+ = my ($level, @r) =3D ctx_block_get($linenr, $remain, 0, '{', '}', 0);
=
+ return @r;
+}
+sub ctx_statemen= t {
+ my ($linenr, $remain, $off) =3D @_;
+<= br>
+ my ($level, @r) =3D ctx_block_get($linenr, $remain, 0, '= (', ')', $off);
+ return @r;
+}
+sub ctx_block_level {
+ my ($linenr, $remain) =3D @_;
+
+ return ctx_block_get($linenr, $remain, 0,= '{', '}', 0);
+}
+sub ctx_statement_level {=
+ my ($linenr, $remain, $off) =3D @_;
+
=
+ return ctx_block_get($linenr, $remain, 0, '(', ')', $off);<= br>
+}
+
+sub ctx_locate_comment {=
+ my ($first_line, $end_line) =3D @_;
+
=
+ # Catch a comment on the end of the line itself.
<= div>+ my ($current_comment) =3D ($rawlines[$end_line - 1] =3D~ m@.*(/\*.= *\*/)\s*(?:\\\s*)?$@);
+ return $current_comment if (defin= ed $current_comment);
+
+ # Look through the= context and try and figure out if there is a
+ # comment.=
+ my $in_comment =3D 0;
+ $current_comment = =3D '';
+ for (my $linenr =3D $first_line; $linenr < $e= nd_line; $linenr++) {
+ my $line =3D $rawlines[$linenr - = 1];
+ #warn "       &n= bsp;   $line\n";
+ if ($linenr =3D=3D $first_li= ne and $line =3D~ m@^.\s*\*@) {
+ $in_comment =3D 1;
=
+ }
+ if ($line =3D~ m@/\*@) {
= + $in_comment =3D 1;
+ }
+ if (!$in_comm= ent && $current_comment ne '') {
+ $current_comm= ent =3D '';
+ }
+ $current_comment .=3D $l= ine . "\n" if ($in_comment);
+ if ($line =3D~ m@\*/@) {
+ $in_comment =3D 0;
+ }
+ }=
+
+ chomp($current_comment);
= + return($current_comment);
+}
+sub ctx_has_= comment {
+ my ($first_line, $end_line) =3D @_;
<= div>+ my $cmt =3D ctx_locate_comment($first_line, $end_line);
<= div>+
+ ##print "LINE: $rawlines[$end_line - 1 ]\n";
+ ##print "CMMT: $cmt\n";
+
+ retur= n ($cmt ne '');
+}
+
+sub raw_= line {
+ my ($linenr, $cnt) =3D @_;
+
+ my $offset =3D $linenr - 1;
+ $cnt++;
<= div>+
+ my $line;
+ while ($cnt) {
=
+ $line =3D $rawlines[$offset++];
+ next if (define= d($line) && $line =3D~ /^-/);
+ $cnt--;
=
+ }
+
+ return $line;
+}<= br>
+
+sub cat_vet {
+ my ($vet) =3D= @_;
+ my ($res, $coded);
+
+ = $res =3D '';
+ while ($vet =3D~ /([^[:cntrl:]]*)([[:cntrl:= ]]|$)/g) {
+ $res .=3D $1;
+ if ($2 ne '')= {
+ $coded =3D sprintf("^%c", unpack('C', $2) + 64);
+ $res .=3D $coded;
+ }
+ }
+ $res =3D~ s/$/\$/;
+
+ return= $res;
+}
+
+my $av_preprocess= or =3D 0;
+my $av_pending;
+my @av_paren_typ= e;
+my $av_pend_colon;
+
+sub = annotate_reset {
+ $av_preprocessor =3D 0;
+= $av_pending =3D '_';
+ @av_paren_type =3D ('E');
+ $av_pend_colon =3D 'O';
+}
+
+sub annotate_values {
+ my ($stream, $type) =3D @_= ;
+
+ my $res;
+ my $var =3D '= _' x length($stream);
+ my $cur =3D $stream;
+
+ print "$stream\n" if ($dbg_values > 1);
<= div>+
+ while (length($cur)) {
+ @av_paren_= type =3D ('E') if ($#av_paren_type < 0);
+ print " <= ;" . join('', @av_paren_type) .
+ "> <$type> &= lt;$av_pending>" if ($dbg_values > 1);
+ if ($cur =3D= ~ /^(\s+)/o) {
+ print "WS($1)\n" if ($dbg_values > 1= );
+ if ($1 =3D~ /\n/ && $av_preprocessor) {
=
+ $type =3D pop(@av_paren_type);
+ $av_pr= eprocessor =3D 0;
+ }
+
+ }= elsif ($cur =3D~ /^(\(\s*$Type\s*)\)/ && $av_pending eq '_') {<= br>
+ print "CAST($1)\n" if ($dbg_values > 1);
<= div>+ push(@av_paren_type, $type);
+ $type =3D 'C';
+
+ } elsif ($cur =3D~ /^($Type)\s*(?:$Ident|= ,|\)|\(|\s*$)/) {
+ print "DECLARE($1)\n" if ($dbg_value= s > 1);
+ $type =3D 'T';
+
+ } elsif ($cur =3D~ /^($Modifier)\s*/) {
+ print "MO= DIFIER($1)\n" if ($dbg_values > 1);
+ $type =3D 'T';<= br>
+
+ } elsif ($cur =3D~ /^(\#\s*define\s*$Id= ent)(\(?)/o) {
+ print "DEFINE($1,$2)\n" if ($dbg_values= > 1);
*** 1791 LINES SKIPPED ***


--d2b24846419d49c4ab1b06d629e431e9--