asm/pptok.pl

   1 #!/usr/bin/perl
   2 ## --------------------------------------------------------------------------
   3 ##
   4 ##   Copyright 1996-2019 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     $line =~ s/\r?\n$//;        # Remove trailing \r\n or \n
  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         # Condition stem
  55         push(@cctok, $1);
  56     } elsif ($line =~ /^\%(.*\!.*)$/) {
  57         # Directive with case insensitity "i" option
  58         # Mnemonic: ! is "upside down i"
  59         push(@ppitok, $1);
  60     } elsif ($line =~ /^\%(.*)$/) {
  61         # Other directive
  62         push(@pptok, $1);
  63     } elsif ($line =~ /^\*(.*)$/) {
  64         # Condition tail
  65         push(@cond, $1);
  66     }
  67 }
  68 close(IN);
  69
  70 # Always sort %if first
  71 @cctok = sort { $a eq 'if' ? -1 : $b eq 'if' ? 1 : $a cmp $b } @cctok;
  72 @cond = sort @cond;
  73 @pptok = sort @pptok;
  74 @ppitok = sort @ppitok;
  75
  76 # Generate the expanded list including conditionals.  The conditionals
  77 # are at the beginning, padded to a power of 2, with the inverses
  78 # following each group; this allows a simple mask to pick out the condition,
  79 # polarity, and directive type.
  80
  81 while ((scalar @cond) & (scalar @cond)-1) {
  82     push(@cond, sprintf("_COND_%d", scalar @cond));
  83 }
  84
  85 @cptok = ();
  86 foreach $ct (@cctok) {
  87     foreach $cc (@cond) {
  88         push(@cptok, $ct.$cc);
  89     }
  90     foreach $cc (@cond) {
  91         push(@cptok, $ct.'n'.$cc);
  92     }
  93 }
  94 $first_uncond = scalar @cptok;
  95 @pptok = (@cptok, @pptok);
  96
  97 # Generate the list of case-specific tokens; these are in pairs
  98 # with the -i- variant following the plain variant
  99 if (scalar(@pptok) & 1) {
 100     push(@pptok, 'CASE_PAD');
 101 }
 102
 103 $first_itoken = scalar @pptok;
 104 foreach $it (@ppitok) {
 105     (my $at = $it) =~ s/\!//;
 106     (my $bt = $it) =~ s/\!/i/;
 107
 108     push(@pptok, $at, $bt);
 109 }
 110
 111 open(OUT, '>', $out) or die "$0: cannot open: $out\n";
 112
 113 #
 114 # Output pptok.h
 115 #
 116 if ($what eq 'h') {
 117     print OUT "/* Automatically generated from $in by $0 */\n";
 118     print OUT "/* Do not edit */\n";
 119     print OUT "\n";
 120
 121     print OUT "enum preproc_token {\n";
 122     $n = 0;
 123     foreach $pt (@pptok) {
 124         if (defined($pt)) {
 125             printf OUT "    %-24s = %3d,\n", "PP_\U$pt\E", $n;
 126         }
 127         $n++;
 128     }
 129     printf OUT "    %-24s = %3d\n", 'PP_INVALID', -1;
 130     print OUT "};\n";
 131     print OUT "\n";
 132
 133     printf OUT "#define PP_COND(x)     ((x) & 0x%x)\n",
 134         (scalar(@cond)-1);
 135     printf OUT "#define PP_IS_COND(x)  ((unsigned int)(x) < PP_%s)\n",
 136         uc($pptok[$first_uncond]);
 137     printf OUT "#define PP_COND_NEGATIVE(x) (!!((x) & 0x%x))\n", scalar(@cond);
 138     print  OUT "\n";
 139     printf OUT "#define PP_HAS_CASE(x) ((x) >= PP_%s)\n",
 140         uc($pptok[$first_itoken]);
 141     print  OUT "#define PP_INSENSITIVE(x) ((x) & 1)\n";
 142     print  OUT "\n";
 143
 144     foreach $ct (@cctok) {
 145         print OUT "#define CASE_PP_\U$ct\E";
 146         $pref = " \\\n";
 147         foreach $cc (@cond) {
 148             print OUT "$pref\tcase PP_\U${ct}${cc}\E";
 149             $pref = ":\\\n";
 150         }
 151         foreach $cc (@cond) {
 152             print OUT "$pref\tcase PP_\U${ct}N${cc}\E";
 153             $pref = ":\\\n";
 154         }
 155         print OUT "\n";         # No colon or newline on the last one
 156     }
 157 }
 158
 159 #
 160 # Output pptok.c
 161 #
 162 if ($what eq 'c') {
 163     print OUT "/* Automatically generated from $in by $0 */\n";
 164     print OUT "/* Do not edit */\n";
 165     print OUT "\n";
 166
 167     my %tokens = ();
 168     my @tokendata = ();
 169
 170     my $n = 0;
 171     foreach $pt (@pptok) {
 172         # Upper case characters signify internal use tokens only
 173         if (defined($pt) && $pt !~ /[A-Z]/) {
 174             $tokens{'%'.$pt} = $n;
 175             if ($pt =~ /[\@\[\]\\_]/) {
 176                 # Fail on characters which look like upper-case letters
 177                 # to the quick-and-dirty downcasing in the prehash
 178                 # (see below)
 179                 die "$in: invalid character in token: $pt";
 180             }
 181         }
 182         $n++;
 183     }
 184
 185     my @hashinfo = gen_perfect_hash(\%tokens);
 186     if (!@hashinfo) {
 187         die "$0: no hash found\n";
 188     }
 189
 190     # Paranoia...
 191     verify_hash_table(\%tokens, \@hashinfo);
 192
 193     ($n, $sv, $g) = @hashinfo;
 194     die if ($n & ($n-1));
 195
 196     print OUT "#include \"compiler.h\"\n";
 197     print OUT "#include \"nctype.h\"\n";
 198     print OUT "#include \"nasmlib.h\"\n";
 199     print OUT "#include \"hashtbl.h\"\n";
 200     print OUT "#include \"preproc.h\"\n";
 201     print OUT "\n";
 202
 203     # Note that this is global.
 204     printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
 205     foreach $d (@pptok) {
 206         if (defined($d) && $d !~ /[A-Z]/) {
 207             print OUT "    \"%$d\",\n";
 208         } else {
 209             print OUT "    NULL,\n";
 210         }
 211     }
 212     print OUT  "};\n";
 213
 214     printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
 215     foreach $d (@pptok) {
 216         printf OUT "    %d,\n", defined($d) ? length($d)+1 : 0;
 217     }
 218     print OUT  "};\n";
 219
 220     print OUT "enum preproc_token pp_token_hash(const char *token)\n";
 221     print OUT "{\n";
 222
 223     # Put a large value in unused slots.  This makes it extremely unlikely
 224     # that any combination that involves unused slot will pass the range test.
 225     # This speeds up rejection of unrecognized tokens, i.e. identifiers.
 226     print OUT "#define UNUSED_HASH_ENTRY (65535/3)\n";
 227
 228     print OUT "    static const int16_t hash1[$n] = {\n";
 229     for ($i = 0; $i < $n; $i++) {
 230         my $h = ${$g}[$i*2+0];
 231         print OUT "        ", defined($h) ? $h : 'UNUSED_HASH_ENTRY', ",\n";
 232     }
 233     print OUT "    };\n";
 234
 235     print OUT "    static const int16_t hash2[$n] = {\n";
 236     for ($i = 0; $i < $n; $i++) {
 237         my $h = ${$g}[$i*2+1];
 238         print OUT "        ", defined($h) ? $h : 'UNUSED_HASH_ENTRY', ",\n";
 239     }
 240     print OUT "    };\n";
 241
 242     print OUT  "    uint32_t k1, k2;\n";
 243     print OUT  "    uint64_t crc;\n";
 244     # For correct overflow behavior, "ix" should be unsigned of the same
 245     # width as the hash arrays.
 246     print OUT  "    uint16_t ix;\n";
 247     print OUT  "\n";
 248
 249     printf OUT "    crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
 250         $$sv[0], $$sv[1];
 251     print  OUT "    k1 = (uint32_t)crc;\n";
 252     print  OUT "    k2 = (uint32_t)(crc >> 32);\n";
 253     print  OUT "\n";
 254     printf OUT "    ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
 255     printf OUT "    if (ix >= %d)\n", scalar(@pptok);
 256     print OUT  "        return PP_INVALID;\n";
 257     print OUT  "\n";
 258
 259     print OUT  "    if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
 260     print OUT  "        return PP_INVALID;\n";
 261     print OUT  "\n";
 262     print OUT  "    return ix;\n";
 263     print OUT  "}\n";
 264 }
 265
 266 #
 267 # Output pptok.ph
 268 #
 269 if ($what eq 'ph') {
 270     print OUT "# Automatically generated from $in by $0\n";
 271     print OUT "# Do not edit\n";
 272     print OUT "\n";
 273
 274     print OUT "%pptok_hash = (\n";
 275     $n = 0;
 276     foreach $tok (@pptok) {
 277         if (defined($tok)) {
 278             printf OUT "    '%%%s' => %d,\n", $tok, $n;
 279         }
 280         $n++;
 281     }
 282     print OUT ");\n";
 283     print OUT "1;\n";
 284 }