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
25use strict;
26
27my $file = $ARGV[0];
28shift;
29my $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
35my $useNameSpace = $ARGV[1] if (defined($ARGV[0]) && $ARGV[0] eq "-n");
36
37print STDERR "Creating hashtable for $file\n";
38open(IN, $file) or die "No such file $file";
39
40my @keys = ();
41my @attrs = ();
42my @values = ();
43my @hashes = ();
44
45my $inside = 0;
46my $name;
47my $pefectHashSize;
48my $compactSize;
49my $compactHashSizeMask;
50my $banner = 0;
51sub calcPerfectHashSize();
52sub calcCompactHashSize();
53sub output();
54sub jsc_ucfirst($);
55sub hashValue($);
56
57while (<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
104die "missing closing \@end" if ($inside);
105
106sub 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
119sub ceilingToPowerOf2
120{
121    my ($pefectHashSize) = @_;
122
123    my $powerOf2 = 1;
124    while ($pefectHashSize > $powerOf2) {
125        $powerOf2 <<= 1;
126    }
127
128    return $powerOf2;
129}
130
131sub calcPerfectHashSize()
132{
133tableSizeLoop:
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
145sub leftShift($$) {
146    my ($value, $distance) = @_;
147    return (($value << $distance) & 0xFFFFFFFF);
148}
149
150sub 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
182sub 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
209  if ($rem != 0) {
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);
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);
232
233  return $hash;
234}
235
236sub 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 = "";
258        my $castStr = "";
259
260        if ($values[$i]{"type"} eq "Function") {
261            $castStr = "static_cast<NativeFunction>";
262            $firstValue = $values[$i]{"function"};
263            $secondValue = $values[$i]{"params"};
264        } elsif ($values[$i]{"type"} eq "Property") {
265            $castStr = "static_cast<PropertySlot::GetValueFunc>";
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        }
272
273        my $intrinsic = "NoIntrinsic";
274        $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode");
275        if ($name eq "mathTable") {
276            $intrinsic = "MinIntrinsic" if ($key eq "min");
277            $intrinsic = "MaxIntrinsic" if ($key eq "max");
278            $intrinsic = "SqrtIntrinsic" if ($key eq "sqrt");
279            $intrinsic = "PowIntrinsic" if ($key eq "pow");
280            $intrinsic = "AbsIntrinsic" if ($key eq "abs");
281            $intrinsic = "FloorIntrinsic" if ($key eq "floor");
282            $intrinsic = "CeilIntrinsic" if ($key eq "ceil");
283            $intrinsic = "RoundIntrinsic" if ($key eq "round");
284            $intrinsic = "ExpIntrinsic" if ($key eq "exp");
285            $intrinsic = "LogIntrinsic" if ($key eq "log");
286            $intrinsic = "IMulIntrinsic" if ($key eq "imul");
287        }
288        if ($name eq "arrayPrototypeTable") {
289            $intrinsic = "ArrayPushIntrinsic" if ($key eq "push");
290            $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop");
291        }
292        if ($name eq "regExpPrototypeTable") {
293            $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec");
294            $intrinsic = "RegExpTestIntrinsic" if ($key eq "test");
295        }
296
297        print "   { \"$key\", $attrs[$i], (intptr_t)" . $castStr . "($firstValue), (intptr_t)$secondValue, $intrinsic },\n";
298        $i++;
299    }
300    print "   { 0, 0, 0, 0, NoIntrinsic }\n";
301    print "};\n\n";
302    print "extern const struct HashTable $name =\n";
303    print "    \{ $compactSize, $compactHashSizeMask, $nameEntries, 0 \};\n";
304    print "} // namespace\n";
305}
306