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 = $ENV{"WEBKITDIR"} . $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 }