asm/warnings.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use File::Find;
   5 use File::Basename;
   6
   7 my @warnings = ();
   8 my %aliases  = ();
   9 my %prefixes = ();
  10 my $err = 0;
  11 my $nwarn = 0;
  12
  13 sub quote_for_c($) {
  14     my $s = join('', @_);
  15
  16     $s =~ s/([\"\'\\])/\\$1/g;
  17     return $s;
  18 }
  19
  20 sub add_alias($$) {
  21     my($a, $this) = @_;
  22     my @comp = split(/-/, $a);
  23
  24     $aliases{$a} = $this;
  25
  26     # All names are prefixes in their own right, although we only
  27     # list the ones that are either prefixes of "proper names" or
  28     # the complete alias name.
  29     for (my $i = ($a eq $this->{name}) ? 0 : $#comp; $i <= $#comp; $i++) {
  30         my $prefix = join('-', @comp[0..$i]);
  31         $prefixes{$prefix} = [] unless defined($prefixes{$prefix});
  32         push(@{$prefixes{$prefix}}, $a);
  33     }
  34 }
  35
  36 sub find_warnings {
  37     my $infile = $_;
  38
  39     return unless (basename($infile) =~ /^\w.*\.[ch]$/i);
  40     open(my $in, '<', $infile)
  41         or die "$0: cannot open input file $infile: $!\n";
  42
  43     my $in_comment = 0;
  44     my $nline = 0;
  45     my $this;
  46     my @doc;
  47
  48     while (defined(my $l = <$in>)) {
  49         $nline++;
  50         chomp $l;
  51
  52         if (!$in_comment) {
  53             $l =~ s/^.*?\/\*.*?\*\///g; # Remove single-line comments
  54
  55             if ($l =~ /^.*?(\/\*.*)$/) {
  56                 # Begin block comment
  57                 $l = $1;
  58                 $in_comment = 1;
  59             }
  60         }
  61
  62         if ($in_comment) {
  63             if ($l =~ /\*\//) {
  64                 # End block comment
  65                 $in_comment = 0;
  66                 undef $this;
  67             } elsif ($l =~ /^\s*\/?\*\!(\-|\=|\s*)(.*?)\s*$/) {
  68                 my $opr = $1;
  69                 my $str = $2;
  70
  71                 if ($opr eq '' && $str eq '') {
  72                     next;
  73                 } elsif ((!defined($this) || ($opr eq '')) &&
  74                          ($str =~ /^([\w\-]+)\s+\[(\w+)\]\s(.*\S)\s*$/)) {
  75                     my $name = $1;
  76                     my $def = $2;
  77                     my $help = $3;
  78
  79                     my $cname = uc($name);
  80                     $cname =~ s/[^A-Z0-9_]+/_/g;
  81
  82                     $this = {name => $name, cname => $cname,
  83                              def => $def, help => $help,
  84                              doc => [], file => $infile, line => $nline};
  85
  86                     if (defined(my $that = $aliases{$name})) {
  87                         # Duplicate defintion?!
  88                         printf STDERR "%s:%s: warning %s previously defined at %s:%s\n",
  89                             $infile, $nline, $name, $that->{file}, $that->{line};
  90                     } else {
  91                         push(@warnings, $this);
  92                         # Every warning name is also a valid warning alias
  93                         add_alias($name, $this);
  94                         $nwarn++;
  95                     }
  96                 } elsif ($opr eq '=') {
  97                     # Alias names for warnings
  98                     for my $a (split(/,+/, $str)) {
  99                         add_alias($a, $this);
 100                     }
 101                 } elsif ($opr =~ /^[\-\s]/) {
 102                     push(@{$this->{doc}}, "$str\n");
 103                 } else {
 104                     print STDERR "$infile:$nline: malformed warning definition\n";
 105                     print STDERR "    $l\n";
 106                     $err++;
 107                 }
 108             } else {
 109                 undef $this;
 110             }
 111         }
 112     }
 113     close($in);
 114 }
 115
 116 my($what, $outfile, @indirs) = @ARGV;
 117
 118 if (!defined($outfile)) {
 119     die "$0: usage: [c|h|doc] outfile indir...\n";
 120 }
 121
 122 find({ wanted => \&find_warnings, no_chdir => 1, follow => 1 }, @indirs);
 123
 124 exit(1) if ($err);
 125
 126 my %sort_special = ( 'other' => 1, 'all' => 2 );
 127 sub sort_warnings {
 128     my $an = $a->{name};
 129     my $bn = $b->{name};
 130     return ($sort_special{$an} <=> $sort_special{$bn}) || ($an cmp $bn);
 131 }
 132
 133 @warnings = sort sort_warnings @warnings;
 134 my @warn_noall = @warnings;
 135 pop @warn_noall if ($warn_noall[$#warn_noall]->{name} eq 'all');
 136
 137 open(my $out, '>', $outfile)
 138     or die "$0: cannot open output file $outfile: $!\n";
 139
 140 if ($what eq 'c') {
 141     print $out "#include \"error.h\"\n\n";
 142     printf $out "const char * const warning_name[%d] = {\n",
 143         $#warnings + 2;
 144     print $out "\tNULL";
 145     foreach my $warn (@warnings) {
 146         print $out ",\n\t\"", $warn->{name}, "\"";
 147     }
 148     print $out "\n};\n\n";
 149     printf $out "const struct warning_alias warning_alias[%d] = {",
 150         scalar(keys %aliases);
 151     my $sep = '';
 152     foreach my $alias (sort { $a cmp $b } keys(%aliases)) {
 153         printf $out "%s\n\t{ %-27s WARN_IDX_%s }",
 154             $sep, "\"$alias\",", $aliases{$alias}->{cname};
 155         $sep = ',';
 156     }
 157     print $out "\n};\n\n";
 158
 159     printf $out "const char * const warning_help[%d] = {\n",
 160         $#warnings + 2;
 161     print $out "\tNULL";
 162     foreach my $warn (@warnings) {
 163         my $help = quote_for_c($warn->{help});
 164         print $out ",\n\t\"", $help, "\"";
 165     }
 166     print $out "\n};\n\n";
 167     printf $out "const uint8_t warning_default[%d] = {\n",
 168         $#warn_noall + 2;
 169     print $out "\tWARN_INIT_ON"; # for entry 0
 170     foreach my $warn (@warn_noall) {
 171         print $out ",\n\tWARN_INIT_", uc($warn->{def});
 172     }
 173     print $out "\n};\n\n";
 174     printf $out "uint8_t warning_state[%d];\t/* Current state */\n",
 175         $#warn_noall + 2;
 176 } elsif ($what eq 'h') {
 177     my $filename = basename($outfile);
 178     my $guard = $filename;
 179     $guard =~ s/[^A-Za-z0-9_]+/_/g;
 180     $guard = "NASM_\U$guard";
 181
 182     print $out "#ifndef $guard\n";
 183     print $out "#define $guard\n";
 184     print $out "\n";
 185     print $out "#ifndef WARN_SHR\n";
 186     print $out "# error \"$filename should only be included from within error.h\"\n";
 187     print $out "#endif\n\n";
 188     print $out "enum warn_index {\n";
 189     printf $out "\tWARN_IDX_%-23s = %3d, /* not suppressible */\n", 'NONE', 0;
 190     my $n = 1;
 191     foreach my $warn (@warnings) {
 192         printf $out "\tWARN_IDX_%-23s = %3d%s /* %s */\n",
 193             $warn->{cname}, $n,
 194             ($n == $#warnings + 1) ? " " : ",",
 195             $warn->{help};
 196         $n++;
 197     }
 198     print $out "};\n\n";
 199
 200     print $out "enum warn_const {\n";
 201     printf $out "\tWARN_%-27s = %3d << WARN_SHR", 'NONE', 0;
 202     $n = 1;
 203     foreach my $warn (@warn_noall) {
 204         printf $out ",\n\tWARN_%-27s = %3d << WARN_SHR", $warn->{cname}, $n++;
 205     }
 206     print $out "\n};\n\n";
 207
 208     print $out "struct warning_alias {\n";
 209     print $out "\tconst char *name;\n";
 210     print $out "\tenum warn_index warning;\n";
 211     print $out "};\n\n";
 212     printf $out "#define NUM_WARNING_ALIAS %d\n", scalar(keys %aliases);
 213
 214     printf $out "extern const char * const warning_name[%d];\n",
 215         $#warnings + 2;
 216     printf $out "extern const char * const warning_help[%d];\n",
 217         $#warnings + 2;
 218     print $out "extern const struct warning_alias warning_alias[NUM_WARNING_ALIAS];\n";
 219     printf $out "extern const uint8_t warning_default[%d];\n",
 220         $#warn_noall + 2;
 221     printf $out "extern uint8_t warning_state[%d];\n",
 222         $#warn_noall + 2;
 223     print $out "\n#endif /* $guard */\n";
 224 } elsif ($what eq 'doc') {
 225     my %whatdef = ( 'on' => 'Enabled',
 226                     'off' => 'Disabled',
 227                     'err' => 'Enabled and promoted to error' );
 228
 229     foreach my $pfx (sort { $a cmp $b } keys(%prefixes)) {
 230         my $warn = $aliases{$pfx};
 231         my @doc;
 232
 233         if (!defined($warn)) {
 234             my @plist = sort { $a cmp $b } @{$prefixes{$pfx}};
 235             next if ( $#plist < 1 );
 236
 237             @doc = ("is a group alias for all warning classes prefixed by ".
 238                     "\\c{".$pfx."-}; currently\n");
 239             for (my $i = 0; $i <= $#plist; $i++) {
 240                 if ($i > 0) {
 241                     if ($i < $#plist) {
 242                         push(@doc, ", ");
 243                     } else {
 244                         push(@doc, ($i == 1) ? " and " : ", and ");
 245                     }
 246                 }
 247                 push(@doc, '\c{'.$plist[$i].'}');
 248             }
 249             push(@doc, ".\n");
 250         } elsif ($pfx ne $warn->{name}) {
 251             @doc = ("is a backwards compatibility alias for \\c{",
 252                     $warn->{name}, "}.\n");
 253         } else {
 254             my $docdef = $whatdef{$warn->{def}};
 255
 256             my $newpara = 0;
 257             foreach my $l (@{$warn->{doc}}) {
 258                 if ($l =~ /^\s*$/) {
 259                     $newpara = 1;
 260                 } else {
 261                     if ($newpara && $l !~ /^\\c\s+/) {
 262                         $l = '\> ' . $l;
 263                     }
 264                     $newpara = 0;
 265                 }
 266                 push(@doc, $l);
 267             }
 268             if (defined($docdef)) {
 269                 push(@doc, "\n", "\\> $docdef by default.\n");
 270             }
 271         }
 272
 273         print $out "\\b \\i\\c{", $pfx, "} ", @doc, "\n";
 274     }
 275 }
 276 close($out);