pptok.pl

   1 #!/usr/bin/perl
   2 #
   3 # Produce pptok.c and pptok.h 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
  33 # Generate the expanded list including conditionals
  34 foreach $ct (@cctok) {
  35     foreach $cc (@cond) {
  36         push(@pptok, $ct.$cc);
  37         push(@pptok, $ct.'n'.$cc);
  38     }
  39 }
  40
  41 @pptok = sort @pptok;
  42
  43 open(OUT, "> $out") or die "$0: cannot open: $out\n";
  44 print OUT "/* Automatically generated from $in by $0 */\n";
  45 print OUT "/* Do not edit */\n";
  46 print OUT "\n";
  47
  48 #
  49 # Output pptok.h
  50 #
  51 if ($what eq 'h') {
  52     print OUT "enum preproc_token {\n";
  53     foreach $pt (@pptok) {
  54         (my $px = $pt) =~ s/\%//g;
  55         print OUT "    PP_\U$px\E,\n";
  56     }
  57     print OUT "    PP_INVALID = -1\n";
  58     print OUT "};\n";
  59     print OUT "\n";
  60
  61     $first_cc = $cond[0];
  62     $last_cc  = $cond[(scalar @cond)-1];
  63
  64     foreach $ct (@cctok) {
  65         (my $cx = $ct) =~ s/\%//g;
  66         print OUT "#define IS_PP_\U$cx\E(x) ((x) >= PP_\U$cx$first_cc\E && ";
  67         print OUT "(x) <= PP_\U$cx$last_cc\E)\n";
  68     }
  69 }
  70
  71 #
  72 # Output pptok.c
  73 #
  74 if ($what eq 'c') {
  75     my %tokens = ();
  76     my @tokendata = ();
  77
  78     foreach $pt (@pptok) {
  79         (my $px = $pt) =~ s/\%//g;
  80         $tokens{$pt} = scalar @tokendata;
  81         push(@tokendata, $pt);
  82     }
  83
  84     my @hashinfo = gen_perfect_hash(\%tokens);
  85     if (!defined(@hashinfo)) {
  86         die "$0: no hash found\n";
  87     }
  88
  89     # Paranoia...
  90     verify_hash_table(\%tokens, \@hashinfo);
  91
  92     ($n, $sv, $g) = @hashinfo;
  93     $sv2 = $sv+2;
  94
  95     die if ($n & ($n-1));
  96
  97     print OUT "#include <inttypes.h>\n";
  98     print OUT "#include <ctype.h>\n";
  99     print OUT "#include \"nasmlib.h\"\n";
 100     print OUT "#include \"preproc.h\"\n";
 101     print OUT "\n";
 102
 103     print OUT "#define rot(x,y) (((uint32_t)(x) << (y))+((uint32_t)(x) >> (32-(y))))\n";
 104     print OUT "\n";
 105
 106     # Note that this is global.
 107     printf OUT "const char * const pp_directives[%d] = {\n",
 108         scalar(@tokendata);
 109     foreach $d (@tokendata) {
 110         print OUT "    \"$d\",\n";
 111     }
 112     print OUT  "};\n";
 113
 114     print OUT "enum preproc_token pp_token_hash(const char *token)\n";
 115     print OUT "{\n";
 116
 117     # Put a large value in unused slots.  This makes it extremely unlikely
 118     # that any combination that involves unused slot will pass the range test.
 119     # This speeds up rejection of unrecognized tokens, i.e. identifiers.
 120     print OUT "#define UNUSED 16383\n";
 121
 122     print OUT "    static const int16_t hash1[$n] = {\n";
 123     for ($i = 0; $i < $n; $i++) {
 124         my $h = ${$g}[$i*2+0];
 125         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 126     }
 127     print OUT "    };\n";
 128
 129     print OUT "    static const int16_t hash2[$n] = {\n";
 130     for ($i = 0; $i < $n; $i++) {
 131         my $h = ${$g}[$i*2+1];
 132         print OUT "        ", defined($h) ? $h : 'UNUSED', ",\n";
 133     }
 134     print OUT "    };\n";
 135
 136     print OUT  "    uint32_t k1 = 0, k2 = 0;\n";
 137     print OUT  "    uint8_t c;\n";
 138     # For correct overflow behavior, "ix" should be unsigned of the same
 139     # width as the hash arrays.
 140     print OUT  "    uint16_t ix;\n";
 141     print OUT  "    const char *p = token;\n";
 142     print OUT  "\n";
 143
 144     print OUT  "    while ((c = *p++) != 0) {\n";
 145     print OUT "         c = tolower(c);\n";
 146     printf OUT "        uint32_t kn1 = rot(k1,%2d) - rot(k2,%2d) + c;\n", ${$sv}[0], ${$sv}[1];
 147     printf OUT "        uint32_t kn2 = rot(k2,%2d) - rot(k1,%2d) + c;\n", ${$sv}[2], ${$sv}[3];
 148     print OUT  "        k1 = kn1; k2 = kn2;\n";
 149     print OUT  "    }\n";
 150     print OUT  "\n";
 151     printf OUT "    ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
 152     printf OUT "    if (ix >= %d)\n", scalar(@tokendata);
 153     print OUT  "        return PP_INVALID;\n";
 154     print OUT  "\n";
 155
 156     print OUT  "    if (nasm_stricmp(pp_directives[ix], token))\n";
 157     print OUT  "        return PP_INVALID;\n";
 158     print OUT  "\n";
 159     print OUT  "    return ix;\n";
 160     print OUT  "}\n";
 161 }