Reworked test files for better error reporting
[nasm/perl-rewrite.git] / pptok.pl
blob117c528b388de2ec2f9e68fb3ad3e687b40683cb
1 #!/usr/bin/perl
3 # Produce pptok.c, pptok.h and pptok.ph from pptok.dat
6 require 'phash.ph';
8 my($what, $in, $out) = @ARGV;
11 # Read pptok.dat
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 '');
20 if ($line =~ /^\%(.*)\*$/) {
21 push(@cctok, $1);
22 } elsif ($line =~ /^\%(.*)$/) {
23 push(@pptok, $1);
24 } elsif ($line =~ /^\*(.*)$/) {
25 push(@cond, $1);
28 close(IN);
30 @cctok = sort @cctok;
31 @cond = sort @cond;
32 @pptok = sort @pptok;
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.
38 while ((scalar @cond) & (scalar @cond)-1) {
39 push(@cond, undef);
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);
53 $first_uncond = $pptok[0];
54 @pptok = (@cptok, @pptok);
56 open(OUT, "> $out") or die "$0: cannot open: $out\n";
59 # Output pptok.h
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";
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;
72 $n++;
74 printf OUT " %-16s = %3d\n", 'PP_INVALID', -1;
75 print OUT "};\n";
76 print OUT "\n";
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;
84 $n += 2;
86 print OUT "};\n\n";
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";
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";
104 print OUT "\n"; # No colon or newline on the last one
109 # Output pptok.c
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";
116 my %tokens = ();
117 my @tokendata = ();
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";
130 $n++;
133 my @hashinfo = gen_perfect_hash(\%tokens);
134 if (!defined(@hashinfo)) {
135 die "$0: no hash found\n";
138 # Paranoia...
139 verify_hash_table(\%tokens, \@hashinfo);
141 ($n, $sv, $g) = @hashinfo;
142 $sv2 = $sv+2;
144 die if ($n & ($n-1));
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";
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";
163 print OUT "};\n";
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;
169 print OUT "};\n";
171 print OUT "enum preproc_token pp_token_hash(const char *token)\n";
172 print OUT "{\n";
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";
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";
184 print OUT " };\n";
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";
191 print OUT " };\n";
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";
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";
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";
218 # Output pptok.ph
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";
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;
231 $n++;
233 print OUT ");\n";
234 print OUT "1;\n";