tokhash.pl

   1 #!/usr/bin/perl
   2 #
   3 # Generate a perfect hash for token parsing
   4 #
   5 # Usage: tokenhash.pl insns.dat regs.dat tokens.dat
   6 #
   7
   8 require 'phash.ph';
   9
  10 my($output, $insns_dat, $regs_dat, $tokens_dat) = @ARGV;
  11
  12 %tokens = ();
  13 @tokendata = ();
  14
  15 #
  16 # List of condition codes
  17 #
  18 @conditions = ('a', 'ae', 'b', 'be', 'c', 'e', 'g', 'ge', 'l', 'le',
  19                'na', 'nae', 'nb', 'nbe', 'nc', 'ne', 'ng', 'nge', 'nl',
  20                'nle', 'no', 'np', 'ns', 'nz', 'o', 'p', 'pe', 'po', 's', 'z');
  21
  22 #
  23 # Read insns.dat
  24 #
  25 open(ID, "< ${insns_dat}") or die "$0: cannot open $insns_dat: $!\n";
  26 while (defined($line = <ID>)) {
  27     if ($line =~ /^([A-Z0-9_]+)(|cc)\s/) {
  28         $insn = $1.$2;
  29         ($token = $1) =~ tr/A-Z/a-z/;
  30
  31         if ($2 eq '') {
  32             # Single instruction token
  33             if (!defined($tokens{$token})) {
  34                 $tokens{$token} = scalar @tokendata;
  35                 push(@tokendata, "\"${token}\", TOKEN_INSN, C_none, I_${insn}");
  36             }
  37         } else {
  38             # Conditional instruction
  39             foreach $cc (@conditions) {
  40                 if (!defined($tokens{$token.$cc})) {
  41                     $tokens{$token.$cc} = scalar @tokendata;
  42                     push(@tokendata, "\"${token}${cc}\", TOKEN_INSN, C_\U$cc\E, I_${insn}");
  43                 }
  44             }
  45         }
  46     }
  47 }
  48 close(ID);
  49
  50 #
  51 # Read regs.dat
  52 #
  53 open(RD, "< ${regs_dat}") or die "$0: cannot open $regs_dat: $!\n";
  54 while (defined($line = <RD>)) {
  55     if ($line =~ /^([a-z0-9_-]+)\s/) {
  56         $reg = $1;
  57
  58         if ($reg =~ /^(.*[^0-9])([0-9]+)\-([0-9]+)(|[^0-9].*)$/) {
  59             $nregs = $3-$2+1;
  60             $reg = $1.$2.$4;
  61             $reg_nr = $2;
  62             $reg_prefix = $1;
  63             $reg_suffix = $4;
  64         } else {
  65             $nregs = 1;
  66             undef $reg_prefix, $reg_suffix;
  67         }
  68
  69         while ($nregs--) {
  70             if (defined($tokens{$reg})) {
  71                 die "Duplicate definition: $reg\n";
  72             }
  73             $tokens{$reg} = scalar @tokendata;
  74             push(@tokendata, "\"${reg}\", TOKEN_REG, 0, R_\U${reg}\E");
  75
  76             if (defined($reg_prefix)) {
  77                 $reg_nr++;
  78                 $reg = sprintf("%s%u%s", $reg_prefix, $reg_nr, $reg_suffix);
  79             } else {
  80                 # Not a dashed sequence
  81                 die if ($nregs);
  82             }
  83         }
  84     }
  85 }
  86 close(RD);
  87
  88 #
  89 # Read tokens.dat
  90 #
  91 open(TD, "< ${tokens_dat}") or die "$0: cannot open $tokens_dat: $!\n";
  92 while (defined($line = <TD>)) {
  93     if ($line =~ /^\%\s+(.*)$/) {
  94         $pattern = $1;
  95     } elsif ($line =~ /^([a-z0-9_-]+)/) {
  96         $token = $1;
  97
  98         if (defined($tokens{$token})) {
  99             die "Duplicate definition: $token\n";
 100         }
 101         $tokens{$token} = scalar @tokendata;
 102
 103         $data = $pattern;
 104         if ($data =~ /^(.*)\{(.*)\}(.*)$/) {
 105             my $head = $1, $tail = $3;
 106             my $px = $2;
 107
 108             $px =~ s/\*/(.*)/g;
 109             if ($token =~ /$px/i) {
 110                 $data = $head."\U$1".$tail;
 111             } else {
 112                 die "$0: token $token doesn't match $px\n";
 113             }
 114         }
 115
 116         $data =~ s/\*/\U$token/g;
 117
 118         push(@tokendata, "\"$token\", $data");
 119     }
 120 }
 121 close(TD);
 122
 123 if ($output eq 'h') {
 124     #
 125     # tokens.h
 126     #
 127
 128     $max_len = 0;
 129     foreach $token (keys(%tokens)) {
 130         if (length($token) > $max_len) {
 131             $max_len = length($token);
 132         }
 133     }
 134
 135     print "/*\n";
 136     print " * This file is generated from insns.dat, regs.dat and token.dat\n";
 137     print " * by tokhash.pl; do not edit.\n";
 138     print " */\n";
 139     print "\n";
 140
 141     print "#ifndef NASM_TOKENS_H\n";
 142     print "#define NASM_TOKENS_H\n";
 143     print "\n";
 144     print "#define MAX_KEYWORD $max_len /* length of longest keyword */\n";
 145     print "\n";
 146     print "#endif /* NASM_TOKENS_H */\n";
 147 } elsif ($output eq 'c') {
 148     #
 149     # tokhash.c
 150     #
 151
 152     @hashinfo = gen_perfect_hash(\%tokens);
 153     if (!defined(@hashinfo)) {
 154         die "$0: no hash found\n";
 155     }
 156
 157     # Paranoia...
 158     verify_hash_table(\%tokens, \@hashinfo);
 159
 160     ($n, $sv, $g) = @hashinfo;
 161     $sv2 = $sv+2;
 162
 163     die if ($n & ($n-1));
 164
 165     print "/*\n";
 166     print " * This file is generated from insns.dat, regs.dat and token.dat\n";
 167     print " * by tokhash.pl; do not edit.\n";
 168     print " */\n";
 169     print "\n";
 170
 171     print "#include \"compiler.h\"\n";
 172     print "#include <string.h>\n";
 173     print "#include \"nasm.h\"\n";
 174     print "#include \"hashtbl.h\"\n";
 175     print "#include \"insns.h\"\n";
 176     print "\n";
 177
 178     # These somewhat odd sizes and ordering thereof are due to the
 179     # relative ranges of the types; this makes it fit in 16 bytes on
 180     # 64-bit machines and 12 bytes on 32-bit machines.
 181     print "struct tokendata {\n";
 182     print "    const char *string;\n";
 183     print "    int16_t tokentype;\n";
 184     print "    int16_t aux;\n";
 185     print "    int32_t num;\n";
 186     print "};\n";
 187     print "\n";
 188
 189     print "int nasm_token_hash(const char *token, struct tokenval *tv)\n";
 190     print "{\n";
 191
 192     # Put a large value in unused slots.  This makes it extremely unlikely
 193     # that any combination that involves unused slot will pass the range test.
 194     # This speeds up rejection of unrecognized tokens, i.e. identifiers.
 195     print "#define UNUSED 16383\n";
 196
 197     print "    static const int16_t hash1[$n] = {\n";
 198     for ($i = 0; $i < $n; $i++) {
 199         my $h = ${$g}[$i*2+0];
 200         print "        ", defined($h) ? $h : 'UNUSED', ",\n";
 201     }
 202     print "    };\n";
 203
 204     print "    static const int16_t hash2[$n] = {\n";
 205     for ($i = 0; $i < $n; $i++) {
 206         my $h = ${$g}[$i*2+1];
 207         print "        ", defined($h) ? $h : 'UNUSED', ",\n";
 208     }
 209     print "    };\n";
 210
 211     printf "    static const struct tokendata tokendata[%d] = {\n", scalar(@tokendata);
 212     foreach $d (@tokendata) {
 213         print "        { ", $d, " },\n";
 214     }
 215     print  "    };\n";
 216
 217     print  "    uint32_t k1, k2;\n";
 218     print  "    uint64_t crc;\n";
 219     # For correct overflow behavior, "ix" should be unsigned of the same
 220     # width as the hash arrays.
 221     print  "    uint16_t ix;\n";
 222     print  "    const struct tokendata *data;\n";
 223     print  "\n";
 224     printf "    crc = crc64(UINT64_C(0x%08x%08x), token);\n",
 225         $$sv[0], $$sv[1];
 226     print  "    k1 = (uint32_t)crc;\n";
 227     print  "    k2 = (uint32_t)(crc >> 32);\n";
 228     print  "\n";
 229     printf "    ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
 230     printf "    if (ix >= %d)\n", scalar(@tokendata);
 231     print  "        return tv->t_type = TOKEN_ID;\n";
 232     print  "\n";
 233     print  "    data = &tokendata[ix];\n";
 234
 235     print  "    if (strcmp(data->string, token))\n";
 236     print  "        return tv->t_type = TOKEN_ID;\n";
 237     print  "\n";
 238     print  "    tv->t_integer = data->num;\n";
 239     print  "    tv->t_inttwo  = data->aux;\n";
 240     print  "    return tv->t_type = data->tokentype;\n";
 241     print  "}\n";
 242 }