|
| 1 | +#!/usr/bin/perl |
| 2 | +# |
| 3 | +# Automatically produce some tables useful for a NASM major mode |
| 4 | +# |
| 5 | + |
| 6 | +use integer; |
| 7 | +use strict; |
| 8 | +use File::Spec; |
| 9 | + |
| 10 | +my($outfile, $srcdir, $objdir) = @ARGV; |
| 11 | + |
| 12 | +if (!defined($outfile)) { |
| 13 | + die "Usage: $0 outfile srcdir objdir\n"; |
| 14 | +} |
| 15 | + |
| 16 | +$srcdir = File::Spec->curdir() unless (defined($srcdir)); |
| 17 | +$objdir = $srcdir unless (defined($objdir)); |
| 18 | + |
| 19 | +my %tokens = (); |
| 20 | + |
| 21 | +sub xpush($@) { |
| 22 | + my $ref = shift @_; |
| 23 | + |
| 24 | + $$ref = [] unless (defined($$ref)); |
| 25 | + return push(@$$ref, @_); |
| 26 | +} |
| 27 | + |
| 28 | +# Combine some specific token types |
| 29 | +my %override = ( 'id' => 'special', |
| 30 | + 'float' => 'function', |
| 31 | + 'floatize' => 'function', |
| 32 | + 'strfunc' => 'function', |
| 33 | + 'ifunc' => 'function', |
| 34 | + 'insn' => 'instruction', |
| 35 | + 'reg' => 'register', |
| 36 | + 'seg' => 'special', |
| 37 | + 'wrt' => 'special' ); |
| 38 | + |
| 39 | +sub read_tokhash_c($) { |
| 40 | + my($tokhash_c) = @_; |
| 41 | + |
| 42 | + open(my $th, '<', $tokhash_c) |
| 43 | + or die "$0:$tokhash_c: $!\n"; |
| 44 | + |
| 45 | + my $l; |
| 46 | + my $tokendata = 0; |
| 47 | + while (defined($l = <$th>)) { |
| 48 | + if ($l =~ /\bstruct tokendata tokendata\[/) { |
| 49 | + $tokendata = 1; |
| 50 | + next; |
| 51 | + } elsif (!$tokendata) { |
| 52 | + next; |
| 53 | + } |
| 54 | + |
| 55 | + last if ($l =~ /\}\;/); |
| 56 | + |
| 57 | + if ($l =~ /^\s*\{\s*\"(.*?)\",.*?,\s*TOKEN_(\w+),.*\}/) { |
| 58 | + my $token = $1; |
| 59 | + my $type = lc($2); |
| 60 | + |
| 61 | + if ($override{$type}) { |
| 62 | + $type = $override{$type}; |
| 63 | + } elsif ($token !~ /^\w/) { |
| 64 | + $type = 'operator'; |
| 65 | + } elsif ($token =~ /^__\?masm_.*\?__$/) { |
| 66 | + next; |
| 67 | + } |
| 68 | + xpush(\$tokens{$type}, $token); |
| 69 | + if ($token =~ /^__\?(.*)\?__$/) { |
| 70 | + # Also encode the "user" (macro) form without __?...?__ |
| 71 | + xpush(\$tokens{$type}, $1); |
| 72 | + } |
| 73 | + } |
| 74 | + } |
| 75 | + close($th); |
| 76 | +} |
| 77 | + |
| 78 | +sub read_pptok_c($) { |
| 79 | + my($pptok_c) = @_; |
| 80 | + |
| 81 | + open(my $pt, '<', $pptok_c) |
| 82 | + or die "$0:$pptok_c: $!\n"; |
| 83 | + |
| 84 | + my $l; |
| 85 | + my $pp_dir = 0; |
| 86 | + |
| 87 | + while (defined($l = <$pt>)) { |
| 88 | + if ($l =~ /\bpp_directives\[/) { |
| 89 | + $pp_dir = 1; |
| 90 | + next; |
| 91 | + } elsif (!$pp_dir) { |
| 92 | + next; |
| 93 | + } |
| 94 | + |
| 95 | + last if ($l =~ /\}\;/); |
| 96 | + |
| 97 | + if ($l =~ /^\s*\"(.*?)\"/) { |
| 98 | + xpush(\$tokens{'pp-directive'}, $1); |
| 99 | + } |
| 100 | + } |
| 101 | + close($pt); |
| 102 | +} |
| 103 | + |
| 104 | +sub read_directiv_dat($) { |
| 105 | + my($directiv_dat) = @_; |
| 106 | + |
| 107 | + open(my $dd, '<', $directiv_dat) |
| 108 | + or die "$0:$directiv_dat: $!\n"; |
| 109 | + |
| 110 | + my $l; |
| 111 | + my $directiv = 0; |
| 112 | + |
| 113 | + while (defined($l = <$dd>)) { |
| 114 | + if ($l =~ /^\; ---.*?(pragma)?/) { |
| 115 | + $directiv = ($1 ne 'pragma'); |
| 116 | + next; |
| 117 | + } elsif (!$directiv) { |
| 118 | + next; |
| 119 | + } |
| 120 | + |
| 121 | + if ($l =~ /^\s*(\w+)/) { |
| 122 | + xpush(\$tokens{'directive'}, $1); |
| 123 | + } |
| 124 | + } |
| 125 | + |
| 126 | + close($dd); |
| 127 | +} |
| 128 | + |
| 129 | +my $version; |
| 130 | +sub read_version($) { |
| 131 | + my($vfile) = @_; |
| 132 | + open(my $v, '<', $vfile) |
| 133 | + or die "$0:$vfile: $!\n"; |
| 134 | + |
| 135 | + $version = <$v>; |
| 136 | + chomp $version; |
| 137 | + |
| 138 | + close($v); |
| 139 | +} |
| 140 | + |
| 141 | +sub make_lines($$@) { |
| 142 | + my $maxline = shift @_; |
| 143 | + my $indent = shift @_; |
| 144 | + |
| 145 | + # The first line isn't explicitly indented and the last line |
| 146 | + # doesn't end in "\n"; assumed the surrounding formatter wants |
| 147 | + # do control that |
| 148 | + my $linepos = 0; |
| 149 | + my $linewidth = $maxline - $indent; |
| 150 | + |
| 151 | + my $line = ''; |
| 152 | + my @lines = (); |
| 153 | + |
| 154 | + foreach my $w (@_) { |
| 155 | + my $l = length($w); |
| 156 | + |
| 157 | + if ($linepos > 0 && $linepos+$l+1 >= $linewidth) { |
| 158 | + $line .= "\n" . (' ' x $indent); |
| 159 | + push(@lines, $line); |
| 160 | + $linepos = 0; |
| 161 | + $line = ''; |
| 162 | + } |
| 163 | + if ($linepos > 0) { |
| 164 | + $line .= ' '; |
| 165 | + $linepos++; |
| 166 | + } |
| 167 | + $line .= $w; |
| 168 | + $linepos += $l; |
| 169 | + } |
| 170 | + |
| 171 | + if ($linepos > 0) { |
| 172 | + push(@lines, $line); |
| 173 | + } |
| 174 | + |
| 175 | + return @lines; |
| 176 | +} |
| 177 | + |
| 178 | +sub quote_for_emacs(@) { |
| 179 | + return map { s/[\\\"\']/\\$1/g; '"'.$_.'"' } @_; |
| 180 | +} |
| 181 | + |
| 182 | +sub write_output($) { |
| 183 | + my($outfile) = @_; |
| 184 | + |
| 185 | + open(my $out, '>', $outfile) |
| 186 | + or die "$0:$outfile: $!\n"; |
| 187 | + |
| 188 | + my($vol,$dir,$file) = File::Spec->splitpath($outfile); |
| 189 | + |
| 190 | + print $out ";;; ${file} --- lists of NASM assembler tokens\n"; |
| 191 | + print $out ";;;\n"; |
| 192 | + print $out ";;; This file contains list of tokens from the NASM x86\n"; |
| 193 | + print $out ";;; assembler, automatically extracted from NASM ${version}.\n"; |
| 194 | + print $out ";;;\n"; |
| 195 | + print $out ";;; This file is intended to be (require)d from a `nasm-mode\'\n"; |
| 196 | + print $out ";;; major mode definition.\n"; |
| 197 | + |
| 198 | + foreach my $type (sort keys(%tokens)) { |
| 199 | + print $out "\n(defconst nasm-${type}\n"; |
| 200 | + print $out " \'("; |
| 201 | + |
| 202 | + print $out make_lines(78, 4, quote_for_emacs(sort @{$tokens{$type}})); |
| 203 | + print $out ")\n"; |
| 204 | + print $out " \"NASM ${version} ${type} tokens for `nasm-mode\'.\")\n"; |
| 205 | + } |
| 206 | + |
| 207 | + close($out); |
| 208 | +} |
| 209 | + |
| 210 | +read_tokhash_c(File::Spec->catfile($objdir, 'asm', 'tokhash.c')); |
| 211 | +read_pptok_c(File::Spec->catfile($objdir, 'asm', 'pptok.c')); |
| 212 | +read_directiv_dat(File::Spec->catfile($srcdir, 'asm', 'directiv.dat')); |
| 213 | +read_version(File::Spec->catfile($srcdir, 'version')); |
| 214 | + |
| 215 | +write_output($outfile); |
0 commit comments