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 yacc) to
the ftnchek maintainer listed in README.
END_ERROR_MESSAGE
exit(1);
}
|
