]>
Commit | Line | Data |
---|---|---|
9dae56ea A |
1 | #! /usr/bin/perl -w |
2 | # | |
3 | # Static Hashtable Generator | |
4 | # | |
5 | # (c) 2000-2002 by Harri Porten <porten@kde.org> and | |
6 | # David Faure <faure@kde.org> | |
7 | # Modified (c) 2004 by Nikolas Zimmermann <wildfox@kde.org> | |
8 | # Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved. | |
9 | # | |
10 | # This library is free software; you can redistribute it and/or | |
11 | # modify it under the terms of the GNU Lesser General Public | |
12 | # License as published by the Free Software Foundation; either | |
13 | # version 2 of the License, or (at your option) any later version. | |
14 | # | |
15 | # This library is distributed in the hope that it will be useful, | |
16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
18 | # Lesser General Public License for more details. | |
19 | # | |
20 | # You should have received a copy of the GNU Lesser General Public | |
21 | # License along with this library; if not, write to the Free Software | |
22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
23 | # | |
24 | ||
25 | use strict; | |
26 | ||
27 | my $file = $ARGV[0]; | |
28 | shift; | |
29 | my $includelookup = 0; | |
30 | ||
31 | # Use -i as second argument to make it include "Lookup.h" | |
32 | $includelookup = 1 if (defined($ARGV[0]) && $ARGV[0] eq "-i"); | |
33 | ||
34 | # Use -n as second argument to make it use the third argument as namespace parameter ie. -n KDOM | |
35 | my $useNameSpace = $ARGV[1] if (defined($ARGV[0]) && $ARGV[0] eq "-n"); | |
36 | ||
37 | print STDERR "Creating hashtable for $file\n"; | |
38 | open(IN, $file) or die "No such file $file"; | |
39 | ||
40 | my @keys = (); | |
41 | my @attrs = (); | |
42 | my @values = (); | |
43 | my @hashes = (); | |
81345200 A |
44 | my @table = (); |
45 | my @links = (); | |
46 | ||
47 | my $hasSetter = "false"; | |
9dae56ea A |
48 | |
49 | my $inside = 0; | |
50 | my $name; | |
51 | my $pefectHashSize; | |
52 | my $compactSize; | |
53 | my $compactHashSizeMask; | |
54 | my $banner = 0; | |
55 | sub calcPerfectHashSize(); | |
56 | sub calcCompactHashSize(); | |
57 | sub output(); | |
58 | sub jsc_ucfirst($); | |
59 | sub hashValue($); | |
60 | ||
61 | while (<IN>) { | |
62 | chomp; | |
63 | s/^\s+//; | |
64 | next if /^\#|^$/; # Comment or blank line. Do nothing. | |
65 | if (/^\@begin/ && !$inside) { | |
66 | if (/^\@begin\s*([:_\w]+)\s*\d*\s*$/) { | |
67 | $inside = 1; | |
68 | $name = $1; | |
69 | } else { | |
70 | print STDERR "WARNING: \@begin without table name, skipping $_\n"; | |
71 | } | |
72 | } elsif (/^\@end\s*$/ && $inside) { | |
73 | calcPerfectHashSize(); | |
74 | calcCompactHashSize(); | |
75 | output(); | |
76 | ||
77 | @keys = (); | |
78 | @attrs = (); | |
79 | @values = (); | |
80 | @hashes = (); | |
81345200 A |
81 | @table = (); |
82 | @links = (); | |
9dae56ea A |
83 | |
84 | $inside = 0; | |
85 | } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*$/ && $inside) { | |
86 | my $key = $1; | |
87 | my $val = $2; | |
88 | my $att = $3; | |
89 | my $param = $4; | |
90 | ||
91 | push(@keys, $key); | |
92 | push(@attrs, length($att) > 0 ? $att : "0"); | |
93 | ||
94 | if ($att =~ m/Function/) { | |
95 | push(@values, { "type" => "Function", "function" => $val, "params" => (length($param) ? $param : "") }); | |
96 | #printf STDERR "WARNING: Number of arguments missing for $key/$val\n" if (length($param) == 0); | |
ed1e77d3 A |
97 | } elsif ($att =~ m/Accessor/) { |
98 | my $get = $val; | |
99 | my $put = "nullptr"; | |
100 | $hasSetter = "true"; | |
101 | push(@values, { "type" => "Accessor", "get" => $get, "put" => $put }); | |
9dae56ea A |
102 | } elsif (length($att)) { |
103 | my $get = $val; | |
81345200 A |
104 | my $put = "0"; |
105 | if (!($att =~ m/ReadOnly/)) { | |
106 | $put = "set" . jsc_ucfirst($val); | |
107 | } | |
108 | $hasSetter = "true"; | |
9dae56ea A |
109 | push(@values, { "type" => "Property", "get" => $get, "put" => $put }); |
110 | } else { | |
111 | push(@values, { "type" => "Lexer", "value" => $val }); | |
112 | } | |
113 | push(@hashes, hashValue($key)); | |
114 | } elsif ($inside) { | |
115 | die "invalid data {" . $_ . "}"; | |
116 | } | |
117 | } | |
118 | ||
119 | die "missing closing \@end" if ($inside); | |
120 | ||
121 | sub jsc_ucfirst($) | |
122 | { | |
123 | my ($value) = @_; | |
124 | ||
125 | if ($value =~ /js/) { | |
126 | $value =~ s/js/JS/; | |
127 | return $value; | |
128 | } | |
129 | ||
130 | return ucfirst($value); | |
131 | } | |
132 | ||
133 | ||
134 | sub ceilingToPowerOf2 | |
135 | { | |
136 | my ($pefectHashSize) = @_; | |
137 | ||
138 | my $powerOf2 = 1; | |
139 | while ($pefectHashSize > $powerOf2) { | |
140 | $powerOf2 <<= 1; | |
141 | } | |
142 | ||
143 | return $powerOf2; | |
144 | } | |
145 | ||
146 | sub calcPerfectHashSize() | |
147 | { | |
148 | tableSizeLoop: | |
149 | for ($pefectHashSize = ceilingToPowerOf2(scalar @keys); ; $pefectHashSize += $pefectHashSize) { | |
150 | my @table = (); | |
151 | foreach my $key (@keys) { | |
152 | my $h = hashValue($key) % $pefectHashSize; | |
153 | next tableSizeLoop if $table[$h]; | |
154 | $table[$h] = 1; | |
155 | } | |
156 | last; | |
157 | } | |
158 | } | |
159 | ||
160 | sub leftShift($$) { | |
161 | my ($value, $distance) = @_; | |
162 | return (($value << $distance) & 0xFFFFFFFF); | |
163 | } | |
164 | ||
165 | sub calcCompactHashSize() | |
166 | { | |
9dae56ea A |
167 | my $compactHashSize = ceilingToPowerOf2(2 * @keys); |
168 | $compactHashSizeMask = $compactHashSize - 1; | |
169 | $compactSize = $compactHashSize; | |
170 | my $collisions = 0; | |
171 | my $maxdepth = 0; | |
172 | my $i = 0; | |
173 | foreach my $key (@keys) { | |
174 | my $depth = 0; | |
175 | my $h = hashValue($key) % $compactHashSize; | |
176 | while (defined($table[$h])) { | |
177 | if (defined($links[$h])) { | |
178 | $h = $links[$h]; | |
179 | $depth++; | |
180 | } else { | |
181 | $collisions++; | |
182 | $links[$h] = $compactSize; | |
183 | $h = $compactSize; | |
184 | $compactSize++; | |
185 | } | |
186 | } | |
187 | $table[$h] = $i; | |
188 | $i++; | |
189 | $maxdepth = $depth if ( $depth > $maxdepth); | |
190 | } | |
191 | } | |
192 | ||
193 | # Paul Hsieh's SuperFastHash | |
194 | # http://www.azillionmonkeys.com/qed/hash.html | |
9dae56ea A |
195 | sub hashValue($) { |
196 | my @chars = split(/ */, $_[0]); | |
197 | ||
198 | # This hash is designed to work on 16-bit chunks at a time. But since the normal case | |
199 | # (above) is to hash UTF-16 characters, we just treat the 8-bit chars as if they | |
200 | # were 16-bit chunks, which should give matching results | |
201 | ||
202 | my $EXP2_32 = 4294967296; | |
203 | ||
204 | my $hash = 0x9e3779b9; | |
205 | my $l = scalar @chars; #I wish this was in Ruby --- Maks | |
206 | my $rem = $l & 1; | |
207 | $l = $l >> 1; | |
208 | ||
209 | my $s = 0; | |
210 | ||
211 | # Main loop | |
212 | for (; $l > 0; $l--) { | |
213 | $hash += ord($chars[$s]); | |
214 | my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash; | |
215 | $hash = (leftShift($hash, 16)% $EXP2_32) ^ $tmp; | |
216 | $s += 2; | |
217 | $hash += $hash >> 11; | |
218 | $hash %= $EXP2_32; | |
219 | } | |
220 | ||
221 | # Handle end case | |
6fe7ccc8 | 222 | if ($rem != 0) { |
9dae56ea A |
223 | $hash += ord($chars[$s]); |
224 | $hash ^= (leftShift($hash, 11)% $EXP2_32); | |
225 | $hash += $hash >> 17; | |
226 | } | |
227 | ||
228 | # Force "avalanching" of final 127 bits | |
229 | $hash ^= leftShift($hash, 3); | |
230 | $hash += ($hash >> 5); | |
231 | $hash = ($hash% $EXP2_32); | |
232 | $hash ^= (leftShift($hash, 2)% $EXP2_32); | |
233 | $hash += ($hash >> 15); | |
234 | $hash = $hash% $EXP2_32; | |
235 | $hash ^= (leftShift($hash, 10)% $EXP2_32); | |
6fe7ccc8 A |
236 | |
237 | # Save 8 bits for StringImpl to use as flags. | |
238 | $hash &= 0xffffff; | |
239 | ||
240 | # This avoids ever returning a hash code of 0, since that is used to | |
241 | # signal "hash not computed yet". Setting the high bit maintains | |
242 | # reasonable fidelity to a hash code of 0 because it is likely to yield | |
243 | # exactly 0 when hash lookup masks out the high bits. | |
244 | $hash = (0x80000000 >> 8) if ($hash == 0); | |
9dae56ea A |
245 | |
246 | return $hash; | |
247 | } | |
248 | ||
249 | sub output() { | |
250 | if (!$banner) { | |
251 | $banner = 1; | |
252 | print "// Automatically generated from $file using $0. DO NOT EDIT!\n"; | |
253 | } | |
254 | ||
255 | my $nameEntries = "${name}Values"; | |
256 | $nameEntries =~ s/:/_/g; | |
81345200 A |
257 | my $nameIndex = "${name}Index"; |
258 | $nameIndex =~ s/:/_/g; | |
9dae56ea | 259 | |
81345200 | 260 | print "\n#include \"JSCBuiltins.h\"\n"; |
9dae56ea | 261 | print "\n#include \"Lookup.h\"\n" if ($includelookup); |
81345200 | 262 | |
9dae56ea A |
263 | if ($useNameSpace) { |
264 | print "\nnamespace ${useNameSpace} {\n"; | |
265 | print "\nusing namespace JSC;\n"; | |
266 | } else { | |
267 | print "\nnamespace JSC {\n"; | |
268 | } | |
81345200 A |
269 | |
270 | print "\nstatic const struct CompactHashIndex ${nameIndex}\[$compactSize\] = {\n"; | |
271 | for (my $i = 0; $i < $compactSize; $i++) { | |
272 | my $T = -1; | |
273 | if (defined($table[$i])) { $T = $table[$i]; } | |
274 | my $L = -1; | |
275 | if (defined($links[$i])) { $L = $links[$i]; } | |
276 | print " { $T, $L },\n"; | |
277 | } | |
278 | print "};\n\n"; | |
279 | ||
280 | my $packedSize = scalar @keys; | |
281 | print "\nstatic const struct HashTableValue ${nameEntries}\[$packedSize\] = {\n"; | |
9dae56ea A |
282 | my $i = 0; |
283 | foreach my $key (@keys) { | |
284 | my $firstValue = ""; | |
285 | my $secondValue = ""; | |
81345200 A |
286 | my $firstCastStr = ""; |
287 | my $secondCastStr = ""; | |
9dae56ea A |
288 | |
289 | if ($values[$i]{"type"} eq "Function") { | |
81345200 | 290 | $firstCastStr = "static_cast<NativeFunction>"; |
9dae56ea A |
291 | $firstValue = $values[$i]{"function"}; |
292 | $secondValue = $values[$i]{"params"}; | |
ed1e77d3 A |
293 | } elsif ($values[$i]{"type"} eq "Accessor") { |
294 | $firstCastStr = "static_cast<NativeFunction>"; | |
295 | $secondCastStr = "static_cast<NativeFunction>"; | |
296 | $firstValue = $values[$i]{"get"}; | |
297 | $secondValue = $values[$i]{"put"}; | |
9dae56ea | 298 | } elsif ($values[$i]{"type"} eq "Property") { |
81345200 A |
299 | $firstCastStr = "static_cast<PropertySlot::GetValueFunc>"; |
300 | $secondCastStr = "static_cast<PutPropertySlot::PutValueFunc>"; | |
9dae56ea A |
301 | $firstValue = $values[$i]{"get"}; |
302 | $secondValue = $values[$i]{"put"}; | |
303 | } elsif ($values[$i]{"type"} eq "Lexer") { | |
304 | $firstValue = $values[$i]{"value"}; | |
305 | $secondValue = "0"; | |
306 | } | |
6fe7ccc8 A |
307 | |
308 | my $intrinsic = "NoIntrinsic"; | |
6fe7ccc8 | 309 | $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode"); |
6fe7ccc8 A |
310 | if ($name eq "arrayPrototypeTable") { |
311 | $intrinsic = "ArrayPushIntrinsic" if ($key eq "push"); | |
312 | $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop"); | |
4e4e5a6f | 313 | } |
6fe7ccc8 A |
314 | if ($name eq "regExpPrototypeTable") { |
315 | $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec"); | |
316 | $intrinsic = "RegExpTestIntrinsic" if ($key eq "test"); | |
14957cd0 | 317 | } |
6fe7ccc8 | 318 | |
81345200 A |
319 | if ($values[$i]{"type"} eq "Function") { |
320 | my $tableHead = $name; | |
321 | $tableHead =~ s/Table$//; | |
322 | print " #if JSC_BUILTIN_EXISTS(" . uc($tableHead . $key) .")\n"; | |
323 | print " { \"$key\", (($attrs[$i]) & ~Function) | Builtin, $intrinsic, (intptr_t)static_cast<BuiltinGenerator>(" . $tableHead . ucfirst($key) . "CodeGenerator), (intptr_t)$secondValue },\n"; | |
324 | print " #else\n" | |
325 | } | |
326 | print " { \"$key\", $attrs[$i], $intrinsic, (intptr_t)" . $firstCastStr . "($firstValue), (intptr_t)" . $secondCastStr . "($secondValue) },\n"; | |
327 | if ($values[$i]{"type"} eq "Function") { | |
328 | print " #endif\n" | |
329 | } | |
9dae56ea A |
330 | $i++; |
331 | } | |
9dae56ea | 332 | print "};\n\n"; |
ed1e77d3 | 333 | print "JS_EXPORT_PRIVATE extern const struct HashTable $name =\n"; |
81345200 | 334 | print " \{ $packedSize, $compactHashSizeMask, $hasSetter, $nameEntries, 0, $nameIndex \};\n"; |
9dae56ea A |
335 | print "} // namespace\n"; |
336 | } |