1#!@PERL@
2
3# $Id: make_blockmatch.pl.in,v 1.3 2001/05/27 14:28:48 moniot Rel $
4
5#  Script to generate block_match.h file from tokdefs.h.  The result is
6#  the contents of an array to map from block-closing tokens to the
7#  required block-opening tokens.  It is used by fortran.y in pop_block
8#  routine to check proper balancing of structured control forms.
9
10%block_opener = (
11      'ELSE' => 'IF',
12      'ENDIF' => 'IF',
13      'ENDDO' => 'DO',
14      'CASE' => 'SELECTCASE',
15      'ENDSELECT' => 'SELECTCASE',
16      'ENDSUBROUTINE' => 'SUBROUTINE',
17      'ENDFUNCTION' => 'FUNCTION',
18      'ENDPROGRAM' => 'PROGRAM',
19      'ENDBLOCKDATA' => 'BLOCKDATA'
20);
21
22
23		# Read the token definitions.  Find the defs corresponding
24		# to block oeners and closers, and save them in hashes.
25
26open(TOKDEFS,"tokdefs.h") || die "Can't open tokdefs.h: $!";
27
28$min_block_token = -1;
29$max_block_token = -1;
30foreach (<TOKDEFS>) {
31    if( /^\#\s*define\s+tok_(\S*)\s*(\d+)/ ) {
32	$name = $1;
33	$number = $2;
34
35	if( grep(/^$name$/,values(%block_opener) ) ) {
36	    $opener_number{$name} = $number;
37	}
38	if( grep(/^$name$/,keys(%block_opener) ) ) {
39	    $closer_name{$number} = $name;
40	}
41				# keep track of min and max block tokens
42	if( $opener_number{$name} || $closer_name{$number} ) {
43	    if( $min_block_token == -1 ) { $min_block_token = $number; }
44	    if( $max_block_token == -1 ) { $max_block_token = $number; }
45	    if( $number < $min_block_token ) { $min_block_token = $number; }
46	    if( $number > $max_block_token ) { $max_block_token = $number; }
47	}
48    }
49}
50
51close(TOKDEFS);
52
53		# Make sure tokdefs.h was parsed OK.  All the token names
54		# in the %block_opener table above must be defined.
55
56foreach ( (keys %block_opener) ) {
57    $key = $_;
58    if( ! grep(/^$key$/, values(%closer_name) ) ) {
59	not_found($key);
60    }
61}
62
63foreach ( (values %block_opener) ) {
64    $val = $_;
65    if( ! defined($opener_number{$val}) )  {
66	not_found($val);
67    }
68}
69
70		# Find range of token values used to index array
71
72$min_closer = (sort keys %closer_name)[0];
73$max_closer = (reverse sort keys %closer_name)[0];
74
75		# Print initializer for the C lookup table that gives
76		# matching opener for any closer.  This initializer is
77		# to be included like so:
78		#   int block_opener[] = {
79		#   #include "blockmatch.h"
80		#   };
81		# It also defines range and offset of index values.
82		# Look up a value as
83		#   matching_token = block_opener[closer_token-MIN_CLOSER]
84
85print <<END_OF_TEXT;
86/* DO NOT EDIT
87     File automatically generated by make_blockmatch.pl from tokdefs.h
88*/
89#define MIN_CLOSER $min_closer
90#define MAX_CLOSER $max_closer
91#define MIN_BLOCK_TOKEN $min_block_token
92#define MAX_BLOCK_TOKEN $max_block_token
93END_OF_TEXT
94
95for($i=$min_closer; $i <= $max_closer; $i++) {
96    if( ($i-$min_closer) % 10 == 0) {
97	print "\n";		# newline every 10 values
98    }
99		# Put matching token number in the array at each closing
100		# token.  If array position is not for a closer, put a zero.
101    if( defined($closer_name{$i}) ) {
102	print "$opener_number{$block_opener{$closer_name{$i}}},";
103    }
104    else {
105	print "0,";
106    }
107}
108print "\n";
109
110		# This error should not occur unless the user has touched
111		# fortran.y and re-made fortran.h and tokdefs.h with a
112		# different parser generator
113sub not_found {
114print STDERR <<END_ERROR_MESSAGE;
115
116  ===> ERROR: tok_$_[0] not found in tokdefs.h <===
117
118This probably means that the regular expression in the first foreach
119of $0 is not correct for the tokdefs.h file produced
120using the local parser generator.  Please send a copy of the tokdefs.h
121file, along with information identifying the operating system and the
122name and version number of the parser generator (probably @YACC@) to
123the ftnchek maintainer listed in README.
124END_ERROR_MESSAGE
125
126exit(1);
127}
128