|
10554
|
1 #!/usr/bin/perl
|
|
|
2 ## --------------------------------------------------------------------------
|
|
|
3 ##
|
|
|
4 ## Copyright 1996-2017 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 # Generate a perfect hash for directive parsing
|
|
|
37 #
|
|
|
38 # Usage:
|
|
|
39 # directiv.pl h directiv.dat directiv.h (to generate C header)
|
|
|
40 # directiv.pl c directiv.dat directbl.c (to generate C source)
|
|
|
41 #
|
|
|
42
|
|
|
43 require 'phash.ph';
|
|
|
44
|
|
|
45 my($output, $directives_dat, $outfile) = @ARGV;
|
|
|
46
|
|
|
47 @directives = ();
|
|
|
48
|
|
|
49 # Special values for enum directives. Note that D_none must be first
|
|
|
50 # so D_none == 0.
|
|
|
51 @specials = ('none', 'unknown', 'corrupt');
|
|
|
52
|
|
|
53 open(DD, "< ${directives_dat}\0")
|
|
|
54 or die "$0: cannot open: ${directives_dat}: $!\n";
|
|
|
55 while (defined($line = <DD>)) {
|
|
|
56 chomp $line;
|
|
|
57 if ($line =~ /^\s*([[:alnum:]_]+)\s*(|[\;\#].*)$/) {
|
|
|
58 push(@directives, $1);
|
|
|
59 }
|
|
|
60 }
|
|
|
61 close(DD);
|
|
|
62
|
|
|
63 if ($output eq 'h') {
|
|
|
64 open(H, "> ${outfile}\0")
|
|
|
65 or die "$0: cannot create: ${outfile}: $!\n";
|
|
|
66
|
|
|
67 print H "/*\n";
|
|
|
68 print H " * This file is generated from directiv.dat\n";
|
|
|
69 print H " * by directiv.pl; do not edit.\n";
|
|
|
70 print H " */\n";
|
|
|
71 print H "\n";
|
|
|
72
|
|
|
73 print H "#ifndef NASM_DIRECTIV_H\n";
|
|
|
74 print H "#define NASM_DIRECTIV_H\n";
|
|
|
75 print H "\n";
|
|
|
76
|
|
|
77 $c = '{';
|
|
|
78 print H "enum directives ";
|
|
|
79 foreach $d (@specials) {
|
|
|
80 print H "$c\n D_$d";
|
|
|
81 $c = ',';
|
|
|
82 }
|
|
|
83 foreach $d (@directives) {
|
|
|
84 print H "$c\n D_\U$d";
|
|
|
85 $c = ',';
|
|
|
86 }
|
|
|
87 print H "\n};\n\n";
|
|
|
88 printf H "extern const char * const directives[%d];\n",
|
|
|
89 scalar(@directives)+scalar(@specials);
|
|
|
90 print H "enum directives find_directive(const char *token);\n\n";
|
|
|
91 print H "#endif /* NASM_DIRECTIV_H */\n";
|
|
|
92 } elsif ($output eq 'c') {
|
|
|
93 %directive = ();
|
|
|
94 $n = 0;
|
|
|
95 foreach $d (@directives) {
|
|
|
96 if (exists($directive{$d})) {
|
|
|
97 die "$0: $directives_dat: duplicate directive: $d\n";
|
|
|
98 }
|
|
|
99 $directive{$d} = $n++; # This is zero-based, unlike the enum!
|
|
|
100 }
|
|
|
101
|
|
|
102 @hashinfo = gen_perfect_hash(\%directive);
|
|
|
103 if (!@hashinfo) {
|
|
|
104 die "$0: no hash found\n";
|
|
|
105 }
|
|
|
106
|
|
|
107 # Paranoia...
|
|
|
108 verify_hash_table(\%directive, \@hashinfo);
|
|
|
109
|
|
|
110 ($n, $sv, $g) = @hashinfo;
|
|
|
111
|
|
|
112 die if ($n & ($n-1));
|
|
|
113
|
|
|
114 open(C, "> ${outfile}\0")
|
|
|
115 or die "$0: cannot create: ${directives_c}: $!\n";
|
|
|
116
|
|
|
117 print C "/*\n";
|
|
|
118 print C " * This file is generated from directiv.dat\n";
|
|
|
119 print C " * by directiv.pl; do not edit.\n";
|
|
|
120 print C " */\n";
|
|
|
121 print C "\n";
|
|
|
122
|
|
|
123 print C "#include \"compiler.h\"\n";
|
|
|
124 print C "#include <string.h>\n";
|
|
|
125 print C "#include \"nasm.h\"\n";
|
|
|
126 print C "#include \"hashtbl.h\"\n";
|
|
|
127 print C "#include \"directiv.h\"\n";
|
|
|
128 print C "\n";
|
|
|
129
|
|
|
130 printf C "const char * const directives[%d] =\n",
|
|
|
131 scalar(@directives)+scalar(@specials);
|
|
|
132 $c = '{';
|
|
|
133 foreach $d (@specials) {
|
|
|
134 print C "$c\n NULL";
|
|
|
135 $c = ',';
|
|
|
136 }
|
|
|
137 foreach $d (@directives) {
|
|
|
138 print C "$c\n \"$d\"";
|
|
|
139 $c = ',';
|
|
|
140 }
|
|
|
141 print C "\n};\n\n";
|
|
|
142
|
|
|
143 print C "enum directives find_directive(const char *token)\n";
|
|
|
144 print C "{\n";
|
|
|
145
|
|
|
146 # Put a large value in unused slots. This makes it extremely unlikely
|
|
|
147 # that any combination that involves unused slot will pass the range test.
|
|
|
148 # This speeds up rejection of unrecognized tokens, i.e. identifiers.
|
|
|
149 print C "#define UNUSED (65535/3)\n";
|
|
|
150
|
|
|
151 print C " static const int16_t hash1[$n] = {\n";
|
|
|
152 for ($i = 0; $i < $n; $i++) {
|
|
|
153 my $h = ${$g}[$i*2+0];
|
|
|
154 print C " ", defined($h) ? $h : 'UNUSED', ",\n";
|
|
|
155 }
|
|
|
156 print C " };\n";
|
|
|
157
|
|
|
158 print C " static const int16_t hash2[$n] = {\n";
|
|
|
159 for ($i = 0; $i < $n; $i++) {
|
|
|
160 my $h = ${$g}[$i*2+1];
|
|
|
161 print C " ", defined($h) ? $h : 'UNUSED', ",\n";
|
|
|
162 }
|
|
|
163 print C " };\n";
|
|
|
164
|
|
|
165 print C " uint32_t k1, k2;\n";
|
|
|
166 print C " uint64_t crc;\n";
|
|
|
167 # For correct overflow behavior, "ix" should be unsigned of the same
|
|
|
168 # width as the hash arrays.
|
|
|
169 print C " uint16_t ix;\n";
|
|
|
170 print C "\n";
|
|
|
171 printf C " crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
|
|
|
172 $$sv[0], $$sv[1];
|
|
|
173 print C " k1 = (uint32_t)crc;\n";
|
|
|
174 print C " k2 = (uint32_t)(crc >> 32);\n";
|
|
|
175 print C "\n";
|
|
|
176 printf C " ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
|
|
|
177 printf C " if (ix >= %d)\n", scalar(@directives);
|
|
|
178 print C " return D_unknown;\n";
|
|
|
179 print C "\n";
|
|
|
180 printf C " ix += %d;\n", scalar(@specials);
|
|
|
181 print C " if (nasm_stricmp(token, directives[ix]))\n";
|
|
|
182 print C " return D_unknown;\n";
|
|
|
183 print C "\n";
|
|
|
184 print C " return ix;\n";
|
|
|
185 print C "}\n";
|
|
|
186 }
|
