]>
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 = (); | |
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 | |
9dae56ea A |
182 | sub hashValue($) { |
183 | my @chars = split(/ */, $_[0]); | |
184 | ||
185 | # This hash is designed to work on 16-bit chunks at a time. But since the normal case | |
186 | # (above) is to hash UTF-16 characters, we just treat the 8-bit chars as if they | |
187 | # were 16-bit chunks, which should give matching results | |
188 | ||
189 | my $EXP2_32 = 4294967296; | |
190 | ||
191 | my $hash = 0x9e3779b9; | |
192 | my $l = scalar @chars; #I wish this was in Ruby --- Maks | |
193 | my $rem = $l & 1; | |
194 | $l = $l >> 1; | |
195 | ||
196 | my $s = 0; | |
197 | ||
198 | # Main loop | |
199 | for (; $l > 0; $l--) { | |
200 | $hash += ord($chars[$s]); | |
201 | my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash; | |
202 | $hash = (leftShift($hash, 16)% $EXP2_32) ^ $tmp; | |
203 | $s += 2; | |
204 | $hash += $hash >> 11; | |
205 | $hash %= $EXP2_32; | |
206 | } | |
207 | ||
208 | # Handle end case | |
6fe7ccc8 | 209 | if ($rem != 0) { |
9dae56ea A |
210 | $hash += ord($chars[$s]); |
211 | $hash ^= (leftShift($hash, 11)% $EXP2_32); | |
212 | $hash += $hash >> 17; | |
213 | } | |
214 | ||
215 | # Force "avalanching" of final 127 bits | |
216 | $hash ^= leftShift($hash, 3); | |
217 | $hash += ($hash >> 5); | |
218 | $hash = ($hash% $EXP2_32); | |
219 | $hash ^= (leftShift($hash, 2)% $EXP2_32); | |
220 | $hash += ($hash >> 15); | |
221 | $hash = $hash% $EXP2_32; | |
222 | $hash ^= (leftShift($hash, 10)% $EXP2_32); | |
6fe7ccc8 A |
223 | |
224 | # Save 8 bits for StringImpl to use as flags. | |
225 | $hash &= 0xffffff; | |
226 | ||
227 | # This avoids ever returning a hash code of 0, since that is used to | |
228 | # signal "hash not computed yet". Setting the high bit maintains | |
229 | # reasonable fidelity to a hash code of 0 because it is likely to yield | |
230 | # exactly 0 when hash lookup masks out the high bits. | |
231 | $hash = (0x80000000 >> 8) if ($hash == 0); | |
9dae56ea A |
232 | |
233 | return $hash; | |
234 | } | |
235 | ||
236 | sub output() { | |
237 | if (!$banner) { | |
238 | $banner = 1; | |
239 | print "// Automatically generated from $file using $0. DO NOT EDIT!\n"; | |
240 | } | |
241 | ||
242 | my $nameEntries = "${name}Values"; | |
243 | $nameEntries =~ s/:/_/g; | |
244 | ||
245 | print "\n#include \"Lookup.h\"\n" if ($includelookup); | |
246 | if ($useNameSpace) { | |
247 | print "\nnamespace ${useNameSpace} {\n"; | |
248 | print "\nusing namespace JSC;\n"; | |
249 | } else { | |
250 | print "\nnamespace JSC {\n"; | |
251 | } | |
252 | my $count = scalar @keys + 1; | |
253 | print "\nstatic const struct HashTableValue ${nameEntries}\[$count\] = {\n"; | |
254 | my $i = 0; | |
255 | foreach my $key (@keys) { | |
256 | my $firstValue = ""; | |
257 | my $secondValue = ""; | |
4e4e5a6f | 258 | my $castStr = ""; |
9dae56ea A |
259 | |
260 | if ($values[$i]{"type"} eq "Function") { | |
4e4e5a6f | 261 | $castStr = "static_cast<NativeFunction>"; |
9dae56ea A |
262 | $firstValue = $values[$i]{"function"}; |
263 | $secondValue = $values[$i]{"params"}; | |
264 | } elsif ($values[$i]{"type"} eq "Property") { | |
4e4e5a6f | 265 | $castStr = "static_cast<PropertySlot::GetValueFunc>"; |
9dae56ea A |
266 | $firstValue = $values[$i]{"get"}; |
267 | $secondValue = $values[$i]{"put"}; | |
268 | } elsif ($values[$i]{"type"} eq "Lexer") { | |
269 | $firstValue = $values[$i]{"value"}; | |
270 | $secondValue = "0"; | |
271 | } | |
6fe7ccc8 A |
272 | |
273 | my $intrinsic = "NoIntrinsic"; | |
274 | $intrinsic = "CharCodeAtIntrinsic" if ($key eq "charCodeAt"); | |
275 | $intrinsic = "CharAtIntrinsic" if ($key eq "charAt"); | |
276 | $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode"); | |
277 | if ($name eq "mathTable") { | |
278 | $intrinsic = "MinIntrinsic" if ($key eq "min"); | |
279 | $intrinsic = "MaxIntrinsic" if ($key eq "max"); | |
280 | $intrinsic = "SqrtIntrinsic" if ($key eq "sqrt"); | |
281 | $intrinsic = "PowIntrinsic" if ($key eq "pow"); | |
282 | $intrinsic = "AbsIntrinsic" if ($key eq "abs"); | |
283 | $intrinsic = "FloorIntrinsic" if ($key eq "floor"); | |
284 | $intrinsic = "CeilIntrinsic" if ($key eq "ceil"); | |
285 | $intrinsic = "RoundIntrinsic" if ($key eq "round"); | |
286 | $intrinsic = "ExpIntrinsic" if ($key eq "exp"); | |
287 | $intrinsic = "LogIntrinsic" if ($key eq "log"); | |
4e4e5a6f | 288 | } |
6fe7ccc8 A |
289 | if ($name eq "arrayPrototypeTable") { |
290 | $intrinsic = "ArrayPushIntrinsic" if ($key eq "push"); | |
291 | $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop"); | |
4e4e5a6f | 292 | } |
6fe7ccc8 A |
293 | if ($name eq "regExpPrototypeTable") { |
294 | $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec"); | |
295 | $intrinsic = "RegExpTestIntrinsic" if ($key eq "test"); | |
14957cd0 | 296 | } |
6fe7ccc8 A |
297 | |
298 | print " { \"$key\", $attrs[$i], (intptr_t)" . $castStr . "($firstValue), (intptr_t)$secondValue, $intrinsic },\n"; | |
9dae56ea A |
299 | $i++; |
300 | } | |
6fe7ccc8 | 301 | print " { 0, 0, 0, 0, NoIntrinsic }\n"; |
9dae56ea | 302 | print "};\n\n"; |
6fe7ccc8 | 303 | print "extern const struct HashTable $name =\n"; |
9dae56ea | 304 | print " \{ $compactSize, $compactHashSizeMask, $nameEntries, 0 \};\n"; |
9dae56ea A |
305 | print "} // namespace\n"; |
306 | } |