create_hash_table

   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
 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
 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
 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 = "";
 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 = "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");
 288         }
 289         if ($name eq "arrayPrototypeTable") {
 290             $intrinsic = "ArrayPushIntrinsic" if ($key eq "push");
 291             $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop");
 292         }
 293         if ($name eq "regExpPrototypeTable") {
 294             $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec");
 295             $intrinsic = "RegExpTestIntrinsic" if ($key eq "test");
 296         }
 297
 298         print "   { \"$key\", $attrs[$i], (intptr_t)" . $castStr . "($firstValue), (intptr_t)$secondValue, $intrinsic },\n";
 299         $i++;
 300     }
 301     print "   { 0, 0, 0, 0, NoIntrinsic }\n";
 302     print "};\n\n";
 303     print "extern const struct HashTable $name =\n";
 304     print "    \{ $compactSize, $compactHashSizeMask, $nameEntries, 0 \};\n";
 305     print "} // namespace\n";
 306 }