make: Lift up openwcom.mak for build on FreeDOS
[nasm/sigaren-mirror.git] / tokhash.pl
blob0c69c03429714e190c0ef13f84aab1987b57cc65
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:
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.
33 ## --------------------------------------------------------------------------
36 # Generate a perfect hash for token parsing
38 # Usage: tokenhash.pl insns.dat regs.dat tokens.dat
41 require 'phash.ph';
43 my($output, $insns_dat, $regs_dat, $tokens_dat) = @ARGV;
45 %tokens = ();
46 @tokendata = ();
49 # List of condition codes
51 @conditions = ('a', 'ae', 'b', 'be', 'c', 'e', 'g', 'ge', 'l', 'le',
52 'na', 'nae', 'nb', 'nbe', 'nc', 'ne', 'ng', 'nge', 'nl',
53 'nle', 'no', 'np', 'ns', 'nz', 'o', 'p', 'pe', 'po', 's', 'z');
56 # Read insns.dat
58 open(ID, "< ${insns_dat}") or die "$0: cannot open $insns_dat: $!\n";
59 while (defined($line = <ID>)) {
60 if ($line =~ /^([A-Z0-9_]+)(|cc)\s/) {
61 $insn = $1.$2;
62 ($token = $1) =~ tr/A-Z/a-z/;
64 if ($2 eq '') {
65 # Single instruction token
66 if (!defined($tokens{$token})) {
67 $tokens{$token} = scalar @tokendata;
68 push(@tokendata, "\"${token}\", TOKEN_INSN, C_none, I_${insn}");
70 } else {
71 # Conditional instruction
72 foreach $cc (@conditions) {
73 if (!defined($tokens{$token.$cc})) {
74 $tokens{$token.$cc} = scalar @tokendata;
75 push(@tokendata, "\"${token}${cc}\", TOKEN_INSN, C_\U$cc\E, I_${insn}");
81 close(ID);
84 # Read regs.dat
86 open(RD, "< ${regs_dat}") or die "$0: cannot open $regs_dat: $!\n";
87 while (defined($line = <RD>)) {
88 if ($line =~ /^([a-z0-9_-]+)\s/) {
89 $reg = $1;
91 if ($reg =~ /^(.*[^0-9])([0-9]+)\-([0-9]+)(|[^0-9].*)$/) {
92 $nregs = $3-$2+1;
93 $reg = $1.$2.$4;
94 $reg_nr = $2;
95 $reg_prefix = $1;
96 $reg_suffix = $4;
97 } else {
98 $nregs = 1;
99 undef $reg_prefix, $reg_suffix;
102 while ($nregs--) {
103 if (defined($tokens{$reg})) {
104 die "Duplicate definition: $reg\n";
106 $tokens{$reg} = scalar @tokendata;
107 push(@tokendata, "\"${reg}\", TOKEN_REG, 0, R_\U${reg}\E");
109 if (defined($reg_prefix)) {
110 $reg_nr++;
111 $reg = sprintf("%s%u%s", $reg_prefix, $reg_nr, $reg_suffix);
112 } else {
113 # Not a dashed sequence
114 die if ($nregs);
119 close(RD);
122 # Read tokens.dat
124 open(TD, "< ${tokens_dat}") or die "$0: cannot open $tokens_dat: $!\n";
125 while (defined($line = <TD>)) {
126 if ($line =~ /^\%\s+(.*)$/) {
127 $pattern = $1;
128 } elsif ($line =~ /^([a-z0-9_-]+)/) {
129 $token = $1;
131 if (defined($tokens{$token})) {
132 die "Duplicate definition: $token\n";
134 $tokens{$token} = scalar @tokendata;
136 $data = $pattern;
137 if ($data =~ /^(.*)\{(.*)\}(.*)$/) {
138 my $head = $1, $tail = $3;
139 my $px = $2;
141 $px =~ s/\*/(.*)/g;
142 if ($token =~ /$px/i) {
143 $data = $head."\U$1".$tail;
144 } else {
145 die "$0: token $token doesn't match $px\n";
149 $data =~ s/\*/\U$token/g;
151 push(@tokendata, "\"$token\", $data");
154 close(TD);
156 if ($output eq 'h') {
158 # tokens.h
161 $max_len = 0;
162 foreach $token (keys(%tokens)) {
163 if (length($token) > $max_len) {
164 $max_len = length($token);
168 print "/*\n";
169 print " * This file is generated from insns.dat, regs.dat and token.dat\n";
170 print " * by tokhash.pl; do not edit.\n";
171 print " */\n";
172 print "\n";
174 print "#ifndef NASM_TOKENS_H\n";
175 print "#define NASM_TOKENS_H\n";
176 print "\n";
177 print "#define MAX_KEYWORD $max_len /* length of longest keyword */\n";
178 print "\n";
179 print "#endif /* NASM_TOKENS_H */\n";
180 } elsif ($output eq 'c') {
182 # tokhash.c
185 @hashinfo = gen_perfect_hash(\%tokens);
186 if (!defined(@hashinfo)) {
187 die "$0: no hash found\n";
190 # Paranoia...
191 verify_hash_table(\%tokens, \@hashinfo);
193 ($n, $sv, $g) = @hashinfo;
194 $sv2 = $sv+2;
196 die if ($n & ($n-1));
198 print "/*\n";
199 print " * This file is generated from insns.dat, regs.dat and token.dat\n";
200 print " * by tokhash.pl; do not edit.\n";
201 print " */\n";
202 print "\n";
204 print "#include \"compiler.h\"\n";
205 print "#include <string.h>\n";
206 print "#include \"nasm.h\"\n";
207 print "#include \"hashtbl.h\"\n";
208 print "#include \"insns.h\"\n";
209 print "\n";
211 # These somewhat odd sizes and ordering thereof are due to the
212 # relative ranges of the types; this makes it fit in 16 bytes on
213 # 64-bit machines and 12 bytes on 32-bit machines.
214 print "struct tokendata {\n";
215 print " const char *string;\n";
216 print " int16_t tokentype;\n";
217 print " int16_t aux;\n";
218 print " int32_t num;\n";
219 print "};\n";
220 print "\n";
222 print "int nasm_token_hash(const char *token, struct tokenval *tv)\n";
223 print "{\n";
225 # Put a large value in unused slots. This makes it extremely unlikely
226 # that any combination that involves unused slot will pass the range test.
227 # This speeds up rejection of unrecognized tokens, i.e. identifiers.
228 print "#define UNUSED 16383\n";
230 print " static const int16_t hash1[$n] = {\n";
231 for ($i = 0; $i < $n; $i++) {
232 my $h = ${$g}[$i*2+0];
233 print " ", defined($h) ? $h : 'UNUSED', ",\n";
235 print " };\n";
237 print " static const int16_t hash2[$n] = {\n";
238 for ($i = 0; $i < $n; $i++) {
239 my $h = ${$g}[$i*2+1];
240 print " ", defined($h) ? $h : 'UNUSED', ",\n";
242 print " };\n";
244 printf " static const struct tokendata tokendata[%d] = {\n", scalar(@tokendata);
245 foreach $d (@tokendata) {
246 print " { ", $d, " },\n";
248 print " };\n";
250 print " uint32_t k1, k2;\n";
251 print " uint64_t crc;\n";
252 # For correct overflow behavior, "ix" should be unsigned of the same
253 # width as the hash arrays.
254 print " uint16_t ix;\n";
255 print " const struct tokendata *data;\n";
256 print "\n";
257 printf " crc = crc64(UINT64_C(0x%08x%08x), token);\n",
258 $$sv[0], $$sv[1];
259 print " k1 = (uint32_t)crc;\n";
260 print " k2 = (uint32_t)(crc >> 32);\n";
261 print "\n";
262 printf " ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
263 printf " if (ix >= %d)\n", scalar(@tokendata);
264 print " return tv->t_type = TOKEN_ID;\n";
265 print "\n";
266 print " data = &tokendata[ix];\n";
268 print " if (strcmp(data->string, token))\n";
269 print " return tv->t_type = TOKEN_ID;\n";
270 print "\n";
271 print " tv->t_integer = data->num;\n";
272 print " tv->t_inttwo = data->aux;\n";
273 print " return tv->t_type = data->tokentype;\n";
274 print "}\n";