Mercurial > repo

comparison nasmbuild/nasm-2.13rc9/asm/pptok.pl @ 10554:587a0a262d22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<moonythedwarf> ` cd nasmbuild; tar -xf nasm.tar.gz
author HackBot
date Thu, 30 Mar 2017 20:58:41 +0000
parents
children
comparison
equal deleted inserted replaced
10553:93dc2a984de0 10554:587a0a262d22
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:
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 # Produce pptok.c, pptok.h and pptok.ph from pptok.dat
37 #
38
39 require 'phash.ph';
40
41 my($what, $in, $out) = @ARGV;
42
43 #
44 # Read pptok.dat
45 #
46 open(IN, "< $in") or die "$0: cannot open: $in\n";
47 while (defined($line = <IN>)) {
48 $line =~ s/\r?\n$//; # Remove trailing \r\n or \n
49 $line =~ s/^\s+//; # Remove leading whitespace
50 $line =~ s/\s*\#.*$//; # Remove comments and trailing whitespace
51 next if ($line eq '');
52
53 if ($line =~ /^\%(.*)\*$/) {
54 push(@cctok, $1);
55 } elsif ($line =~ /^\%(.*)$/) {
56 push(@pptok, $1);
57 } elsif ($line =~ /^\*(.*)$/) {
58 push(@cond, $1);
59 }
60 }
61 close(IN);
62
63 @cctok = sort @cctok;
64 @cond = sort @cond;
65 @pptok = sort @pptok;
66
67 # Generate the expanded list including conditionals. The conditionals
68 # are at the beginning, padded to a power of 2, with the inverses
69 # interspersed; this allows a simple mask to pick out the condition.
70
71 while ((scalar @cond) & (scalar @cond)-1) {
72 push(@cond, undef);
73 }
74
75 @cptok = ();
76 foreach $ct (@cctok) {
77 foreach $cc (@cond) {
78 if (defined($cc)) {
79 push(@cptok, $ct.$cc);
80 push(@cptok, $ct.'n'.$cc);
81 } else {
82 push(@cptok, undef, undef);
83 }
84 }
85 }
86 $first_uncond = $pptok[0];
87 @pptok = (@cptok, @pptok);
88
89 open(OUT, "> $out") or die "$0: cannot open: $out\n";
90
91 #
92 # Output pptok.h
93 #
94 if ($what eq 'h') {
95 print OUT "/* Automatically generated from $in by $0 */\n";
96 print OUT "/* Do not edit */\n";
97 print OUT "\n";
98
99 print OUT "enum preproc_token {\n";
100 $n = 0;
101 foreach $pt (@pptok) {
102 if (defined($pt)) {
103 printf OUT " %-16s = %3d,\n", "PP_\U$pt\E", $n;
104 }
105 $n++;
106 }
107 printf OUT " %-16s = %3d\n", 'PP_INVALID', -1;
108 print OUT "};\n";
109 print OUT "\n";
110
111 print OUT "enum pp_conditional {\n";
112 $n = 0;
113 $c = '';
114 foreach $cc (@cond) {
115 if (defined($cc)) {
116 printf OUT "$c %-16s = %3d", "PPC_IF\U$cc\E", $n;
117 $c = ',';
118 }
119 $n += 2;
120 }
121 print OUT "\n};\n\n";
122
123 printf OUT "#define PP_COND(x) ((enum pp_conditional)((x) & 0x%x))\n",
124 (scalar(@cond)-1) << 1;
125 print OUT "#define PP_IS_COND(x) ((unsigned int)(x) < PP_\U$first_uncond\E)\n";
126 print OUT "#define PP_NEGATIVE(x) ((x) & 1)\n";
127 print OUT "\n";
128
129 foreach $ct (@cctok) {
130 print OUT "#define CASE_PP_\U$ct\E";
131 $pref = " \\\n";
132 foreach $cc (@cond) {
133 if (defined($cc)) {
134 print OUT "$pref\tcase PP_\U${ct}${cc}\E: \\\n";
135 print OUT "\tcase PP_\U${ct}N${cc}\E";
136 $pref = ":\\\n";
137 }
138 }
139 print OUT "\n"; # No colon or newline on the last one
140 }
141 }
142
143 #
144 # Output pptok.c
145 #
146 if ($what eq 'c') {
147 print OUT "/* Automatically generated from $in by $0 */\n";
148 print OUT "/* Do not edit */\n";
149 print OUT "\n";
150
151 my %tokens = ();
152 my @tokendata = ();
153
154 my $n = 0;
155 foreach $pt (@pptok) {
156 if (defined($pt)) {
157 $tokens{'%'.$pt} = $n;
158 if ($pt =~ /[\@\[\]\\_]/) {
159 # Fail on characters which look like upper-case letters
160 # to the quick-and-dirty downcasing in the prehash
161 # (see below)
162 die "$in: invalid character in token: $pt";
163 }
164 }
165 $n++;
166 }
167
168 my @hashinfo = gen_perfect_hash(\%tokens);
169 if (!@hashinfo) {
170 die "$0: no hash found\n";
171 }
172
173 # Paranoia...
174 verify_hash_table(\%tokens, \@hashinfo);
175
176 ($n, $sv, $g) = @hashinfo;
177 $sv2 = $sv+2;
178
179 die if ($n & ($n-1));
180
181 print OUT "#include \"compiler.h\"\n";
182 print OUT "#include <ctype.h>\n";
183 print OUT "#include \"nasmlib.h\"\n";
184 print OUT "#include \"hashtbl.h\"\n";
185 print OUT "#include \"preproc.h\"\n";
186 print OUT "\n";
187
188 # Note that this is global.
189 printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
190 foreach $d (@pptok) {
191 if (defined($d)) {
192 print OUT " \"%$d\",\n";
193 } else {
194 print OUT " NULL,\n";
195 }
196 }
197 print OUT "};\n";
198
199 printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
200 foreach $d (@pptok) {
201 printf OUT " %d,\n", defined($d) ? length($d)+1 : 0;
202 }
203 print OUT "};\n";
204
205 print OUT "enum preproc_token pp_token_hash(const char *token)\n";
206 print OUT "{\n";
207
208 # Put a large value in unused slots. This makes it extremely unlikely
209 # that any combination that involves unused slot will pass the range test.
210 # This speeds up rejection of unrecognized tokens, i.e. identifiers.
211 print OUT "#define UNUSED (65535/3)\n";
212
213 print OUT " static const int16_t hash1[$n] = {\n";
214 for ($i = 0; $i < $n; $i++) {
215 my $h = ${$g}[$i*2+0];
216 print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
217 }
218 print OUT " };\n";
219
220 print OUT " static const int16_t hash2[$n] = {\n";
221 for ($i = 0; $i < $n; $i++) {
222 my $h = ${$g}[$i*2+1];
223 print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
224 }
225 print OUT " };\n";
226
227 print OUT " uint32_t k1, k2;\n";
228 print OUT " uint64_t crc;\n";
229 # For correct overflow behavior, "ix" should be unsigned of the same
230 # width as the hash arrays.
231 print OUT " uint16_t ix;\n";
232 print OUT "\n";
233
234 printf OUT " crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
235 $$sv[0], $$sv[1];
236 print OUT " k1 = (uint32_t)crc;\n";
237 print OUT " k2 = (uint32_t)(crc >> 32);\n";
238 print OUT "\n";
239 printf OUT " ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
240 printf OUT " if (ix >= %d)\n", scalar(@pptok);
241 print OUT " return PP_INVALID;\n";
242 print OUT "\n";
243
244 print OUT " if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
245 print OUT " return PP_INVALID;\n";
246 print OUT "\n";
247 print OUT " return ix;\n";
248 print OUT "}\n";
249 }
250
251 #
252 # Output pptok.ph
253 #
254 if ($what eq 'ph') {
255 print OUT "# Automatically generated from $in by $0\n";
256 print OUT "# Do not edit\n";
257 print OUT "\n";
258
259 print OUT "%pptok_hash = (\n";
260 $n = 0;
261 foreach $tok (@pptok) {
262 if (defined($tok)) {
263 printf OUT " '%%%s' => %d,\n", $tok, $n;
264 }
265 $n++;
266 }
267 print OUT ");\n";
268 print OUT "1;\n";
269 }
270
271