Skip to content
Snippets Groups Projects
create_hash_table 10.1 KiB
Newer Older
  • Learn to ignore specific revisions
  • #! /usr/bin/perl -w
    #
    # 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, 2008, 2009 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;
    
    my $file = $ARGV[0];
    shift;
    my $includelookup = 0;
    
    # Use -i as second argument to make it include "Lookup.h"
    $includelookup = 1 if (defined($ARGV[0]) && $ARGV[0] eq "-i");
    
    # Use -n as second argument to make it use the third argument as namespace parameter ie. -n KDOM
    my $useNameSpace = $ARGV[1] if (defined($ARGV[0]) && $ARGV[0] eq "-n");
    
    print STDERR "Creating hashtable for $file\n";
    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 $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 = ();
    
    
            $inside = 0;
        } elsif (/^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*$/ && $inside) {
            my $key = $1;
            my $val = $2;
            my $att = $3;
            my $param = $4;
    
            push(@keys, $key);
            push(@attrs, length($att) > 0 ? $att : "0");
    
            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 ($att =~ m/Accessor/) {
                my $get = $val;
                my $put = "nullptr";
                $hasSetter = "true";
                push(@values, { "type" => "Accessor", "get" => $get, "put" => $put });
    
            } elsif (length($att)) {
                my $get = $val;
    
                my $put = "0";
                if (!($att =~ m/ReadOnly/)) {
                    $put = "set" . jsc_ucfirst($val);
                }
                $hasSetter = "true";
    
                push(@values, { "type" => "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#include \"JSCBuiltins.h\"\n";
    
        print "\n#include \"Lookup.h\"\n" if ($includelookup);
    
        if ($useNameSpace) {
            print "\nnamespace ${useNameSpace} {\n";
            print "\nusing namespace JSC;\n";
        } else {
            print "\nnamespace JSC {\n";
        }
    
    
        print "\nstatic 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";
        }
        print "};\n\n";
    
        my $packedSize = scalar @keys;
        print "\nstatic const struct HashTableValue ${nameEntries}\[$packedSize\] = {\n";
    
        my $i = 0;
        foreach my $key (@keys) {
            my $firstValue = "";
            my $secondValue = "";
    
            my $firstCastStr = "";
            my $secondCastStr = "";
    
    
            if ($values[$i]{"type"} eq "Function") {
    
                $firstCastStr = "static_cast<NativeFunction>";
    
                $firstValue = $values[$i]{"function"};
                $secondValue = $values[$i]{"params"};
    
            } elsif ($values[$i]{"type"} eq "Accessor") {
                $firstCastStr = "static_cast<NativeFunction>";
                $secondCastStr = "static_cast<NativeFunction>";
                $firstValue = $values[$i]{"get"};
                $secondValue = $values[$i]{"put"};
    
            } elsif ($values[$i]{"type"} eq "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";
            }
    
    
            my $intrinsic = "NoIntrinsic";
            $intrinsic = "FromCharCodeIntrinsic" if ($key eq "fromCharCode");
    
            if ($name eq "arrayPrototypeTable") {
    
                $intrinsic = "ArrayPushIntrinsic" if ($key eq "push");
                $intrinsic = "ArrayPopIntrinsic" if ($key eq "pop");
    
            if ($name eq "regExpPrototypeTable") {
                $intrinsic = "RegExpExecIntrinsic" if ($key eq "exec");
                $intrinsic = "RegExpTestIntrinsic" if ($key eq "test");
            }
    
            if ($values[$i]{"type"} eq "Function")  {
                my $tableHead = $name;
                $tableHead =~ s/Table$//;
                print " #if JSC_BUILTIN_EXISTS(" . uc($tableHead . $key) .")\n";
    
                print "   { \"$key\", (($attrs[$i]) & ~Function) | Builtin, $intrinsic, { (intptr_t)static_cast<BuiltinGenerator>(" . $tableHead . ucfirst($key) . "CodeGenerator), (intptr_t)$secondValue } },\n";
    
                print " #else\n"
            }
    
            print "   { \"$key\", $attrs[$i], $intrinsic, { (intptr_t)" . $firstCastStr . "($firstValue), (intptr_t)" . $secondCastStr . "($secondValue) } },\n";
    
            if ($values[$i]{"type"} eq "Function")  {
                print " #endif\n"
            }
    
            $i++;
        }
        print "};\n\n";
    
        print "static const struct HashTable $name =\n";
        print "    \{ $packedSize, $compactHashSizeMask, $hasSetter, $nameEntries, $nameIndex \};\n";
    
        print "} // namespace\n";
    }