pptok.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2009 The NASM Authors - All Rights Reserved
   5 ##   See the file AUTHORS included with the NASM distribution for
   6 ##   the specific copyright holders.
   7 ##
   8 ##   Redistribution and use in source and binary forms, with or without
   9 ##   modification, are permitted provided that the following
  10 ##   conditions are met:
  11 ##
  12 ##   * Redistributions of source code must retain the above copyright
  13 ##     notice, this list of conditions and the following disclaimer.
  14 ##   * Redistributions in binary form must reproduce the above
  15 ##     copyright notice, this list of conditions and the following
  16 ##     disclaimer in the documentation and/or other materials provided
  17 ##     with the distribution.
  18 ##
  19 ##     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20 ##     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21 ##     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22 ##     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23 ##     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24 ##     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25 ##     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26 ##     NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27 ##     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28 ##     HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29 ##     CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30 ##     OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31 ##     EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32 ##
  33 ## --------------------------------------------------------------------------
  34
  35 #
  36 # Produce pptok.c, pptok.h and pptok.ph from pptok.dat
  37 #
  38
  39 require 'phash.ph';
  40
  41 my($what, $in, $out) = @ARGV;
  42
  43 #
  44 # Read pptok.dat
  45 #
  46 open(IN, "< $in") or die "$0: cannot open: $in\n";
  47 while (defined($line = <IN>)) {
  48     chomp $line;
  49     $line =~ s/^\s+//;          # Remove leading whitespace
  50     $line =~ s/\s*\#.*$//;      # Remove comments and trailing whitespace
  51     next if ($line eq '');
  52
  53     if ($line =~ /^\%(.*)\*$/) {
  54         push(@cctok, $1);
  55     } elsif ($line =~ /^\%(.*)$/) {
  56         push(@pptok, $1);
  57     } elsif ($line =~ /^\*(.*)$/) {
  58         push(@cond, $1);
  59     }
  60 }
  61 close(IN);
  62
  63 @cctok = sort @cctok;
  64 @cond = sort @cond;
  65 @pptok = sort @pptok;
  66
  67 # Generate the expanded list including conditionals.  The conditionals
  68 # are at the beginning, padded to a power of 2, with the inverses
  69 # interspersed; this allows a simple mask to pick out the condition.
  70
  71 while ((scalar @cond) & (scalar @cond)-1) {
  72     push(@cond, undef);
  73 }
  74
  75 @cptok = ();
  76 foreach $ct (@cctok) {
  77     foreach $cc (@cond) {
  78         if (defined($cc)) {
  79             push(@cptok, $ct.$cc);
  80             push(@cptok, $ct.'n'.$cc);
  81         } else {
  82             push(@cptok, undef, undef);
  83         }
  84     }
  85 }
  86 $first_uncond = $pptok[0];
  87 @pptok = (@cptok, @pptok);
  88
  89 open(OUT, "> $out") or die "$0: cannot open: $out\n";
  90
  91 #
  92 # Output pptok.h
  93 #
  94 if ($what eq 'h') {
  95     print OUT "/* Automatically generated from $in by $0 */\n";
  96     print OUT "/* Do not edit */\n";
  97     print OUT "\n";
  98
  99     print OUT "enum preproc_token {\n";
 100     $n = 0;
 101     foreach $pt (@pptok) {
 102         if (defined($pt)) {
 103             printf OUT "    %-16s = %3d,\n", "PP_\U$pt\E", $n;
 104         }
 105         $n++;
 106     }
 107     printf OUT "    %-16s = %3d\n", 'PP_INVALID', -1;
 108     print OUT "};\n";
 109     print OUT "\n";
 110
 111     print  OUT "enum pp_conditional {\n";
 112     $n = 0;
 113     foreach $cc (@cond) {
 114         if (defined($cc)) {
 115             printf OUT "    %-16s = %3d,\n", "PPC_IF\U$cc\E", $n;
 116         }
 117         $n += 2;
 118     }
 119     print  OUT "};\n\n";
 120
 121     printf OUT "#define PP_COND(x)     ((enum pp_conditional)((x) & 0x%x))\n",
 122         (scalar(@cond)-1) << 1;
 123     print  OUT "#define PP_IS_COND(x)  ((unsigned int)(x) < PP_\U$first_uncond\E)\n";
 124     print  OUT "#define PP_NEGATIVE(x) ((x) & 1)\n";
 125     print  OUT "\n";
 126
 127     foreach $ct (@cctok) {
 128         print OUT "#define CASE_PP_\U$ct\E";
 129         $pref = " \\\n";
 130         foreach $cc (@cond) {
 131             if (defined($cc)) {
 132                 print OUT "$pref\tcase PP_\U${ct}${cc}\E: \\\n";
 133                 print OUT "\tcase PP_\U${ct}N${cc}\E";
 134                 $pref = ":\\\n";
 135             }
 136         }
 137         print OUT "\n";         # No colon or newline on the last one
 138     }
 139 }
 140
 141 #
 142 # Output pptok.c
 143 #
 144 if ($what eq 'c') {
 145     print OUT "/* Automatically generated from $in by $0 */\n";
 146     print OUT "/* Do not edit */\n";
 147     print OUT "\n";
 148
 149     my %tokens = ();
 150     my @tokendata = ();
 151
 152     my $n = 0;
 153     foreach $pt (@pptok) {
 154         if (defined($pt)) {
 155             $tokens{'%'.$pt} = $n;
 156             if ($pt =~ /[\@\[\]\\_]/) {
 157                 # Fail on characters which look like upper-case letters
 158                 # to the quick-and-dirty downcasing in the prehash
 159                 # (see below)
 160                 die "$in: invalid character in token: $pt";
 161             }
 162         }
 163         $n++;
 164     }
 165
 166     my @hashinfo = gen_perfect_hash(\%tokens);
 167     if (!defined(@hashinfo)) {
 168         die "$0: no hash found\n";
 169     }
 170
 171     # Paranoia...
 172     verify_hash_table(\%tokens, \@hashinfo);
 173
 174     ($n, $sv, $g) = @hashinfo;
 175     $sv2 = $sv+2;
 176
 177     die if ($n & ($n-1));
 178
 179     print OUT "#include \"compiler.h\"\n";
 180     print OUT "#include <inttypes.h>\n";
 181     print OUT "#include <ctype.h>\n";
 182     print OUT "#include \"nasmlib.h\"\n";
 183     print OUT "#include \"hashtbl.h\"\n";
 184     print OUT "#include \"preproc.h\"\n";
 185     print OUT "\n";
 186
 187     # Note that this is global.
 188     printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
 189     foreach $d (@pptok) {
 190         if (defined($d)) {
 191             print OUT "    \"%$d\",\n";
 192         } else {
 193             print OUT "    NULL,\n";
 194         }
 195     }
 196     print OUT  "};\n";
 197
 198     printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
 199     foreach $d (@pptok) {
 200         printf OUT "    %d,\n", defined($d) ? length($d)+1 : 0;
 201     }
 202     print OUT  "};\n";
 203
 204     print OUT "enum preproc_token pp_token_hash(const char *token)\n";
 205     print OUT "{\n";
 206
 207     # Put a large value in unused slots.  This makes it extremely unlikely
 208     # that any combination that involves unused slot will pass the range test.
 209     # This speeds up rejection of unrecognized tokens, i.e. identifiers.
 210     print OUT "#define UNUSED 16383\n";
 211
 212     print OUT "    static const int16_t hash1[$n] = {\n";
 213     for ($i = 0; $i < $n; $i++) {
 214         my $h = ${$g}[$i*2+0];
 215         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 216     }
 217     print OUT "    };\n";
 218
 219     print OUT "    static const int16_t hash2[$n] = {\n";
 220     for ($i = 0; $i < $n; $i++) {
 221         my $h = ${$g}[$i*2+1];
 222         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 223     }
 224     print OUT "    };\n";
 225
 226     print OUT  "    uint32_t k1, k2;\n";
 227     print OUT  "    uint64_t crc;\n";
 228     # For correct overflow behavior, "ix" should be unsigned of the same
 229     # width as the hash arrays.
 230     print OUT  "    uint16_t ix;\n";
 231     print OUT  "\n";
 232
 233     printf OUT "    crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
 234         $$sv[0], $$sv[1];
 235     print  OUT "    k1 = (uint32_t)crc;\n";
 236     print  OUT "    k2 = (uint32_t)(crc >> 32);\n";
 237     print  OUT "\n";
 238     printf OUT "    ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
 239     printf OUT "    if (ix >= %d)\n", scalar(@pptok);
 240     print OUT  "        return PP_INVALID;\n";
 241     print OUT  "\n";
 242
 243     print OUT  "    if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
 244     print OUT  "        return PP_INVALID;\n";
 245     print OUT  "\n";
 246     print OUT  "    return ix;\n";
 247     print OUT  "}\n";
 248 }
 249
 250 #
 251 # Output pptok.ph
 252 #
 253 if ($what eq 'ph') {
 254     print OUT "# Automatically generated from $in by $0\n";
 255     print OUT "# Do not edit\n";
 256     print OUT "\n";
 257
 258     print OUT "%pptok_hash = (\n";
 259     $n = 0;
 260     foreach $tok (@pptok) {
 261         if (defined($tok)) {
 262             printf OUT "    '%%%s' => %d,\n", $tok, $n;
 263         }
 264         $n++;
 265     }
 266     print OUT ");\n";
 267     print OUT "1;\n";
 268 }
 269
 270