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