| #! /usr/bin/env perl |
| # |
| # Static Hashtable Generator |
| # |
| # (c) 2000-2002 by Harri Porten <porten@kde.org> and |
| # David Faure <faure@kde.org> |
| # Modified (c) 2004 by Nikolas Zimmermann <wildfox@kde.org> |
| # Copyright (C) 2007-2018 Apple Inc. All rights reserved. |
| # |
| # 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 |
| # |
| |
| use strict; |
| use warnings; |
| use Getopt::Long qw(:config pass_through); |
| |
| my $file = shift @ARGV or die("Must provide source file as final argument."); |
| |
| open(IN, $file) or die "No such file $file"; |
| |
| my @keys = (); |
| my @attrs = (); |
| my @values = (); |
| my @hashes = (); |
| my @table = (); |
| my @links = (); |
| |
| my $hasSetter = "false"; |
| |
| my $includeBuiltin = 0; |
| my $inside = 0; |
| my $name; |
| my $pefectHashSize; |
| my $compactSize; |
| my $compactHashSizeMask; |
| my $banner = 0; |
| sub calcPerfectHashSize(); |
| sub calcCompactHashSize(); |
| sub output(); |
| sub jsc_ucfirst($); |
| sub hashValue($); |
| |
| while (<IN>) { |
| 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"; |
| } |
| } elsif (/^\@end\s*$/ && $inside) { |
| calcPerfectHashSize(); |
| calcCompactHashSize(); |
| output(); |
| |
| @keys = (); |
| @attrs = (); |
| @values = (); |
| @hashes = (); |
| @table = (); |
| @links = (); |
| $includeBuiltin = 0; |
| |
| $inside = 0; |
| } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*(\w*)\s*$/ && $inside) { |
| my $key = $1; |
| my $val = $2; |
| my $att = $3; |
| my $param = $4; |
| my $intrinsic = $5; |
| |
| push(@keys, $key); |
| push(@attrs, length($att) > 0 ? $att : "None"); |
| |
| if ($val eq "JSBuiltin") { |
| $includeBuiltin = 1; |
| } |
| |
| if ($att =~ m/Function/) { |
| push(@values, { "type" => "PropertyAttribute::Function", "function" => $val, "params" => (length($param) ? $param : ""), "intrinsic" => (length($intrinsic) ? $intrinsic : "NoIntrinsic") }); |
| #printf STDERR "WARNING: Number of arguments missing for $key/$val\n" if (length($param) == 0); |
| } elsif ($att =~ m/Accessor/) { |
| my $get = $val; |
| my $put = "nullptr"; |
| $hasSetter = "true"; |
| push(@values, { "type" => "PropertyAttribute::Accessor", "get" => $get, "put" => $put }); |
| } elsif ($att =~ m/CellProperty/) { |
| my $property = $val; |
| push(@values, { "type" => "PropertyAttribute::CellProperty", "property" => $property }); |
| } elsif ($att =~ m/ClassStructure/) { |
| my $property = $val; |
| push(@values, { "type" => "PropertyAttribute::ClassStructure", "property" => $property }); |
| } elsif ($att =~ m/PropertyCallback/) { |
| my $cback = $val; |
| push(@values, { "type" => "PropertyAttribute::PropertyCallback", "cback" => $cback }); |
| } elsif (length($att)) { |
| my $get = $val; |
| my $put = "0"; |
| if (!($att =~ m/ReadOnly/)) { |
| $put = "set" . jsc_ucfirst($val); |
| } |
| $hasSetter = "true"; |
| push(@values, { "type" => "PropertyAttribute::Property", "get" => $get, "put" => $put }); |
| } else { |
| push(@values, { "type" => "Lexer", "value" => $val }); |
| } |
| push(@hashes, hashValue($key)); |
| } elsif ($inside) { |
| die "invalid data {" . $_ . "}"; |
| } |
| } |
| |
| die "missing closing \@end" if ($inside); |
| |
| sub jsc_ucfirst($) |
| { |
| my ($value) = @_; |
| |
| if ($value =~ /js/) { |
| $value =~ s/js/JS/; |
| return $value; |
| } |
| |
| return ucfirst($value); |
| } |
| |
| |
| sub ceilingToPowerOf2 |
| { |
| my ($pefectHashSize) = @_; |
| |
| my $powerOf2 = 1; |
| while ($pefectHashSize > $powerOf2) { |
| $powerOf2 <<= 1; |
| } |
| |
| return $powerOf2; |
| } |
| |
| sub calcPerfectHashSize() |
| { |
| tableSizeLoop: |
| for ($pefectHashSize = ceilingToPowerOf2(scalar @keys); ; $pefectHashSize += $pefectHashSize) { |
| my @table = (); |
| foreach my $key (@keys) { |
| my $h = hashValue($key) % $pefectHashSize; |
| next tableSizeLoop if $table[$h]; |
| $table[$h] = 1; |
| } |
| last; |
| } |
| } |
| |
| sub leftShift($$) { |
| my ($value, $distance) = @_; |
| return (($value << $distance) & 0xFFFFFFFF); |
| } |
| |
| sub calcCompactHashSize() |
| { |
| 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); |
| } |
| } |
| |
| # Paul Hsieh's SuperFastHash |
| # http://www.azillionmonkeys.com/qed/hash.html |
| sub hashValue($) { |
| my @chars = split(/ */, $_[0]); |
| |
| # 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]); |
| my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash; |
| $hash = (leftShift($hash, 16)% $EXP2_32) ^ $tmp; |
| $s += 2; |
| $hash += $hash >> 11; |
| $hash %= $EXP2_32; |
| } |
| |
| # Handle end case |
| if ($rem != 0) { |
| $hash += ord($chars[$s]); |
| $hash ^= (leftShift($hash, 11)% $EXP2_32); |
| $hash += $hash >> 17; |
| } |
| |
| # Force "avalanching" of final 127 bits |
| $hash ^= leftShift($hash, 3); |
| $hash += ($hash >> 5); |
| $hash = ($hash% $EXP2_32); |
| $hash ^= (leftShift($hash, 2)% $EXP2_32); |
| $hash += ($hash >> 15); |
| $hash = $hash% $EXP2_32; |
| $hash ^= (leftShift($hash, 10)% $EXP2_32); |
| |
| # Save 8 bits for StringImpl to use as flags. |
| $hash &= 0xffffff; |
| |
| # 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. |
| $hash = (0x80000000 >> 8) if ($hash == 0); |
| |
| return $hash; |
| } |
| |
| sub output() { |
| if (!$banner) { |
| $banner = 1; |
| print "// Automatically generated from $file using $0. DO NOT EDIT!\n"; |
| } |
| |
| my $nameEntries = "${name}Values"; |
| $nameEntries =~ s/:/_/g; |
| my $nameIndex = "${name}Index"; |
| $nameIndex =~ s/:/_/g; |
| |
| print "\n"; |
| print "#include \"JSCBuiltins.h\"\n" if ($includeBuiltin); |
| print "#include \"Lookup.h\"\n"; |
| print "\n"; |
| print "namespace JSC {\n"; |
| print "\n"; |
| if ($compactSize != 0) { |
| print "static const struct CompactHashIndex ${nameIndex}\[$compactSize\] = {\n"; |
| for (my $i = 0; $i < $compactSize; $i++) { |
| my $T = -1; |
| if (defined($table[$i])) { $T = $table[$i]; } |
| my $L = -1; |
| if (defined($links[$i])) { $L = $links[$i]; } |
| print " { $T, $L },\n"; |
| } |
| } else { |
| # MSVC dislikes empty arrays. |
| print "static const struct CompactHashIndex ${nameIndex}\[1\] = {\n"; |
| print " { 0, 0 }\n"; |
| } |
| print "};\n"; |
| print "\n"; |
| |
| my $packedSize = scalar @keys; |
| if ($packedSize != 0) { |
| print "static const struct HashTableValue ${nameEntries}\[$packedSize\] = {\n"; |
| } else { |
| # MSVC dislikes empty arrays. |
| print "static const struct HashTableValue ${nameEntries}\[1\] = {\n"; |
| print " { nullptr, 0, NoIntrinsic, { 0, 0 } }\n"; |
| } |
| my $i = 0; |
| foreach my $key (@keys) { |
| my $firstValue = ""; |
| my $secondValue = ""; |
| my $firstCastStr = ""; |
| my $secondCastStr = ""; |
| my $intrinsic = "NoIntrinsic"; |
| |
| if ($values[$i]{"type"} eq "PropertyAttribute::Function") { |
| $firstCastStr = "static_cast<RawNativeFunction>"; |
| $firstValue = $values[$i]{"function"}; |
| $secondValue = $values[$i]{"params"}; |
| $intrinsic = $values[$i]{"intrinsic"}; |
| } elsif ($values[$i]{"type"} eq "PropertyAttribute::Accessor") { |
| $firstCastStr = "static_cast<RawNativeFunction>"; |
| $secondCastStr = "static_cast<RawNativeFunction>"; |
| $firstValue = $values[$i]{"get"}; |
| $secondValue = $values[$i]{"put"}; |
| } elsif ($values[$i]{"type"} eq "PropertyAttribute::Property") { |
| $firstCastStr = "static_cast<PropertySlot::GetValueFunc>"; |
| $secondCastStr = "static_cast<PutPropertySlot::PutValueFunc>"; |
| $firstValue = $values[$i]{"get"}; |
| $secondValue = $values[$i]{"put"}; |
| } elsif ($values[$i]{"type"} eq "Lexer") { |
| $firstValue = $values[$i]{"value"}; |
| $secondValue = "0"; |
| } elsif ($values[$i]{"type"} eq "PropertyAttribute::CellProperty" || $values[$i]{"type"} eq "PropertyAttribute::ClassStructure") { |
| $values[$i]{"property"} =~ /\A([a-zA-Z0-9_]+)::(.*)\Z/ or die; |
| $firstValue = "OBJECT_OFFSETOF($1, $2)"; |
| $secondValue = "0"; |
| } elsif ($values[$i]{"type"} eq "PropertyAttribute::PropertyCallback") { |
| $firstCastStr = "static_cast<LazyPropertyCallback>"; |
| $firstValue = $values[$i]{"cback"}; |
| $secondValue = "0"; |
| } |
| |
| my $attributes = "PropertyAttribute::" . $attrs[$i]; |
| $attributes =~ s/\|/\|PropertyAttribute::/g; |
| $attributes = "static_cast<unsigned>(" . $attributes . ")"; |
| if ($values[$i]{"type"} eq "PropertyAttribute::Function" && $firstValue eq "JSBuiltin") { |
| my $tableHead = $name; |
| $tableHead =~ s/Table$//; |
| print " { \"$key\", (($attributes) & ~PropertyAttribute::Function) | PropertyAttribute::Builtin, $intrinsic, { (intptr_t)static_cast<BuiltinGenerator>(" . $tableHead . ucfirst($key) . "CodeGenerator), (intptr_t)$secondValue } },\n"; |
| } |
| else { |
| print " { \"$key\", $attributes, $intrinsic, { (intptr_t)" . $firstCastStr . "($firstValue), (intptr_t)" . $secondCastStr . "($secondValue) } },\n"; |
| } |
| $i++; |
| } |
| print "};\n"; |
| print "\n"; |
| print "static const struct HashTable $name =\n"; |
| print " \{ $packedSize, $compactHashSizeMask, $hasSetter, nullptr, $nameEntries, $nameIndex \};\n"; |
| print "\n"; |
| print "} // namespace JSC\n"; |
| } |
