create_hash_table 8.4 KB
Newer Older
1 2 3 4 5 6
#! /usr/bin/perl -w
#
# Static Hashtable Generator
#
# (c) 2000-2002 by Harri Porten <porten@kde.org> and
#                  David Faure <faure@kde.org>
eseidel's avatar
eseidel committed
7
# Modified (c) 2004 by Nikolas Zimmermann <wildfox@kde.org>
8
# Copyright (C) 2007, 2008, 2009 Apple Inc. All rights reserved.
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
#
24

staikos's avatar
staikos committed
25 26 27
use strict;

my $file = $ARGV[0];
28 29
shift;
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
staikos's avatar
staikos committed
35
my $useNameSpace = $ARGV[1] if (defined($ARGV[0]) && $ARGV[0] eq "-n");
eseidel's avatar
eseidel committed
36

mitz@apple.com's avatar
mitz@apple.com committed
37
print STDERR "Creating hashtable for $file\n";
38 39
open(IN, $file) or die "No such file $file";

staikos's avatar
staikos committed
40 41
my @keys = ();
my @attrs = ();
weinig@apple.com's avatar
weinig@apple.com committed
42
my @values = ();
staikos's avatar
staikos committed
43
my @hashes = ();
44 45 46

my $inside = 0;
my $name;
47 48 49
my $pefectHashSize;
my $compactSize;
my $compactHashSizeMask;
50
my $banner = 0;
51 52
sub calcPerfectHashSize();
sub calcCompactHashSize();
53
sub output();
weinig@apple.com's avatar
weinig@apple.com committed
54
sub jsc_ucfirst($);
55 56 57
sub hashValue($);

while (<IN>) {
darin@apple.com's avatar
darin@apple.com committed
58 59 60 61 62 63 64 65 66 67
    chomp;
    s/^\s+//;
    next if /^\#|^$/; # Comment or blank line. Do nothing.
    if (/^\@begin/ && !$inside) {
        if (/^\@begin\s*([:_\w]+)\s*\d*\s*$/) {
            $inside = 1;
            $name = $1;
        } else {
            print STDERR "WARNING: \@begin without table name, skipping $_\n";
        }
68
    } elsif (/^\@end\s*$/ && $inside) {
69 70
        calcPerfectHashSize();
        calcCompactHashSize();
darin@apple.com's avatar
darin@apple.com committed
71
        output();
72

darin@apple.com's avatar
darin@apple.com committed
73 74
        @keys = ();
        @attrs = ();
weinig@apple.com's avatar
weinig@apple.com committed
75
        @values = ();
darin@apple.com's avatar
darin@apple.com committed
76 77 78
        @hashes = ();

        $inside = 0;
79
    } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*$/ && $inside) {
darin@apple.com's avatar
darin@apple.com committed
80 81 82 83
        my $key = $1;
        my $val = $2;
        my $att = $3;
        my $param = $4;
weinig@apple.com's avatar
weinig@apple.com committed
84

darin@apple.com's avatar
darin@apple.com committed
85 86
        push(@keys, $key);
        push(@attrs, length($att) > 0 ? $att : "0");
weinig@apple.com's avatar
weinig@apple.com committed
87 88 89 90 91 92 93 94 95 96 97 98

        if ($att =~ m/Function/) {
            push(@values, { "type" => "Function", "function" => $val, "params" => (length($param) ? $param : "") });
            #printf STDERR "WARNING: Number of arguments missing for $key/$val\n" if (length($param) == 0);
        } elsif (length($att)) {
            my $get = $val;
            my $put = !($att =~ m/ReadOnly/) ? "set" . jsc_ucfirst($val) : "0";
            push(@values, { "type" => "Property", "get" => $get, "put" => $put });
        } else {
            push(@values, { "type" => "Lexer", "value" => $val });        
        }
        push(@hashes, hashValue($key));
99
    } elsif ($inside) {
darin@apple.com's avatar
darin@apple.com committed
100
        die "invalid data {" . $_ . "}";
101 102 103 104 105
    }
}

die "missing closing \@end" if ($inside);

