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