pptok.pl

   1 #!/usr/bin/perl
   2 #
   3 # Produce pptok.c, pptok.h and pptok.ph from pptok.dat
   4 #
   5
   6 require 'phash.ph';
   7
   8 my($what, $in, $out) = @ARGV;
   9
  10 #
  11 # Read pptok.dat
  12 #
  13 open(IN, "< $in") or die "$0: cannot open: $in\n";
  14 while (defined($line = <IN>)) {
  15     chomp $line;
  16     $line =~ s/^\s+//;          # Remove leading whitespace
  17     $line =~ s/\s*\#.*$//;      # Remove comments and trailing whitespace
  18     next if ($line eq '');
  19
  20     if ($line =~ /^\%(.*)\*$/) {
  21         push(@cctok, $1);
  22     } elsif ($line =~ /^\%(.*)$/) {
  23         push(@pptok, $1);
  24     } elsif ($line =~ /^\*(.*)$/) {
  25         push(@cond, $1);
  26     }
  27 }
  28 close(IN);
  29
  30 @cctok = sort @cctok;
  31 @cond = sort @cond;
  32 @pptok = sort @pptok;
  33
  34 # Generate the expanded list including conditionals.  The conditionals
  35 # are at the beginning, padded to a power of 2, with the inverses
  36 # interspersed; this allows a simple mask to pick out the condition.
  37
  38 while ((scalar @cond) & (scalar @cond)-1) {
  39     push(@cond, undef);
  40 }
  41
  42 @cptok = ();
  43 foreach $ct (@cctok) {
  44     foreach $cc (@cond) {
  45         if (defined($cc)) {
  46             push(@cptok, $ct.$cc);
  47             push(@cptok, $ct.'n'.$cc);
  48         } else {
  49             push(@cptok, undef, undef);
  50         }
  51     }
  52 }
  53 $first_uncond = $pptok[0];
  54 @pptok = (@cptok, @pptok);
  55
  56 open(OUT, "> $out") or die "$0: cannot open: $out\n";
  57
  58 #
  59 # Output pptok.h
  60 #
  61 if ($what eq 'h') {
  62     print OUT "/* Automatically generated from $in by $0 */\n";
  63     print OUT "/* Do not edit */\n";
  64     print OUT "\n";
  65
  66     print OUT "enum preproc_token {\n";
  67     $n = 0;
  68     foreach $pt (@pptok) {
  69         if (defined($pt)) {
  70             printf OUT "    %-16s = %3d,\n", "PP_\U$pt\E", $n;
  71         }
  72         $n++;
  73     }
  74     printf OUT "    %-16s = %3d\n", 'PP_INVALID', -1;
  75     print OUT "};\n";
  76     print OUT "\n";
  77
  78     print  OUT "enum pp_conditional {\n";
  79     $n = 0;
  80     foreach $cc (@cond) {
  81         if (defined($cc)) {
  82             printf OUT "    %-16s = %3d,\n", "PPC_IF\U$cc\E", $n;
  83         }
  84         $n += 2;
  85     }
  86     print  OUT "};\n\n";
  87
  88     printf OUT "#define PP_COND(x)     ((enum pp_conditional)((x) & 0x%x))\n",
  89         (scalar(@cond)-1) << 1;
  90     print  OUT "#define PP_IS_COND(x)  ((unsigned int)(x) < PP_\U$first_uncond\E)\n";
  91     print  OUT "#define PP_NEGATIVE(x) ((x) & 1)\n";
  92     print  OUT "\n";
  93
  94     foreach $ct (@cctok) {
  95         print OUT "#define CASE_PP_\U$ct\E";
  96         $pref = " \\\n";
  97         foreach $cc (@cond) {
  98             if (defined($cc)) {
  99                 print OUT "$pref\tcase PP_\U${ct}${cc}\E: \\\n";
 100                 print OUT "\tcase PP_\U${ct}N${cc}\E";
 101                 $pref = ":\\\n";
 102             }
 103         }
 104         print OUT "\n";         # No colon or newline on the last one
 105     }
 106 }
 107
 108 #
 109 # Output pptok.c
 110 #
 111 if ($what eq 'c') {
 112     print OUT "/* Automatically generated from $in by $0 */\n";
 113     print OUT "/* Do not edit */\n";
 114     print OUT "\n";
 115
 116     my %tokens = ();
 117     my @tokendata = ();
 118
 119     my $n = 0;
 120     foreach $pt (@pptok) {
 121         if (defined($pt)) {
 122             $tokens{'%'.$pt} = $n;
 123             if ($pt =~ /[\@\[\]\\_]/) {
 124                 # Fail on characters which look like upper-case letters
 125                 # to the quick-and-dirty downcasing in the prehash
 126                 # (see below)
 127                 die "$in: invalid character in token: $pt";
 128             }
 129         }
 130         $n++;
 131     }
 132
 133     my @hashinfo = gen_perfect_hash(\%tokens);
 134     if (!defined(@hashinfo)) {
 135         die "$0: no hash found\n";
 136     }
 137
 138     # Paranoia...
 139     verify_hash_table(\%tokens, \@hashinfo);
 140
 141     ($n, $sv, $g) = @hashinfo;
 142     $sv2 = $sv+2;
 143
 144     die if ($n & ($n-1));
 145
 146     print OUT "#include \"compiler.h\"\n";
 147     print OUT "#include <inttypes.h>\n";
 148     print OUT "#include <ctype.h>\n";
 149     print OUT "#include \"nasmlib.h\"\n";
 150     print OUT "#include \"hashtbl.h\"\n";
 151     print OUT "#include \"preproc.h\"\n";
 152     print OUT "\n";
 153
 154     # Note that this is global.
 155     printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
 156     foreach $d (@pptok) {
 157         if (defined($d)) {
 158             print OUT "    \"%$d\",\n";
 159         } else {
 160             print OUT "    NULL,\n";
 161         }
 162     }
 163     print OUT  "};\n";
 164
 165     printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
 166     foreach $d (@pptok) {
 167         printf OUT "    %d,\n", defined($d) ? length($d)+1 : 0;
 168     }
 169     print OUT  "};\n";
 170
 171     print OUT "enum preproc_token pp_token_hash(const char *token)\n";
 172     print OUT "{\n";
 173
 174     # Put a large value in unused slots.  This makes it extremely unlikely
 175     # that any combination that involves unused slot will pass the range test.
 176     # This speeds up rejection of unrecognized tokens, i.e. identifiers.
 177     print OUT "#define UNUSED 16383\n";
 178
 179     print OUT "    static const int16_t hash1[$n] = {\n";
 180     for ($i = 0; $i < $n; $i++) {
 181         my $h = ${$g}[$i*2+0];
 182         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 183     }
 184     print OUT "    };\n";
 185
 186     print OUT "    static const int16_t hash2[$n] = {\n";
 187     for ($i = 0; $i < $n; $i++) {
 188         my $h = ${$g}[$i*2+1];
 189         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 190     }
 191     print OUT "    };\n";
 192
 193     print OUT  "    uint32_t k1, k2;\n";
 194     print OUT  "    uint64_t crc;\n";
 195     # For correct overflow behavior, "ix" should be unsigned of the same
 196     # width as the hash arrays.
 197     print OUT  "    uint16_t ix;\n";
 198     print OUT  "\n";
 199
 200     printf OUT "    crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
 201         $$sv[0], $$sv[1];
 202     print  OUT "    k1 = (uint32_t)crc;\n";
 203     print  OUT "    k2 = (uint32_t)(crc >> 32);\n";
 204     print  OUT "\n";
 205     printf OUT "    ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
 206     printf OUT "    if (ix >= %d)\n", scalar(@pptok);
 207     print OUT  "        return PP_INVALID;\n";
 208     print OUT  "\n";
 209
 210     print OUT  "    if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
 211     print OUT  "        return PP_INVALID;\n";
 212     print OUT  "\n";
 213     print OUT  "    return ix;\n";
 214     print OUT  "}\n";
 215 }
 216
 217 #
 218 # Output pptok.ph
 219 #
 220 if ($what eq 'ph') {
 221     print OUT "# Automatically generated from $in by $0\n";
 222     print OUT "# Do not edit\n";
 223     print OUT "\n";
 224
 225     print OUT "%pptok_hash = (\n";
 226     $n = 0;
 227     foreach $tok (@pptok) {
 228         if (defined($tok)) {
 229             printf OUT "    '%%%s' => %d,\n", $tok, $n;
 230         }
 231         $n++;
 232     }
 233     print OUT ");\n";
 234     print OUT "1;\n";
 235 }
 236
 237