weinig@apple.com's avatar
weinig@apple.com committed
106 107 108 109 110 111 112 113 114 115 116 117 118
sub jsc_ucfirst($)
{
    my ($value) = @_;

    if ($value =~ /js/) {
        $value =~ s/js/JS/;
        return $value;
    }

    return ucfirst($value);
}


darin's avatar
darin committed
119 120
sub ceilingToPowerOf2
{
121
    my ($pefectHashSize) = @_;
darin's avatar
darin committed
122 123

    my $powerOf2 = 1;
124
    while ($pefectHashSize > $powerOf2) {
darin's avatar
darin committed
125 126 127 128 129 130
        $powerOf2 <<= 1;
    }

    return $powerOf2;
}

131
sub calcPerfectHashSize()
darin@apple.com's avatar
darin@apple.com committed
132 133
{
tableSizeLoop:
134
    for ($pefectHashSize = ceilingToPowerOf2(scalar @keys); ; $pefectHashSize += $pefectHashSize) {
darin@apple.com's avatar
darin@apple.com committed
135 136
        my @table = ();
        foreach my $key (@keys) {
137
            my $h = hashValue($key) % $pefectHashSize;
darin@apple.com's avatar
darin@apple.com committed
138 139 140 141
            next tableSizeLoop if $table[$h];
            $table[$h] = 1;
        }
        last;
142 143 144
    }
}

145 146 147 148 149
sub leftShift($$) {
    my ($value, $distance) = @_;
    return (($value << $distance) & 0xFFFFFFFF);
}

150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
sub calcCompactHashSize()
{
    my @table = ();
    my @links = ();
    my $compactHashSize = ceilingToPowerOf2(2 * @keys);
    $compactHashSizeMask = $compactHashSize - 1;
    $compactSize = $compactHashSize;
    my $collisions = 0;
    my $maxdepth = 0;
    my $i = 0;
    foreach my $key (@keys) {
        my $depth = 0;
        my $h = hashValue($key) % $compactHashSize;
        while (defined($table[$h])) {
            if (defined($links[$h])) {
                $h = $links[$h];
                $depth++;
            } else {
                $collisions++;
                $links[$h] = $compactSize;
                $h = $compactSize;
                $compactSize++;
            }
        }
        $table[$h] = $i;
        $i++;
        $maxdepth = $depth if ( $depth > $maxdepth);
    }
}

mjs's avatar
mjs committed
180 181
# Paul Hsieh's SuperFastHash
# http://www.azillionmonkeys.com/qed/hash.html
182
sub hashValue($) {
staikos's avatar
staikos committed
183
  my @chars = split(/ */, $_[0]);
mjs's avatar
mjs committed
184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200

  # This hash is designed to work on 16-bit chunks at a time. But since the normal case
  # (above) is to hash UTF-16 characters, we just treat the 8-bit chars as if they
  # were 16-bit chunks, which should give matching results

  my $EXP2_32 = 4294967296;

  my $hash = 0x9e3779b9;
  my $l    = scalar @chars; #I wish this was in Ruby --- Maks
  my $rem  = $l & 1;
  $l = $l >> 1;

  my $s = 0;

  # Main loop
  for (; $l > 0; $l--) {
    $hash   += ord($chars[$s]);
201 202
    my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash;
    $hash   = (leftShift($hash, 16)% $EXP2_32) ^ $tmp;
mjs's avatar
mjs committed
203 204
    $s += 2;
    $hash += $hash >> 11;
zimmermann's avatar
zimmermann committed
205
    $hash %= $EXP2_32;
206
  }
mjs's avatar
mjs committed
207 208

  # Handle end case
209
  if ($rem != 0) {
mjs's avatar
mjs committed
210
    $hash += ord($chars[$s]);
211
    $hash ^= (leftShift($hash, 11)% $EXP2_32);
mjs's avatar
mjs committed
212 213 214 215
    $hash += $hash >> 17;
  }

  # Force "avalanching" of final 127 bits
216
  $hash ^= leftShift($hash, 3);
mjs's avatar
mjs committed
217 218
  $hash += ($hash >> 5);
  $hash = ($hash% $EXP2_32);
219
  $hash ^= (leftShift($hash, 2)% $EXP2_32);
mjs's avatar
mjs committed
220 221
  $hash += ($hash >> 15);
  $hash = $hash% $EXP2_32;
222
  $hash ^= (leftShift($hash, 10)% $EXP2_32);
223

224 225
  # Save 8 bits for StringImpl to use as flags.
  $hash &= 0xffffff;
226 227 228 229 230

  # This avoids ever returning a hash code of 0, since that is used to
  # signal "hash not computed yet". Setting the high bit maintains
  # reasonable fidelity to a hash code of 0 because it is likely to yield
  # exactly 0 when hash lookup masks out the high bits.
231
  $hash = (0x80000000 >> 8) if ($hash == 0);
mjs's avatar
mjs committed
232 233

  return $hash;
234 235 236
}

