1#!/usr/bin/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 bison) to
123the ftnchek maintainer listed in README.
124END_ERROR_MESSAGE
125
126exit(1);
127}
128