### ==================================================================== ### @Awk-file{ ### author = "Nelson H. F. Beebe", ### version = "1.1", ### date = "13 March 1995", ### revision = "10 March 2000", ### time = "17:20:54 MST", ### filename = "dcl2inc.awk", ### address = "Center for Scientific Computing ### Department of Mathematics ### University of Utah ### Salt Lake City, UT 84112 ### USA", ### telephone = "+1 801 581 5254", ### FAX = "+1 801 581 4148", ### checksum = "3212047631 4467", ### email = "beebe@math.utah.edu (Internet)", ### codetable = "ISO/ASCII", ### keywords = "Fortran, type declarations", ### supported = "yes", ### docstring = "Extract COMMON block declarations from .dcl ### files output by ftnchek 2.8.2 (or later), and ### provided that they are unique, output *.inc ### include files, and modified .dcl files with ### extension .dcn containing INCLUDE statements ### in place of COMMON block declarations. In ### addition, write a sorted list of include file ### dependencies on stdout, suitable for use in a ### Makefile. ### ### Usage: ### ftnchek -makedcls=1 *.f ### nawk -f dcl2inc.awk *.dcl >tempfile ### ### You can then manually replace the old ### declarations in the *.f files with the ### contents of each corresponding *.dcn file. ### Any COMMON blocks that are not identical to ### their first occurrence will be left intact, ### instead of being replaced by INCLUDE ### statements, and a warning will be issued for ### each of them. ### ### The checksum field above contains a CRC-32 ### checksum as the first value, followed by ### the byte count, both computed on the ### content beginning with the BEGIN line. ### This checksum is produced by the GNU cksum ### utility. To reproduce it, use ### sed -n '/^BEGIN/,$p' dcl2inc.awk.in | cksum ### ### Modified warning function to be configurable ### for gawk or nawk: R. Moniot March 2000", ### } ### ==================================================================== BEGIN { dcn_file_name = "" } /^[cC*!]====>Begin Module/ { begin_module() } /^[cC*!]====>End Module/ { end_module() } /^[cC*!] Common variables/ { begin_common() } /^[cC*!] Equivalenced common/ { equivalenced_common() } /^ [ ]*COMMON / { get_common_name() } in_common == 1 { add_common() } /./ { output_dcn_line($0) } END { output_declarations() } function add_common() { common_block = common_block "\n" $0 } function begin_common() { end_module() in_common = 1 common_block = substr($0,1,1) # start with empty comment line common_name = "" common_fnr = FNR basename = FILENAME sub(/[.].*$/,"",basename) } function begin_module() { end_module() # Typical line: # c====>Begin Module PROB5_4DIM File dp5_4dim.f All variables last_dcn_file_name = dcn_file_name dcn_file_name = $5 sub(/[.].*$/,".dcn",dcn_file_name) if ((last_dcn_file_name != "") && (last_dcn_file_name != dcn_file_name)) close(last_dcn_file_name) if (last_dcn_file_name != dcn_file_name) output_dependency_list() if (last_dcn_file_name == "") output_dcn_line(substr($0,1,1)) } function clear_array(array, key) { for (key in array) delete array[key] } function end_common( name) { in_common = 0 if (common_name == "") return if ((common_name in include_file_contents) && (include_file_contents[common_name] != common_block)) { warning("Common block /" common_name "/ mismatch with definition at " \ include_file_common_filename[common_name] ":" \ include_file_common_position[common_name]) output_dcn_line(common_block) common_name = "" return } output_dcn_line(" INCLUDE '" common_name ".inc'") name = common_name ".inc" dependency_list[name] = name include_file_contents[common_name] = common_block include_file_common_position[common_name] = common_fnr "--" FNR include_file_common_filename[common_name] = FILENAME common_name = "" } function end_module() { end_common() } function equivalenced_common() { end_common() output_dcn_line(substr($0,1,1)) } function get_common_name( words) { split($0, words, "/") common_name = Tolower(trim(words[2])) } function output_declarations( common_file,name) { output_dependency_list() close(dcn_file_name) for (name in include_file_contents) { common_file = name ".inc" print include_file_contents[name] > common_file close (common_file) } } function output_dependency_list( k,line,prefix) { sort_array(dependency_list) prefix = " " for (k = 1; k in dependency_list; ++k) { if (k == 1) { line = basename ".o:" line = line substr(prefix,1,16-length(line)) basename ".f" } if ((length(line) + 1 + length(dependency_list[k])) > 77) { print line " \\" line = substr(prefix,1,15) } line = line " " dependency_list[k] } if (k > 1) print line clear_array(dependency_list) } function output_dcn_line(s) { if ((!in_common) && (dcn_file_name != "")) print s > dcn_file_name } function sort_array(array, k,key,m,n,sorted_copy) { n = 0 for (key in array) { n++ sorted_copy[n] = array[key] } for (k = 1; k < n; ++k) { for (m = k + 1; m <= n; ++m) { if (sorted_copy[k] > sorted_copy[m]) { key = sorted_copy[m] sorted_copy[m] = sorted_copy[k] sorted_copy[k] = key } } } clear_array(array) for (k = 1; k <= n; ++k) array[k] = sorted_copy[k] } function Tolower(s, k,n,t) { t = "" for (k = 1; k <= length(s); ++k) { n = index("ABCDEFGHIJKLMNOPQRSTUVWXYZ", substr(s,k,1)) if (n > 0) t = t substr("abcdefghijklmnopqrstuvwxyz", n, 1) else t = t substr(s,k,1) } return (t) } function trim(s) { gsub(/^ */,"",s) gsub(/ *$/,"",s) return (s) } function warning(message) { # Although gawk provides "/dev/stderr" for writing to stderr, nawk # requires a subterfuge: see Aho, Kernighan, and Weinberger, ``The # AWK Programming Language'', Addison-Wesley (1986), ISBN # 0-201-07981-X, LCCN QA76.73.A95 A35 1988, p. 59. We need to be # able to output to the true stderr unit in order for the ftnchek # validation suite to check these warnings. The configure script # puts in appropriate redirect for nawk or gawk, depending on which # one your system has. print FILENAME ":" FNR ":\t" message > "/dev/stderr" }