warnings.pl: script to harvest warnings directly from the source

This will make it a lot easier to create new warning categories by
inserting a block comment directly in the source code near where the
warning is used.

This block comment should look like:

     /*
      *!warning-name {on|off|err} this is a warning
      *!
      *! needs a help text.
      */
      nasm_warnf(WARN_WARNING_NAME, ...);

Signed-off-by: H. Peter Anvin (Intel) <hpa@zytor.com>

1 files changed, 184 insertions, 0 deletions

diff --git a/asm/warnings.pl b/asm/warnings.pl
new file mode 100755
index 00000000..384c18da
--- /dev/null
+++ b/asm/warnings.pl
@@ -0,0 +1,184 @@
+#!/usr/bin/perl
+
+use strict;
+use File::Find;
+use File::Basename;
+
+my @warnings = ();
+my $err = 0;
+my $nwarn = 0;
+
+sub quote_for_c($) {
+    my $s = join('', @_);
+
+    $s =~ s/([\"\'\\])/\\\1/g;
+    return $s;
+}
+
+sub find_warnings {
+    my $infile = $_;
+
+    return unless ($infile =~ /\.[ch]$/i);
+    open(my $in, '<', $infile)
+	or die "$0: cannot open input file $infile: $!\n";
+
+    my $in_comment = 0;
+    my $nline = 0;
+    my $this;
+    my @doc;
+
+    while (defined(my $l = <$in>)) {
+	$nline++;
+	chomp $l;
+
+	if (!$in_comment) {
+	    $l =~ s/^.*?\/\*.*?\*\///g; # Remove single-line comments
+
+	    if ($l =~ /^.*?(\/\*.*)$/) {
+		# Begin block comment
+		$l = $1;
+		$in_comment = 1;
+	    }
+	}
+
+	if ($in_comment) {
+	    if ($l =~ /\*\//) {
+		# End block comment
+		$in_comment = 0;
+		undef $this;
+	    } elsif ($l =~ /^\s*\/?\*\!(\s*)(.*?)\s*$/) {
+		my $ws = $1;
+		my $str = $2;
+
+		if (!defined($this) || ($ws eq '' && $str ne '')) {
+		    if ($str =~ /^(\w+)\s+(\w+)\s(.+)$/) {
+			my $name = $1;
+			my $def = $2;
+			my $help = $3;
+
+			my $cname = uc($name);
+			$cname =~ s/[^A-Z0-9_]+/_/g;
+
+			$this = {name => $name, cname => $cname,
+				 def => $def, help => $help, doc => [],
+				 file => $infile, line => $nline};
+			push(@warnings, $this);
+			$nwarn++;
+		    } else {
+			print STDERR "$infile:$nline: malformed warning definition\n";
+			print STDERR "    $l\n";
+			$err++;
+		    }
+		} else {
+		    push(@{$this->{doc}}, "$str\n");
+		}
+	    } else {
+		undef $this;
+	    }
+	}
+    }
+    close($in);
+}
+
+my($what, $outfile, @indirs) = @ARGV;
+
+if (!defined($outfile)) {
+    die "$0: usage: [c|h|doc] outfile indir...\n";
+}
+
+find({ wanted => \&find_warnings, no_chdir => 1, follow => 1 }, @indirs);
+
+exit(1) if ($err);
+
+my %sort_special = ( 'other' => 1, 'all' => 2 );
+sub sort_warnings {
+    my $an = $a->{name};
+    my $bn = $b->{name};
+    return ($sort_special{$an} <=> $sort_special{$bn}) || ($an cmp $bn);
+}
+
+@warnings = sort sort_warnings @warnings;
+my @warn_noall = @warnings;
+pop @warn_noall if ($warn_noall[$#warn_noall]->{name} eq 'all');
+
+open(my $out, '>', $outfile)
+    or die "$0: cannot open output file $outfile: $!\n";
+
+if ($what eq 'c') {
+    print $out "#include \"error.h\"\n\n";
+    printf $out "const char * const warning_names[%d] = {\n",
+	$#warnings + 2;
+    print $out "\tNULL";
+    foreach my $warn (@warnings) {
+	print $out ",\n\t\"", $warn->{name}, "\"";
+    }
+    print $out "\n};\n\n";
+    printf $out "const char * const warning_help[%d] = {\n",
+	$#warnings + 2;
+    print $out "\tNULL";
+    foreach my $warn (@warnings) {
+	my $help = quote_for_c($warn->{help});
+	print $out ",\n\t\"", $help, "\"";
+    }
+    print $out "\n};\n\n";
+    printf $out "const uint8_t warning_defaults[%d] = {\n",
+	$#warn_noall + 2;
+    print $out "\tWARN_INIT_ON"; # for entry 0
+    foreach my $warn (@warn_noall) {
+	print $out ",\n\tWARN_INIT_", uc($warn->{def});
+    }
+    print $out "\n};\n";
+} elsif ($what eq 'h') {
+    my $guard = basename($outfile);
+    $guard =~ s/[^A-Za-z0-9_]+/_/g;
+    $guard = "NASM_\U$guard";
+
+    print $out "#ifndef $guard\n";
+    print $out "#define $guard\n";
+    print $out "\n";
+    print $out "#include \"compiler.h\"\n\n";
+    print $out "enum warn_index {\n";
+    printf $out "\tWARN_IDX_%-15s = %2d", 'NONE', 0;
+    my $n = 1;
+    foreach my $warn (@warnings) {
+	printf $out ",\n\tWARN_IDX_%-15s = %2d%s    /* %s */",
+	    $warn->{cname}, $n++, $warn->{help};
+    }
+    print $out "\n};\n\n";
+
+    print $out "enum warn_const {\n";
+    printf $out "\tWARN_%-19s = %2d << WARN_SHR", 'NONE', 0;
+    my $n = 1;
+    foreach my $warn (@warn_noall) {
+	printf $out ",\n\tWARN_%-19s = %2d << WARN_SHR", $warn->{cname}, $n++;
+    }
+    print $out "\n};\n\n";
+
+    printf $out "extern const char * const warning_names[%d];\n",
+	$#warnings + 2;
+    printf $out "extern const char * const warning_help[%d];\n",
+	$#warnings + 2;
+    printf $out "extern const uint8_t warning_defaults[%d];\n",
+	$#warn_noall + 2;
+    print $out "\n#endif /* $guard */\n";
+} elsif ($what eq 'doc') {
+    my %whatdef = ( 'on' => 'Enabled',
+		    'off' => 'Disabled',
+		    'err' => 'Enabled and promoted to error' );
+    foreach my $warn (@warnings) {
+
+	my @doc = @{$warn->{doc}};
+	shift @doc while ($doc[0] =~ /^\s*$/);
+	pop @doc while ($doc[$#doc] =~ /^\s*$/);
+
+	print $out "\\b \\i\\c{", $warn->{name}, "} ", @doc;
+
+	my $docdef = $whatdef{$warn->{def}};
+	if (defined($docdef)) {
+	    print $out $docdef, " by default.\n";
+	}
+
+	print $out "\n";
+    }
+}
+close($out);