88use File::Spec;
99use File::Find;
1010
11+ my $format = ' el'
12+
13+ if ($ARGV [0] =~ / ^-(\S +)$ /
14+ $format = $1 ;
15+ shift @ARGV ;
16+ }
17+
1118my ($outfile , $srcdir , $objdir ) = @ARGV ;
1219
1320if (!defined ($outfile )) {
14- die " Usage: $0 outfile srcdir objdir\n "
21+ die " Usage: $0 [-format] outfile srcdir objdir\n "
1522}
1623
17- $srcdir = File::Spec-> curdir() unless (defined ($srcdir ));
18- $objdir = $srcdir unless (defined ($objdir ));
24+ my @vpath ;
25+
26+ $srcdir = $srcdir || File::Spec-> curdir();
27+ $objdir = $objdir || $srcdir ;
28+ push (@vpath , $objdir ) if ($objdir ne $srcdir );
29+ push (@vpath , $srcdir );
1930
2031my %tokens = (); # Token lists per category
2132my %token_category = (); # Tokens to category map
2738 return push (@$$ref , @_ );
2839}
2940
41+ # Search for a file, and return a file handle if successfully opened
42+ sub open_vpath ($$) {
43+ my ($mode , $file ) = @_ ;
44+ my %tried ;
45+
46+ # For simplicity, allow filenames to be specified
47+ # with Unix / syntax internally
48+ $file = File::Spec-> catfile(split (/ \/ / $file ));
49+
50+ foreach my $d (@vpath ) {
51+ my $fn = File::Spec-> catfile($d , $file );
52+ next if ($tried {$fn });
53+ $tried {$fn }++;
54+ my $fh ;
55+ return $fh if (open ($fh , $mode , $fn ));
56+ }
57+ return undef ;
58+ }
59+
60+ sub must_open ($) {
61+ my ($file ) = @_ ;
62+ my $fh = open_vpath(' <' $file );
63+ return $fh if (defined ($fh ));
64+ die " $0 :$file : $! \n "
65+ }
66+
3067# Combine some specific token types
3168my %override = (
3269 ' brcconst' => ' special-constant'
5491sub read_tokhash_c ($) {
5592 my ($tokhash_c ) = @_ ;
5693
57- open (my $th , ' <' $tokhash_c )
58- or die " $0 :$tokhash_c : $! \n "
94+ my $th = must_open($tokhash_c );
5995
6096 my $l ;
6197 my $tokendata = 0;
97133sub read_pptok_c ($) {
98134 my ($pptok_c ) = @_ ;
99135
100- open (my $pt , ' <' $pptok_c )
101- or die " $0 :$pptok_c : $! \n "
136+ my $pt = must_open($pptok_c );
102137
103138 my $l ;
104139 my $pp_dir = 0;
123158sub read_directiv_dat ($) {
124159 my ($directiv_dat ) = @_ ;
125160
126- open (my $dd , ' <' $directiv_dat )
127- or die " $0 :$directiv_dat : $! \n "
161+ my $dd = must_open($directiv_dat );
128162
129163 my $l ;
130164 my $directiv = 0;
@@ -145,22 +179,25 @@ ($)
145179 close ($dd );
146180}
147181
148- my $ version
182+ my % version
149183sub read_version ($) {
150184 my ($vfile ) = @_ ;
151- open (my $v , ' <' $vfile )
152- or die " $0 :$vfile : $! \n "
153-
154- $version = <$v >;
155- chomp $version ;
185+ my $v = must_open($vfile );
156186
187+ while (defined (my $vl = <$v >)) {
188+ if ($vl =~ / ^NASM_(\w +)=(\S +)\s *$ /
189+ $version {lc ($1 )} = $2 ;
190+ }
191+ }
157192 close ($v );
158193}
159194
195+ # This is called from the directory search in read_macros(), so
196+ # don't use must_open() here.
160197sub read_macro_file ($) {
161198 my ($file ) = @_ ;
162199
163- open (my $fh , ' <' $file ) or die ;
200+ open (my $fh , ' <' $file ) or die " $0 : $file : $! \n "
164201 while (defined (my $l = <$fh >)) {
165202 next unless ($l =~ / ^\s *\% /
166203 my @f = split (/ \s +/ $l );
@@ -177,21 +214,20 @@ ($)
177214 close ($fh );
178215}
179216
180- sub read_macros ($$) {
181- my ($srcdir , $objdir ) = @_ ;
182- my @dirs ;
183- push (@dirs , $objdir );
184- push (@dirs , File::Spec-> catdir($srcdir , ' macros'
185- push (@dirs , File::Spec-> catdir($srcdir , ' output'
217+ sub read_macros (@) {
218+ my %visited ;
219+ my @dirs = (File::Spec-> curdir(), qw( macros output editors)
220+ @dirs = map { my $od = $_ ; map { File::Spec-> catdir($od , $_ ) } @dirs } @_ ;
186221 foreach my $dir (@dirs ) {
187- opendir (my $dh , $dir ) or die ;
222+ next if ($visited {$dir });
223+ $visited {$dir }++;
224+ next unless opendir (my $dh , $dir );
188225 while (defined (my $fn = readdir ($dh ))) {
189- next unless ($fn =~ / \. mac$ /
190- read_macro_file(File::Spec-> catdir ($dir , $fn ));
226+ next unless ($fn =~ / \. mac$ /i
227+ read_macro_file(File::Spec-> catfile ($dir , $fn ));
191228 }
229+ closedir ($dh );
192230 }
193- # Don't read the whole misc directory!
194- read_macro_file(File::Spec-> catdir($srcdir , ' misc/builtin.mac'
195231}
196232
197233sub make_lines ($$@) {
@@ -235,18 +271,15 @@ (@)
235271 return map { s /\\\"\' ]/ \\ $1 / g ' "' $_ .' "' @_ ;
236272}
237273
238- sub write_output ($) {
239- my ($outfile ) = @_ ;
240-
241- open (my $out , ' >' $outfile )
242- or die " $0 :$outfile : $! \n "
243-
244- my ($vol ,$dir ,$file ) = File::Spec-> splitpath($outfile );
274+ # Emacs LISP
275+ sub write_output_el {
276+ my ($out , $outfile , $file ) = @_ ;
277+ my $whoami = ' NASM ' $version {' ver'
245278
246279 print $out " ;;; ${file} --- lists of NASM assembler tokens\n\n "
247280 print $out " ;;; Commentary:\n\n "
248281 print $out " ;; This file contains list of tokens from the NASM x86\n "
249- print $out " ;; assembler, automatically extracted from NASM ${version }\n "
282+ print $out " ;; assembler, automatically extracted from ${whoami }\n "
250283 print $out " ;;\n "
251284 print $out " ;; This file is intended to be (require)d from a `nasm-mode\'\n "
252285 print $out " ;; major mode definition.\n "
@@ -268,28 +301,69 @@ ($)
268301
269302 print $out make_lines(78, 4, quote_for_emacs(sort @{$tokens {$type }}));
270303 print $out " )\n "
271- print $out " \" NASM ${version }${type} tokens for `nasm-mode\' .\" )\n "
304+ print $out " \" ${whoami }${type} tokens for `nasm-mode\' .\" )\n "
272305 }
273306
274307 # Generate a list of all the token type lists.
275308 print $out " \n (defconst nasm-token-lists\n "
276309 print $out " \' ("
277310 print $out make_lines(78, 4, map { " 'nasm-$_ " sort keys (%tokens ));
278311 print $out " )\n "
279- print $out " \" List of all NASM token type lists.\" )\n "
280-
312+ print $out " \" List of all ${whoami} token type lists.\" )\n "
313+
314+ # The NASM token extracted version
315+ printf $out " \n (defconst nasm-token-version %s \n "
316+ quote_for_emacs($version {' ver'
317+ print $out " \" Version of NASM from which tokens were extracted,\n "
318+ print $out " as a human-readable string.\" )\n "
319+
320+ printf $out " \n (defconst nasm-token-version-id #x%08x\n "
321+ $version {' version_id'
322+ print $out " \" Version of NASM from which tokens were extracted,\n "
323+ print $out " as numeric identifier, for comparisons. Equivalent to the\n "
324+ print $out " __?NASM_VERSION_ID?__ NASM macro value.\" )\n "
325+
326+ printf $out " \n (defconst nasm-token-version-snapshot %s \n "
327+ $version {' snapshot' ' nil'
328+ print $out " \" Daily NASM snapshot build from which tokens were extracted,\n "
329+ print $out " as a decimal number in YYYYMMDD format, or nil if not a\n "
330+ print $out " daily snapshot build.\" )\n "
281331
282332 # Footer
283333 print $out " \n (provide 'nasmtok)\n "
284334 print $out " ;;; nasmtok.el ends here\n "
285335
286- close ( $out ) ;
336+ return 0 ;
287337}
288338
289- read_tokhash_c(File::Spec-> catfile($objdir , ' asm' ' tokhash.c'
290- read_pptok_c(File::Spec-> catfile($objdir , ' asm' ' pptok.c'
291- read_directiv_dat(File::Spec-> catfile($srcdir , ' asm' ' directiv.dat'
292- read_version(File::Spec-> catfile($srcdir , ' version'
293- read_macros($srcdir , $objdir );
339+ sub write_output ($$) {
340+ my ($format , $outfile ) = @_ ;
341+ my %formats = (
342+ ' el' => \&write_output_el
343+ );
344+
345+ my $outfunc = $formats {$format };
346+ if (!defined ($outfunc )) {
347+ die " $0 : unknown output format: $format \n "
348+ }
349+
350+ open (my $out , ' >' $outfile )
351+ or die " $0 :$outfile : $! \n "
352+
353+ my ($vol ,$dir ,$file ) = File::Spec-> splitpath($outfile );
354+
355+ my $err = $outfunc -> ($out , $outfile , $file );
356+ close ($out );
357+
358+ if ($err ) {
359+ unlink ($outfile );
360+ die " $0 :$outfile : error writing output\n "
361+ }
362+ }
294363
295- write_output($outfile );
364+ read_tokhash_c(' asm/tokhash.c'
365+ read_pptok_c(' asm/pptok.c'
366+ read_directiv_dat(' asm/directiv.dat'
367+ read_version(' version.mak'
368+ read_macros(@vpath );
369+ write_output($format , $outfile );
0 commit comments