#! /usr/bin/env perl
#
# Static Hashtable Generator
#
# (c) 2000-2002 by Harri Porten  and
#                  David Faure 
# Modified (c) 2004 by Nikolas Zimmermann 
# Copyright (C) 2007-2023 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 bigint;
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 @table = ();
my @links = ();

my $hasSetter = "false";

my $includeBuiltin = 0;
my $inside = 0;
my $name;
my $perfectHashSize;
my $compactSize;
my $compactHashSizeMask;
my $banner = 0;
my $mask64 = 2**64 - 1;
my $mask32 = 2**32 - 1;
sub calcPerfectHashSize();
sub calcCompactHashSize();
sub output();
sub jsc_ucfirst($);
sub hashValue($);

while () {
    chomp;
    s/^\s+//;
    next if /^\#|^$/; # Comment or blank line. Do nothing.
    if (!$inside && /^\@begin/) {
        if (/^\@begin\s*([:_\w]+)\s*\d*\s*$/) {
            $inside = 1;
            $name = $1;
        } else {
            print STDERR "WARNING: \@begin without table name, skipping $_\n";
        }
    } elsif ($inside && /^\@end\s*$/) {
        output();

        @keys = ();
        @attrs = ();
        @values = ();
        $includeBuiltin = 0;

        $inside = 0;
    } elsif ($inside && /^(\S+)\s*(\S+)\s*([\w\|]*)\s*(\w*)\s*(\w*)\s*$/) {
        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/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 });
        }
    } 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 ($perfectHashSize) = @_;

    my $powerOf2 = 1;
    while ($perfectHashSize > $powerOf2) {
        $powerOf2  1000) {
                die "The hash size is far too big. This should not be reached.";
            }
            if ($depth > 100) {
                die "The depth is far too big. This should not be reached.";
            }
            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);
    }
}

sub maskTop8BitsAndAvoidZero($) {
    my ($value) = @_;

    $value &= $mask32;

    # Save 8 bits for StringImpl to use as flags.
    $value &= 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.
    $value = (0x80000000 >> 8) if ($value == 0);

    return $value;
}

sub uint64_add($$) {
    my ($a, $b) = @_;
    my $sum = $a + $b;
    return $sum & $mask64;
}

sub uint64_multi($$) {
    my ($a, $b) = @_;
    my $product = $a * $b;
    return $product & $mask64;
}

sub rapid_mul128($$) {
    my ($A, $B) = @_;

    my $ha = $A >> 32;
    my $hb = $B >> 32;
    my $la = $A & $mask32;
    my $lb = $B & $mask32;
    my $hi;
    my $lo;
    my $rh = uint64_multi($ha, $hb);
    my $rm0 = uint64_multi($ha, $lb);
    my $rm1 = uint64_multi($hb, $la);
    my $rl = uint64_multi($la, $lb);
    my $t = uint64_add($rl, ($rm0  32), uint64_add(($rm1 >> 32), $c)));

    return ($lo, $hi);
};

sub rapid_mix($$) {
    my ($A, $B) = @_;
    ($A, $B) = rapid_mul128($A, $B);
    return $A ^ $B;
}

sub rapidhash {
    # https://github.com/Nicoshev/rapidhash
    # Hashes raw ASCII bytes (1 byte per character).
    my @chars = @_;
    my $len = scalar @chars;
    my @secret = ( 3257665815644502181, 10067880064238660809, 5418857496715711651 );

    my $seed = rapid_mix(0 ^ $secret[0], $secret[1]) ^ $len;
    my $a = 0;
    my $b = 0;

    local *read64 = sub {
        my ($i) = @_;
        return ord($chars[$i])
            | (ord($chars[$i + 1])