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 my @table = ();
  45 my @links = ();
  46
  47 my $hasSetter = "false";
  48
  49 my $inside = 0;
  50 my $name;
  51 my $pefectHashSize;
  52 my $compactSize;
  53 my $compactHashSizeMask;
  54 my $banner = 0;
  55 sub calcPerfectHashSize();
  56 sub calcCompactHashSize();
  57 sub output();
  58 sub jsc_ucfirst($);
  59 sub hashValue($);
  60
  61 while (<IN>) {
  62     chomp;
  63     s/^\s+//;
  64     next if /^\#|^$/; # Comment or blank line. Do nothing.
  65     if (/^\@begin/ && !$inside) {
  66         if (/^\@begin\s*([:_\w]+)\s*\d*\s*$/) {
  67             $inside = 1;
  68             $name = $1;
  69         } else {
  70             print STDERR "WARNING: \@begin without table name, skipping $_\n";
  71         }
  72     } elsif (/^\@end\s*$/ && $inside) {
  73         calcPerfectHashSize();
  74         calcCompactHashSize();
  75         output();
  76
  77         @keys = ();
  78         @attrs = ();
  79         @values = ();
  80         @hashes = ();
  81         @table = ();
  82         @links = ();
  83
  84         $inside = 0;
  85     } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*$/ && $inside) {
  86         my $key = $1;
  87         my $val = $2;
  88         my $att = $3;
  89         my $param = $4;
  90
  91         push(@keys, $key);
  92         push(@attrs, length($att) > 0 ? $att : "0");
  93
  94         if ($att =~ m/Function/) {
  95             push(@values, { "type" => "Function", "function" => $val, "params" => (length($param) ? $param : "") });
  96             #printf STDERR "WARNING: Number of arguments missing for $key/$val\n" if (length($param) == 0);
  97         } elsif ($att =~ m/Accessor/) {
  98             my $get = $val;
  99             my $put = "nullptr";
 100             $hasSetter = "true";
 101             push(@values, { "type" => "Accessor", "get" => $get, "put" => $put });
 102         } elsif (length($att)) {
 103             my $get = $val;
 104             my $put = "0";
 105             if (!($att =~ m/ReadOnly/)) {
 106                 $put = "set" . jsc_ucfirst($val);
 107             }
 108             $hasSetter = "true";
 109             push(@values, { "type" => "Property", "get" => $get, "put" => $put });
 110         } else {
 111             push(@values, { "type" => "Lexer", "value" => $val });
 112         }
 113         push(@hashes, hashValue($key));
 114     } elsif ($inside) {
 115         die "invalid data {" . $_ . "}";
 116     }
 117 }
 118
 119 die "missing closing \@end" if ($inside);
 120
 121 sub jsc_ucfirst($)
 122 {
 123     my ($value) = @_;
 124
 125     if ($value =~ /js/) {
 126         $value =~ s/js/JS/;
 127         return $value;
 128     }
 129
 130     return ucfirst($value);
 131 }
 132
 133
 134 sub ceilingToPowerOf2
 135 {
 136     my ($pefectHashSize) = @_;
 137
 138     my $powerOf2 = 1;
 139     while ($pefectHashSize > $powerOf2) {
 140         $powerOf2 <<= 1;
 141     }
 142
 143     return $powerOf2;
 144 }
 145
 146 sub calcPerfectHashSize()
 147 {
 148 tableSizeLoop:
 149     for ($pefectHashSize = ceilingToPowerOf2(scalar @keys); ; $pefectHashSize += $pefectHashSize) {
 150         my @table = ();
 151         foreach my $key (@keys) {
 152             my $h = hashValue($key) % $pefectHashSize;
 153             next tableSizeLoop if $table[$h];
 154             $table[$h] = 1;
 155         }
 156         last;
 157     }
 158 }
 159
 160 sub leftShift($$) {
 161     my ($value, $distance) = @_;
 162     return (($value << $distance) & 0xFFFFFFFF);
 163 }
 164
 165 sub calcCompactHashSize()
 166 {
 167     my $compactHashSize = ceilingToPowerOf2(2 * @keys);
 168     $compactHashSizeMask = $compactHashSize - 1;
 169     $compactSize = $compactHashSize;
 170     my $collisions = 0;
 171     my $maxdepth = 0;
 172     my $i = 0;
 173     foreach my $key (@keys) {
 174         my $depth = 0;
 175         my $h = hashValue($key) % $compactHashSize;
 176         while (defined($table[$h])) {
 177             if (defined($links[$h])) {
 178                 $h = $links[$h];
 179                 $depth++;
 180             } else {
 181                 $collisions++;
 182                 $links[$h] = $compactSize;
 183                 $h = $compactSize;
 184                 $compactSize++;
 185             }
 186         }
 187         $table[$h] = $i;
 188         $i++;
 189         $maxdepth = $depth if ( $depth > $maxdepth);
 190     }
 191 }
 192
 193 # Paul Hsieh's SuperFastHash
 194 # http://www.azillionmonkeys.com/qed/hash.html
 195 sub hashValue($) {
 196   my @chars = split(/ */, $_[0]);
 197
 198   # This hash is designed to work on 16-bit chunks at a time. But since the normal case
 199   # (above) is to hash UTF-16 characters, we just treat the 8-bit chars as if they
 200   # were 16-bit chunks, which should give matching results
 201
 202   my $EXP2_32 = 4294967296;
 203
 204   my $hash = 0x9e3779b9;
 205   my $l    = scalar @chars; #I wish this was in Ruby --- Maks
 206   my $rem  = $l & 1;
 207   $l = $l >> 1;
 208
 209   my $s = 0;
 210
 211   # Main loop
 212   for (; $l > 0; $l--) {
 213     $hash   += ord($chars[$s]);
 214     my $tmp = leftShift(ord($chars[$s+1]), 11) ^ $hash;
 215     $hash   = (leftShift($hash, 16)% $EXP2_32) ^ $tmp;
 216     $s += 2;
 217     $hash += $hash >> 11;
 218     $hash %= $EXP2_32;
 219   }
 220
 221   # Handle end case
 222   if ($rem != 0) {
 223     $hash += ord($chars[$s]);
 224     $hash ^= (leftShift($hash, 11)% $EXP2_32);
 225     $hash += $hash >> 17;
 226   }
 227
 228   # Force "avalanching" of final 127 bits
 229   $hash ^= leftShift($hash, 3);
 230   $hash += ($hash >> 5);
 231   $hash = ($hash% $EXP2_32);
 232   $hash ^= (leftShift($hash, 2)% $EXP2_32);
 233   $hash += ($hash >> 15);
 234   $hash = $hash% $EXP2_32;
 235   $hash ^= (leftShift($hash, 10)% $EXP2_32);
 236
 237   # Save 8 bits for StringImpl to use as flags.
 238   $hash &= 0xffffff;
 239
 240   # This avoids ever returning a hash code of 0, since that is used to
 241   # signal "hash not computed yet". Setting the high bit maintains
 242   # reasonable fidelity to a hash code of 0 because it is likely to yield
 243   # exactly 0 when hash lookup masks out the high bits.
 244   $hash = (0x80000000 >> 8) if ($hash == 0);
 245
 246   return $hash;
 247 }
 248
 249 sub output() {
 250     if (!$banner) {
 251         $banner = 1;
 252         print "// Automatically generated from $file using $0. DO NOT EDIT!\n";
 253     }
 254
 255     my $nameEntries = "${name}Values";
 256     $nameEntries =~ s/:/_/g;
 257     my $nameIndex = "${name}Index";
 258     $nameIndex =~ s/:/_/g;
 259
 260     print "\n#include \"JSCBuiltins.h\"\n";
 261     print "\n#include \"Lookup.h\"\n" if ($includelookup);
 262
 263     if ($useNameSpace) {
 264         print "\nnamespace ${useNameSpace} {\n";
 265         print "\nusing namespace JSC;\n";
 266     } else {
 267         print "\nnamespace JSC {\n";
 268     }
 269
 270     print "\nstatic const struct CompactHashIndex ${nameIndex}\[$compactSize\] = {\n";
 271     for (my $i = 0; $i < $compactSize; $i++) {
 272         my $T = -1;
 273         if (defined($table[$i])) { $T = $table[$i]; }
 274         my $L = -1;
 275         if (defined($links[$i])) { $L = $links[$i]; }
 276         print "    { $T, $L },\n";
 277     }
 278     print "};\n\n";
 279
 280     my $packedSize = scalar @keys;
 281     print "\nstatic const struct HashTableValue ${nameEntries}\[$packedSize\] = {\n";
 282     my $i = 0;
 283     foreach my $key (@keys) {
 284         my $firstValue = "";
 285         my $secondValue = "";
 286         my $firstCastStr = "";
 287         my $secondCastStr = "";
 288
 289         if ($values[$i]{"type"} eq "Function") {
 290             $firstCastStr = "static_cast<NativeFunction>";
 291             $firstValue = $values[$i]{"function"};
 292             $secondValue = $values[$i]{"params"};
 293         } elsif ($values[$i]{"type"} eq "Accessor") {
 294             $firstCastStr = "static_cast<NativeFunction>";
 295             $secondCastStr = "static_cast<NativeFunction>";
 296             $firstValue = $values[$i]{"get"};
 297             $secondValue = $values[$i]{"put"};
 298         } elsif ($values[$i]{"type"} eq "Property") {
 299             $firstCastStr = "static_cast<PropertySlot::GetValueFunc>";
 300             $secondCastStr = "static_cast<PutPropertySlot::PutValueFunc>";
 301             $firstValue = $values[$i]{"get"};
 302             $secondValue = $values[$i]{"put"};
 303         } elsif ($values[$i]{"type"} eq "Lexer") {
 304             $firstValue = $values[$i]{"value"};
 305             $secondValue = "0";
 306         }
 307
 308         my $intrinsic = "NoIntrinsic";
 309         $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode");
 310         if ($name eq "arrayPrototypeTable") {
 311             $intrinsic = "ArrayPushIntrinsic" if ($key eq "push");
 312             $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop");
 313         }
 314         if ($name eq "regExpPrototypeTable") {
 315             $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec");
 316             $intrinsic = "RegExpTestIntrinsic" if ($key eq "test");
 317         }
 318
 319         if ($values[$i]{"type"} eq "Function")  {
 320             my $tableHead = $name;
 321             $tableHead =~ s/Table$//;
 322             print " #if JSC_BUILTIN_EXISTS(" . uc($tableHead . $key) .")\n";
 323             print "   { \"$key\", (($attrs[$i]) & ~Function) | Builtin, $intrinsic, (intptr_t)static_cast<BuiltinGenerator>(" . $tableHead . ucfirst($key) . "CodeGenerator), (intptr_t)$secondValue },\n";
 324             print " #else\n"
 325         }
 326         print "   { \"$key\", $attrs[$i], $intrinsic, (intptr_t)" . $firstCastStr . "($firstValue), (intptr_t)" . $secondCastStr . "($secondValue) },\n";
 327         if ($values[$i]{"type"} eq "Function")  {
 328             print " #endif\n"
 329         }
 330         $i++;
 331     }
 332     print "};\n\n";
 333     print "JS_EXPORT_PRIVATE extern const struct HashTable $name =\n";
 334     print "    \{ $packedSize, $compactHashSizeMask, $hasSetter, $nameEntries, 0, $nameIndex \};\n";
 335     print "} // namespace\n";
 336 }