sub output() {
darin@apple.com's avatar
darin@apple.com committed
237 238 239 240
    if (!$banner) {
        $banner = 1;
        print "// Automatically generated from $file using $0. DO NOT EDIT!\n";
    }
241

darin@apple.com's avatar
darin@apple.com committed
242 243
    my $nameEntries = "${name}Values";
    $nameEntries =~ s/:/_/g;
eseidel's avatar
eseidel committed
244

245
    print "\n#include \"Lookup.h\"\n" if ($includelookup);
darin@apple.com's avatar
darin@apple.com committed
246
    if ($useNameSpace) {
weinig@apple.com's avatar
weinig@apple.com committed
247 248
        print "\nnamespace ${useNameSpace} {\n";
        print "\nusing namespace JSC;\n";
darin@apple.com's avatar
darin@apple.com committed
249
    } else {
250
        print "\nnamespace JSC {\n";
251
    }
darin@apple.com's avatar
darin@apple.com committed
252
    my $count = scalar @keys + 1;
253
    print "\nstatic const struct HashTableValue ${nameEntries}\[$count\] = {\n";
darin@apple.com's avatar
darin@apple.com committed
254 255
    my $i = 0;
    foreach my $key (@keys) {
weinig@apple.com's avatar
weinig@apple.com committed
256 257
        my $firstValue = "";
        my $secondValue = "";
258
        my $castStr = "";
weinig@apple.com's avatar
weinig@apple.com committed
259 260

        if ($values[$i]{"type"} eq "Function") {
261
            $castStr = "static_cast<NativeFunction>";
weinig@apple.com's avatar
weinig@apple.com committed
262 263 264
            $firstValue = $values[$i]{"function"};
            $secondValue = $values[$i]{"params"};
        } elsif ($values[$i]{"type"} eq "Property") {
265
            $castStr = "static_cast<PropertySlot::GetValueFunc>";
weinig@apple.com's avatar
weinig@apple.com committed
266 267 268 269 270 271
            $firstValue = $values[$i]{"get"};
            $secondValue = $values[$i]{"put"};
        } elsif ($values[$i]{"type"} eq "Lexer") {
            $firstValue = $values[$i]{"value"};
            $secondValue = "0";
        }
272 273 274

        my $intrinsic = "NoIntrinsic";
        $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode");
275
        if ($name eq "arrayPrototypeTable") {
276 277
            $intrinsic = "ArrayPushIntrinsic" if ($key eq "push");
            $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop");
278
        }
279 280 281 282
        if ($name eq "regExpPrototypeTable") {
            $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec");
            $intrinsic = "RegExpTestIntrinsic" if ($key eq "test");
        }
283

284
        print "   { \"$key\", $attrs[$i], $intrinsic, (intptr_t)" . $castStr . "($firstValue), (intptr_t)$secondValue },\n";
darin@apple.com's avatar
darin@apple.com committed
285 286
        $i++;
    }
287
    print "   { 0, 0, NoIntrinsic, 0, 0 }\n";
darin@apple.com's avatar
darin@apple.com committed
288
    print "};\n\n";
289
    print "extern const struct HashTable $name =\n";
290
    print "    \{ $compactSize, $compactHashSizeMask, $nameEntries, 0 \};\n";
darin@apple.com's avatar
darin@apple.com committed
291
    print "} // namespace\n";
292
}