summaryrefslogtreecommitdiff
path: root/pptok.pl
diff options
context:
space:
mode:
authorH. Peter Anvin <hpa@zytor.com>2007-09-12 01:29:43 +0000
committerH. Peter Anvin <hpa@zytor.com>2007-09-12 01:29:43 +0000
commit4169a47bd9daba2eb03d6c435722f1bb0bb6f52c (patch)
treeedc9826eed78c333119a5ad3083aa455f98a66da /pptok.pl
parentcdea6f96b69a31e7d9294ac9b7f9f1167f722ed8 (diff)
downloadnasm-4169a47bd9daba2eb03d6c435722f1bb0bb6f52c.tar.gz
Use a perfect hash to look up preprocessor directives
Use a perfect hash to look up preprocessor directives, and generate the preprocessor directive list automatically.
Diffstat (limited to 'pptok.pl')
-rwxr-xr-xpptok.pl147
1 files changed, 147 insertions, 0 deletions
diff --git a/pptok.pl b/pptok.pl
new file mode 100755
index 00000000..df64cdee
--- /dev/null
+++ b/pptok.pl
@@ -0,0 +1,147 @@
+#!/usr/bin/perl
+#
+# Produce pptok.c and pptok.h 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>)) {
+ chomp $line;
+ $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);
+
+foreach $ct (@cctok) {
+ foreach $cc (@cond) {
+ push(@pptok, $ct.$cc);
+ push(@pptok, $ct.'n'.$cc);
+ }
+}
+
+@pptok = sort @pptok;
+
+open(OUT, "> $out") or die "$0: cannot open: $out\n";
+print OUT "/* Automatically generated from $in by $0 */\n";
+print OUT "/* Do not edit */\n";
+print OUT "\n";
+
+#
+# Output pptok.h
+#
+if ($what eq 'h') {
+ print OUT "enum preproc_token {\n";
+ foreach $pt (@pptok) {
+ (my $px = $pt) =~ s/\%//g;
+ print OUT " PP_\U$px\E,\n";
+ }
+ print OUT " PP_INVALID = -1\n";
+ print OUT "};\n";
+}
+
+#
+# Output pptok.c
+#
+if ($what eq 'c') {
+ my %tokens = ();
+ my @tokendata = ();
+
+ foreach $pt (@pptok) {
+ (my $px = $pt) =~ s/\%//g;
+ $tokens{$pt} = scalar @tokendata;
+ push(@tokendata, $pt);
+ }
+
+ my @hashinfo = gen_perfect_hash(\%tokens);
+ if (!defined(@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 <inttypes.h>\n";
+ print OUT "#include <ctype.h>\n";
+ print OUT "#include \"nasmlib.h\"\n";
+ print OUT "#include \"preproc.h\"\n";
+ print OUT "\n";
+
+ print OUT "#define rot(x,y) (((uint32_t)(x) << (y))+((uint32_t)(x) >> (32-(y))))\n";
+ print OUT "\n";
+
+ # Note that this is global.
+ printf OUT "const char * const pp_directives[%d] = {\n",
+ scalar(@tokendata);
+ foreach $d (@tokendata) {
+ print OUT " \"$d\",\n";
+ }
+ 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 16383\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 = 0, k2 = 0;\n";
+ print OUT " uint8_t c;\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 " const char *p = token;\n";
+ print OUT "\n";
+
+ print OUT " while ((c = *p++) != 0) {\n";
+ print OUT " c = tolower(c);\n";
+ printf OUT " uint32_t kn1 = rot(k1,%2d) - rot(k2,%2d) + c;\n", ${$sv}[0], ${$sv}[1];
+ printf OUT " uint32_t kn2 = rot(k2,%2d) - rot(k1,%2d) + c;\n", ${$sv}[2], ${$sv}[3];
+ print OUT " k1 = kn1; k2 = kn2;\n";
+ print OUT " }\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(@tokendata);
+ print OUT " return PP_INVALID;\n";
+ print OUT "\n";
+
+ print OUT " if (nasm_stricmp(pp_directives[ix], token))\n";
+ print OUT " return PP_INVALID;\n";
+ print OUT "\n";
+ print OUT " return ix;\n";
+ print OUT "}\n";
+}