]>
Commit | Line | Data |
---|---|---|
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 = (); | |
44 | ||
45 | my $inside = 0; | |
46 | my $name; | |
47 | my $pefectHashSize; | |
48 | my $compactSize; | |
49 | my $compactHashSizeMask; | |
50 | my $banner = 0; | |
51 | sub calcPerfectHashSize(); | |
52 | sub calcCompactHashSize(); | |
53 | sub output(); | |
54 | sub jsc_ucfirst($); | |
55 | sub hashValue($); | |
56 | ||
57 | while (<IN>) { | |
58 | chomp; | |
59 | s/^\s+//; | |
60 | next if /^\#|^$/; # Comment or blank line. Do nothing. | |
61 | if (/^\@begin/ && !$inside) { | |
62 | if (/^\@begin\s*([:_\w]+)\s*\d*\s*$/) { | |
63 | $inside = 1; | |
64 | $name = $1; | |
65 | } else { | |
66 | print STDERR "WARNING: \@begin without table name, skipping $_\n"; | |
67 | } | |
68 | } elsif (/^\@end\s*$/ && $inside) { | |
69 | calcPerfectHashSize(); | |
70 | calcCompactHashSize(); | |
71 | output(); | |
72 | ||
73 | @keys = (); | |
74 | @attrs = (); | |
75 | @values = (); | |
76 | @hashes = (); | |
77 | ||
78 | $inside = 0; | |
79 | } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*$/ && $inside) { | |
80 | my $key = $1; | |
81 | my $val = $2; | |
82 | my $att = $3; | |
83 | my $param = $4; | |
84 | ||
85 | push(@keys, $key); | |
86 | push(@attrs, length($att) > 0 ? $att : "0"); | |
87 | ||
88 | if ($att =~ m/Function/) { | |
89 | push(@values, { "type" => "Function", "function" => $val, "params" => (length($param) ? $param : "") }); | |
90 | #printf STDERR "WARNING: Number of arguments missing for $key/$val\n" if (length($param) == 0); | |
91 | } elsif (length($att)) { | |
92 | my $get = $val; | |
93 | my $put = !($att =~ m/ReadOnly/) ? "set" . jsc_ucfirst($val) : "0"; | |
94 | push(@values, { "type" => "Property", "get" => $get, "put" => $put }); | |
95 | } else { | |
96 | push(@values, { "type" => "Lexer", "value" => $val }); | |
97 | } | |
98 | push(@hashes, hashValue($key)); | |
99 | } elsif ($inside) { | |
100 | die "invalid data {" . $_ . "}"; | |
101 | } | |
102 | } | |
103 | ||
104 | die "missing closing \@end" if ($inside); | |
105 | ||
106 | sub jsc_ucfirst($) | |
107 | { | |
108 | my ($value) = @_; | |
109 | ||
110 | if ($value =~ /js/) { | |
111 | $value =~ s/js/JS/; | |
112 | return $value; | |
113 | } | |
114 | ||
115 | return ucfirst($value); | |
116 | } | |
117 | ||
118 | ||
119 | sub ceilingToPowerOf2 | |
120 | { | |
121 | my ($pefectHashSize) = @_; | |
122 | ||
123 | my $powerOf2 = 1; | |
124 | while ($pefectHashSize > $powerOf2) { | |
125 | $powerOf2 <<= 1; | |
126 | } | |
127 | ||
128 | return $powerOf2; | |
129 | } | |
130 | ||
131 | sub calcPerfectHashSize() | |
132 | { | |
133 | tableSizeLoop: | |
134 | for ($pefectHashSize = ceilingToPowerOf2(scalar @keys); ; $pefectHashSize += $pefectHashSize) { | |
135 | my @table = (); | |
136 | foreach my $key (@keys) { | |
137 | my $h = hashValue($key) % $pefectHashSize; | |
138 | next tableSizeLoop if $table[$h]; | |
139 | $table[$h] = 1; | |
140 | } | |
141 | last; | |
142 | } | |
143 | } | |
144 | ||
145 | sub leftShift($$) { | |
146 | my ($value, $distance) = @_; | |
147 | return (($value << $distance) & 0xFFFFFFFF); | |
148 | } | |
149 | ||
150 | sub calcCompactHashSize() | |
151 | { | |
152 | my @table = (); | |
153 | my @links = (); | |
154 | my $compactHashSize = ceilingToPowerOf2(2 * @keys); | |
155 | $compactHashSizeMask = $compactHashSize - 1; | |
156 | $compactSize = $compactHashSize; | |
157 | my $collisions = 0; | |
158 | my $maxdepth = 0; | |
159 | my $i = 0; | |
160 | foreach my $key (@keys) { | |
161 | my $depth = 0; | |
162 | my $h = hashValue($key) % $compactHashSize; | |
163 | while (defined($table[$h])) { | |
164 | if (defined($links[$h])) { | |
165 | $h = $links[$h]; | |
166 | $depth++; | |
167 | } else { | |
168 | $collisions++; | |
169 | $links[$h] = $compactSize; | |
170 | $h = $compactSize; | |
171 | $compactSize++; | |
172 | } | |
173 | } | |
174 | $table[$h] = $i; | |
175 | $i++; | |
176 | $maxdepth = $depth if ( $depth > $maxdepth); | |
177 | } | |
178 | } | |
179 | ||
180 | # Paul Hsieh's SuperFastHash | |
181 | # http://www.azillionmonkeys.com/qed/hash.html | |
182 | # Ported from UString.. | |
183 | sub hashValue($) { | |
184 | my @chars = split(/ */, $_[0]); | |
185 | ||
186 | # This hash is designed to work on 16-bit chunks at a time. But since the normal case | |
187 | # (above) is to hash UTF-16 characters, we just treat the 8-bit chars as if they | |
188 | # were 16-bit chunks, which should give matching results | |
189 | ||
190 | my $EXP2_32 = 4294967296; | |
191 | ||
192 | my $hash = 0x9e3779b9; | |
193 | my $l = scalar @chars; #I wish this was in Ruby --- Maks | |
194 | my $rem = $l & 1; | |
195 | $l = $l >> 1; | |
196 | ||
197 | my $s = 0; | |
198 | ||
199 | # Main loop | |
200 | for (; $l > 0; $l--) { | |
201 | $hash += ord($chars[$s]); | |
202 | my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash; | |
203 | $hash = (leftShift($hash, 16)% $EXP2_32) ^ $tmp; | |
204 | $s += 2; | |
205 | $hash += $hash >> 11; | |
206 | $hash %= $EXP2_32; | |
207 | } | |
208 | ||
209 | # Handle end case | |
210 | if ($rem !=0) { | |
211 | $hash += ord($chars[$s]); | |
212 | $hash ^= (leftShift($hash, 11)% $EXP2_32); | |
213 | $hash += $hash >> 17; | |
214 | } | |
215 | ||
216 | # Force "avalanching" of final 127 bits | |
217 | $hash ^= leftShift($hash, 3); | |
218 | $hash += ($hash >> 5); | |
219 | $hash = ($hash% $EXP2_32); | |
220 | $hash ^= (leftShift($hash, 2)% $EXP2_32); | |
221 | $hash += ($hash >> 15); | |
222 | $hash = $hash% $EXP2_32; | |
223 | $hash ^= (leftShift($hash, 10)% $EXP2_32); | |
224 | ||
225 | # this avoids ever returning a hash code of 0, since that is used to | |
226 | # signal "hash not computed yet", using a value that is likely to be | |
227 | # effectively the same as 0 when the low bits are masked | |
228 | $hash = 0x80000000 if ($hash == 0); | |
229 | ||
230 | return $hash; | |
231 | } | |
232 | ||
233 | sub output() { | |
234 | if (!$banner) { | |
235 | $banner = 1; | |
236 | print "// Automatically generated from $file using $0. DO NOT EDIT!\n"; | |
237 | } | |
238 | ||
239 | my $nameEntries = "${name}Values"; | |
240 | $nameEntries =~ s/:/_/g; | |
241 | ||
242 | print "\n#include \"Lookup.h\"\n" if ($includelookup); | |
243 | if ($useNameSpace) { | |
244 | print "\nnamespace ${useNameSpace} {\n"; | |
245 | print "\nusing namespace JSC;\n"; | |
246 | } else { | |
247 | print "\nnamespace JSC {\n"; | |
248 | } | |
249 | my $count = scalar @keys + 1; | |
250 | print "#if ENABLE(JIT)\n"; | |
251 | print "#define THUNK_GENERATOR(generator) , generator\n"; | |
252 | print "#else\n"; | |
253 | print "#define THUNK_GENERATOR(generator)\n"; | |
254 | print "#endif\n"; | |
255 | print "\nstatic const struct HashTableValue ${nameEntries}\[$count\] = {\n"; | |
256 | my $i = 0; | |
257 | foreach my $key (@keys) { | |
258 | my $firstValue = ""; | |
259 | my $secondValue = ""; | |
260 | my $castStr = ""; | |
261 | ||
262 | if ($values[$i]{"type"} eq "Function") { | |
263 | $castStr = "static_cast<NativeFunction>"; | |
264 | $firstValue = $values[$i]{"function"}; | |
265 | $secondValue = $values[$i]{"params"}; | |
266 | } elsif ($values[$i]{"type"} eq "Property") { | |
267 | $castStr = "static_cast<PropertySlot::GetValueFunc>"; | |
268 | $firstValue = $values[$i]{"get"}; | |
269 | $secondValue = $values[$i]{"put"}; | |
270 | } elsif ($values[$i]{"type"} eq "Lexer") { | |
271 | $firstValue = $values[$i]{"value"}; | |
272 | $secondValue = "0"; | |
273 | } | |
274 | my $thunkGenerator = "0"; | |
275 | if ($key eq "charCodeAt") { | |
276 | $thunkGenerator = "charCodeAtThunkGenerator"; | |
277 | } | |
278 | if ($key eq "charAt") { | |
279 | $thunkGenerator = "charAtThunkGenerator"; | |
280 | } | |
281 | if ($key eq "sqrt") { | |
282 | $thunkGenerator = "sqrtThunkGenerator"; | |
283 | } | |
284 | if ($key eq "pow") { | |
285 | $thunkGenerator = "powThunkGenerator"; | |
286 | } | |
287 | print " { \"$key\", $attrs[$i], (intptr_t)" . $castStr . "($firstValue), (intptr_t)$secondValue THUNK_GENERATOR($thunkGenerator) },\n"; | |
288 | $i++; | |
289 | } | |
290 | print " { 0, 0, 0, 0 THUNK_GENERATOR(0) }\n"; | |
291 | print "};\n\n"; | |
292 | print "#undef THUNK_GENERATOR\n"; | |
293 | print "extern JSC_CONST_HASHTABLE HashTable $name =\n"; | |
294 | print " \{ $compactSize, $compactHashSizeMask, $nameEntries, 0 \};\n"; | |
295 | print "} // namespace\n"; | |
296 | } |