[nasm:emacs] misc/emacstbl.el: script to produce token lists for an emacs mode

[nasm-bot for H. Peter Anvin]

Commit-ID:  b58771d8278968e2ea36e8e66675c7d6d4105af9
Gitweb:     http://repo.or.cz/w/nasm.git?a=commitdiff;h=b58771d8278968e2ea36e8e66675c7d6d4105af9
Author:     H. Peter Anvin <hpa at zytor.com>
AuthorDate: Thu, 17 Nov 2022 11:50:03 -0800
Committer:  H. Peter Anvin <hpa at zytor.com>
CommitDate: Thu, 17 Nov 2022 11:50:03 -0800

misc/emacstbl.el: script to produce token lists for an emacs mode

Add a simple script to auto-generate token lists for an emacs major
mode, e.g. https://github.com/skeeto/nasm-mode

It is recommended to use "require" this file separately from the main
code, so it can be automatically kept up to date.

If this ends up being used, I will include the generated result in the
NASM release distribution.

Signed-off-by: H. Peter Anvin <hpa at zytor.com>


---
 misc/emacstbl.pl | 189 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 189 insertions(+)

diff --git a/misc/emacstbl.pl b/misc/emacstbl.pl
new file mode 100755
index 00000000..4c7673c9
--- /dev/null
+++ b/misc/emacstbl.pl
@@ -0,0 +1,189 @@
+#!/usr/bin/perl
+#
+# Automatically produce some tables useful for a NASM major mode
+#
+
+use integer;
+use strict;
+use File::Spec;
+
+my($outfile, $srcdir, $objdir) = @ARGV;
+
+if (!defined($outfile)) {
+    die "Usage: $0 outfile srcdir objdir\n";
+}
+
+$srcdir = File::Spec->curdir() unless (defined($srcdir));
+$objdir = $srcdir unless (defined($objdir));
+
+my %tokens = ();
+
+sub xpush($@) {
+    my $ref = shift @_;
+
+    $$ref = [] unless (defined($$ref));
+    return push(@$$ref, @_);
+}
+
+# Combine some specific token types
+my %override = ( 'id' => 'special',
+		 'float' => 'function',
+		 'floatize' => 'function',
+		 'strfunc' => 'function',
+		 'ifunc' => 'function',
+		 'seg' => 'special',
+		 'wrt' => 'special' );
+
+sub read_tokhash_c($) {
+    my($tokhash_c) = @_;
+
+    open(my $th, '<', $tokhash_c)
+	or die "$0:$tokhash_c: $!\n";
+
+    my $l;
+    my $tokendata = 0;
+    while (defined($l = <$th>)) {
+	if ($l =~ /\bstruct tokendata tokendata\[/) {
+	    $tokendata = 1;
+	    next;
+	} elsif (!$tokendata) {
+	    next;
+	}
+
+	last if ($l =~ /\}\;/);
+
+	if ($l =~ /^\s*\{\s*\"(.*?)\",.*?,\s*TOKEN_(\w+),.*\}/) {
+	    my $token = $1;
+	    my $type  = lc($2);
+
+	    if ($override{$type}) {
+		$type = $override{$type};
+	    } elsif ($token !~ /^\w/) {
+		$type = 'operator';
+	    } elsif ($token =~ /^__\?masm_.*\?__$/) {
+		next;
+	    }
+	    xpush(\$tokens{$type}, $token);
+	    if ($token =~ /^__\?(.*)\?__$/) {
+		# Also encode the "user" (macro) form without __?...?__
+		xpush(\$tokens{$type}, $1);
+	    }
+	}
+    }
+    close($th);
+}
+
+sub read_pptok_c($) {
+    my($pptok_c) = @_;
+
+    open(my $pt, '<', $pptok_c)
+	or die "$0:$pptok_c: $!\n";
+
+    my $l;
+    my $pp_dir = 0;
+
+    while (defined($l = <$pt>)) {
+	if ($l =~ /\bpp_directives\[/) {
+	    $pp_dir = 1;
+	    next;
+	} elsif (!$pp_dir) {
+	    next;
+	}
+
+	last if ($l =~ /\}\;/);
+
+	if ($l =~ /^\s*\"(.*?)\"/) {
+	    xpush(\$tokens{'pp-directive'}, $1);
+	}
+    }
+    close($pt);
+}
+
+sub read_directiv_dat($) {
+    my($directiv_dat) = @_;
+
+    open(my $dd, '<', $directiv_dat)
+	or die "$0:$directiv_dat: $!\n";
+
+    my $l;
+    my $directiv = 0;
+
+    while (defined($l = <$dd>)) {
+	if ($l =~ /^\; ---.*?(pragma)?/) {
+	    $directiv = ($1 ne 'pragma');
+	    next;
+	} elsif (!$directiv) {
+	    next;
+	}
+
+	if ($l =~ /^\s*(\w+)/) {
+	    xpush(\$tokens{'directive'}, $1);
+	}
+    }
+
+    close($dd);
+}
+
+sub make_lines($$@) {
+    my $maxline = shift @_;
+    my $indent  = shift @_;
+
+    # The first line isn't explicitly indented and the last line
+    # doesn't end in "\n"; assumed the surrounding formatter wants
+    # do control that
+    my $linepos   = 0;
+    my $linewidth = $maxline - $indent;
+
+    my $line = '';
+    my @lines = ();
+
+    foreach my $w (@_) {
+	my $l = length($w);
+
+	if ($linepos > 0 && $linepos+$l+1 >= $linewidth) {
+	    $line .= "\n" . (' ' x $indent);
+	    push(@lines, $line);
+	    $linepos = 0;
+	    $line = '';
+	}
+	if ($linepos > 0) {
+	    $line .= ' ';
+	    $linepos++;
+	}
+	$line .= $w;
+	$linepos += $l;
+    }
+
+    if ($linepos > 0) {
+	push(@lines, $line);
+    }
+
+    return @lines;
+}
+
+sub quote_for_emacs(@) {
+    return map { s/[\\\"\']/\\$1/g; '"'.$_.'"' } @_;
+}
+
+sub write_output($) {
+    my($outfile) = @_;
+
+    open(my $out, '>', $outfile)
+	or die "$0:$outfile: $!\n";
+
+    foreach my $type (sort keys(%tokens)) {
+	print $out "(defconst nasm-${type}\n";
+	print $out "  \'(";
+
+	print $out make_lines(78, 4, quote_for_emacs(sort @{$tokens{$type}}));
+	print $out "))\n";
+    }
+
+    close($out);
+}
+
+read_tokhash_c(File::Spec->catfile($objdir, 'asm', 'tokhash.c'));
+read_pptok_c(File::Spec->catfile($objdir, 'asm', 'pptok.c'));
+read_directiv_dat(File::Spec->catfile($srcdir, 'asm', 'directiv.dat'));
+
+write_output($outfile);