#!/usr/bin/perl
## --------------------------------------------------------------------------
##
## Copyright 1996-2009 The NASM Authors - All Rights Reserved
## See the file AUTHORS included with the NASM distribution for
## the specific copyright holders.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following
## conditions are met:
##
## * Redistributions of source code must retain the above copyright
## notice, this list of conditions and the following disclaimer.
## * Redistributions in binary form must reproduce the above
## copyright notice, this list of conditions and the following
## disclaimer in the documentation and/or other materials provided
## with the distribution.
##
## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
## CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
## DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
## OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
##
## --------------------------------------------------------------------------
#
# Produce pptok.c, pptok.h and pptok.ph from pptok.dat
#
require 'phash.ph';
my($what, $in, $out) = @ARGV;
#
# Read pptok.dat
#
open(IN, '<', $in) or die "$0: cannot open: $in\n";
while (defined($line = <IN>)) {
$line =~ s/\r?\n$//; # Remove trailing \r\n or \n
$line =~ s/^\s+//; # Remove leading whitespace
$line =~ s/\s*\#.*$//; # Remove comments and trailing whitespace
next if ($line eq '');
if ($line =~ /^\%(.*)\*$/) {
push(@cctok, $1);
} elsif ($line =~ /^\%(.*)$/) {
push(@pptok, $1);
} elsif ($line =~ /^\*(.*)$/) {
push(@cond, $1);
}
}
close(IN);
@cctok = sort @cctok;
@cond = sort @cond;
@pptok = sort @pptok;
# Generate the expanded list including conditionals. The conditionals
# are at the beginning, padded to a power of 2, with the inverses
# interspersed; this allows a simple mask to pick out the condition.
while ((scalar @cond) & (scalar @cond)-1) {
push(@cond, undef);
}
@cptok = ();
foreach $ct (@cctok) {
foreach $cc (@cond) {
if (defined($cc)) {
push(@cptok, $ct.$cc);
push(@cptok, $ct.'n'.$cc);
} else {
push(@cptok, undef, undef);
}
}
}
$first_uncond = $pptok[0];
@pptok = (@cptok, @pptok);
open(OUT, '>', $out) or die "$0: cannot open: $out\n";
#
# Output pptok.h
#
if ($what eq 'h') {
print OUT "/* Automatically generated from $in by $0 */\n";
print OUT "/* Do not edit */\n";
print OUT "\n";
print OUT "enum preproc_token {\n";
$n = 0;
foreach $pt (@pptok) {
if (defined($pt)) {
printf OUT " %-16s = %3d,\n", "PP_\U$pt\E", $n;
}
$n++;
}
printf OUT " %-16s = %3d\n", 'PP_INVALID', -1;
print OUT "};\n";
print OUT "\n";
print OUT "enum pp_conditional {\n";
$n = 0;
$c = '';
foreach $cc (@cond) {
if (defined($cc)) {
printf OUT "$c %-16s = %3d", "PPC_IF\U$cc\E", $n;
$c = ',';
}
$n += 2;
}
print OUT "\n};\n\n";
printf OUT "#define PP_COND(x) ((enum pp_conditional)((x) & 0x%x))\n",
(scalar(@cond)-1) << 1;
print OUT "#define PP_IS_COND(x) ((unsigned int)(x) < PP_\U$first_uncond\E)\n";
print OUT "#define PP_NEGATIVE(x) ((x) & 1)\n";
print OUT "\n";
foreach $ct (@cctok) {
print OUT "#define CASE_PP_\U$ct\E";
$pref = " \\\n";
foreach $cc (@cond) {
if (defined($cc)) {
print OUT "$pref\tcase PP_\U${ct}${cc}\E: \\\n";
print OUT "\tcase PP_\U${ct}N${cc}\E";
$pref = ":\\\n";
}
}
print OUT "\n"; # No colon or newline on the last one
}
}
#
# Output pptok.c
#
if ($what eq 'c') {
print OUT "/* Automatically generated from $in by $0 */\n";
print OUT "/* Do not edit */\n";
print OUT "\n";
my %tokens = ();
my @tokendata = ();
my $n = 0;
foreach $pt (@pptok) {
if (defined($pt)) {
$tokens{'%'.$pt} = $n;
if ($pt =~ /[\@\[\]\\_]/) {
# Fail on characters which look like upper-case letters
# to the quick-and-dirty downcasing in the prehash
# (see below)
die "$in: invalid character in token: $pt";
}
}
$n++;
}
my @hashinfo = gen_perfect_hash(\%tokens);
if (!@hashinfo) {
die "$0: no hash found\n";
}
# Paranoia...
verify_hash_table(\%tokens, \@hashinfo);
($n, $sv, $g) = @hashinfo;
$sv2 = $sv+2;
die if ($n & ($n-1));
print OUT "#include \"compiler.h\"\n";
print OUT "#include <ctype.h>\n";
print OUT "#include \"nasmlib.h\"\n";
print OUT "#include \"hashtbl.h\"\n";
print OUT "#include \"preproc.h\"\n";
print OUT "\n";
# Note that this is global.
printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
foreach $d (@pptok) {
if (defined($d)) {
print OUT " \"%$d\",\n";
} else {
print OUT " NULL,\n";
}
}
print OUT "};\n";
printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
foreach $d (@pptok) {
printf OUT " %d,\n", defined($d) ? length($d)+1 : 0;
}
print OUT "};\n";
print OUT "enum preproc_token pp_token_hash(const char *token)\n";
print OUT "{\n";
# Put a large value in unused slots. This makes it extremely unlikely
# that any combination that involves unused slot will pass the range test.
# This speeds up rejection of unrecognized tokens, i.e. identifiers.
print OUT "#define UNUSED (65535/3)\n";
print OUT " static const int16_t hash1[$n] = {\n";
for ($i = 0; $i < $n; $i++) {
my $h = ${$g}[$i*2+0];
print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
}
print OUT " };\n";
print OUT " static const int16_t hash2[$n] = {\n";
for ($i = 0; $i < $n; $i++) {
my $h = ${$g}[$i*2+1];
print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
}
print OUT " };\n";
print OUT " uint32_t k1, k2;\n";
print OUT " uint64_t crc;\n";
# For correct overflow behavior, "ix" should be unsigned of the same
# width as the hash arrays.
print OUT " uint16_t ix;\n";
print OUT "\n";
printf OUT " crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
$$sv[0], $$sv[1];
print OUT " k1 = (uint32_t)crc;\n";
print OUT " k2 = (uint32_t)(crc >> 32);\n";
print OUT "\n";
printf OUT " ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
printf OUT " if (ix >= %d)\n", scalar(@pptok);
print OUT " return PP_INVALID;\n";
print OUT "\n";
print OUT " if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
print OUT " return PP_INVALID;\n";
print OUT "\n";
print OUT " return ix;\n";
print OUT "}\n";
}
#
# Output pptok.ph
#
if ($what eq 'ph') {
print OUT "# Automatically generated from $in by $0\n";
print OUT "# Do not edit\n";
print OUT "\n";
print OUT "%pptok_hash = (\n";
$n = 0;
foreach $tok (@pptok) {
if (defined($tok)) {
printf OUT " '%%%s' => %d,\n", $tok, $n;
}
$n++;
}
print OUT ");\n";
print OUT "1;\n";
}