1### ====================================================================
2###  @Awk-file{
3###     author          = "Nelson H. F. Beebe",
4###     version         = "1.1",
5###     date            = "13 March 1995",
6###     revision        = "10 March 2000",
7###     time            = "17:20:54 MST",
8###     filename        = "dcl2inc.awk",
9###     address         = "Center for Scientific Computing
10###                        Department of Mathematics
11###                        University of Utah
12###                        Salt Lake City, UT 84112
13###                        USA",
14###     telephone       = "+1 801 581 5254",
15###     FAX             = "+1 801 581 4148",
16###     checksum        = "3212047631 4467",
17###     email           = "beebe@math.utah.edu (Internet)",
18###     codetable       = "ISO/ASCII",
19###     keywords        = "Fortran, type declarations",
20###     supported       = "yes",
21###     docstring       = "Extract COMMON block declarations from .dcl
22###                        files output by ftnchek 2.8.2 (or later), and
23###                        provided that they are unique, output *.inc
24###                        include files, and modified .dcl files with
25###                        extension .dcn containing INCLUDE statements
26###                        in place of COMMON block declarations.  In
27###                        addition, write a sorted list of include file
28###                        dependencies on stdout, suitable for use in a
29###                        Makefile.
30###
31###                        Usage:
32###                        	ftnchek -makedcls=1 *.f
33###                        	nawk -f dcl2inc.awk *.dcl >tempfile
34###
35###                        You can then manually replace the old
36###                        declarations in the *.f files with the
37###                        contents of each corresponding *.dcn file.
38###                        Any COMMON blocks that are not identical to
39###                        their first occurrence will be left intact,
40###                        instead of being replaced by INCLUDE
41###                        statements, and a warning will be issued for
42###                        each of them.
43###
44###                        The checksum field above contains a CRC-32
45###                        checksum as the first value, followed by
46###                        the byte count, both computed on the
47###                        content beginning with the BEGIN line.
48###                        This checksum is produced by the GNU cksum
49###                        utility.  To reproduce it, use
50###                          sed -n '/^BEGIN/,$p' dcl2inc.awk.in | cksum
51###
52###                        Modified warning function to be configurable
53###                        for gawk or nawk: R. Moniot March 2000",
54###  }
55### ====================================================================
56
57BEGIN					{ dcn_file_name = "" }
58
59/^[cC*!]====>Begin Module/		{ begin_module() }
60
61/^[cC*!]====>End Module/		{ end_module() }
62
63/^[cC*!]     Common variables/		{ begin_common() }
64
65/^[cC*!]     Equivalenced common/	{ equivalenced_common() }
66
67/^  [ ]*COMMON /			{ get_common_name() }
68
69in_common == 1				{ add_common() }
70
71/./					{ output_dcn_line($0) }
72
73END   					{ output_declarations() }
74
75function add_common()
76{
77    common_block = common_block "\n" $0
78}
79
80function begin_common()
81{
82    end_module()
83    in_common = 1
84    common_block = substr($0,1,1) 	# start with empty comment line
85    common_name = ""
86    common_fnr = FNR
87    basename = FILENAME
88    sub(/[.].*$/,"",basename)
89}
90
91function begin_module()
92{
93    end_module()
94    # Typical line:
95    # c====>Begin Module PROB5_4DIM   File dp5_4dim.f     All variables
96    last_dcn_file_name = dcn_file_name
97    dcn_file_name = $5
98    sub(/[.].*$/,".dcn",dcn_file_name)
99    if ((last_dcn_file_name != "") && (last_dcn_file_name != dcn_file_name))
100	close(last_dcn_file_name)
101    if (last_dcn_file_name != dcn_file_name)
102	output_dependency_list()
103    if (last_dcn_file_name == "")
104	output_dcn_line(substr($0,1,1))
105}
106
107function clear_array(array, key)
108{
109    for (key in array)
110	delete array[key]
111}
112
113function end_common( name)
114{
115    in_common = 0
116    if (common_name == "")
117	return
118    if ((common_name in include_file_contents) &&
119	(include_file_contents[common_name] != common_block))
120    {
121	warning("Common block /" common_name "/ mismatch with definition at " \
122	    include_file_common_filename[common_name] ":" \
123	    include_file_common_position[common_name])
124	output_dcn_line(common_block)
125	common_name = ""
126	return
127    }
128    output_dcn_line("      INCLUDE '" common_name ".inc'")
129
130    name = common_name ".inc"
131    dependency_list[name] = name
132    include_file_contents[common_name] = common_block
133    include_file_common_position[common_name] = common_fnr "--" FNR
134    include_file_common_filename[common_name] = FILENAME
135    common_name = ""
136}
137
138function end_module()
139{
140    end_common()
141}
142
143function equivalenced_common()
144{
145    end_common()
146    output_dcn_line(substr($0,1,1))
147}
148
149
150function get_common_name( words)
151{
152    split($0, words, "/")
153    common_name = Tolower(trim(words[2]))
154}
155
156function output_declarations( common_file,name)
157{
158    output_dependency_list()
159    close(dcn_file_name)
160    for (name in include_file_contents)
161    {
162	common_file = name ".inc"
163	print include_file_contents[name] > common_file
164	close (common_file)
165    }
166}
167
168function output_dependency_list( k,line,prefix)
169{
170    sort_array(dependency_list)
171    prefix = "                "
172
173    for (k = 1; k in dependency_list; ++k)
174    {
175	if (k == 1)
176	{
177	    line = basename ".o:"
178	    line = line substr(prefix,1,16-length(line)) basename ".f"
179	}
180	if ((length(line) + 1 + length(dependency_list[k])) > 77)
181	{
182	    print line " \\"
183	    line = substr(prefix,1,15)
184	}
185	line = line " " dependency_list[k]
186    }
187    if (k > 1)
188	print line
189
190    clear_array(dependency_list)
191}
192
193function output_dcn_line(s)
194{
195    if ((!in_common) && (dcn_file_name != ""))
196	print s > dcn_file_name
197}
198
199function sort_array(array, k,key,m,n,sorted_copy)
200{
201    n = 0
202    for (key in array)
203    {
204	n++
205	sorted_copy[n] = array[key]
206    }
207
208    for (k = 1; k < n; ++k)
209    {
210	for (m = k + 1; m <= n; ++m)
211	{
212	    if (sorted_copy[k] > sorted_copy[m])
213	    {
214		key = sorted_copy[m]
215		sorted_copy[m] = sorted_copy[k]
216		sorted_copy[k] = key
217	    }
218	}
219    }
220
221    clear_array(array)
222
223    for (k = 1; k <= n; ++k)
224	array[k] = sorted_copy[k]
225}
226
227function Tolower(s, k,n,t)
228{
229    t = ""
230    for (k = 1; k <= length(s); ++k)
231    {
232	n = index("ABCDEFGHIJKLMNOPQRSTUVWXYZ", substr(s,k,1))
233	if (n > 0)
234	    t = t substr("abcdefghijklmnopqrstuvwxyz", n, 1)
235	else
236	    t = t substr(s,k,1)
237    }
238    return (t)
239}
240
241function trim(s)
242{
243    gsub(/^ */,"",s)
244    gsub(/ *$/,"",s)
245    return (s)
246}
247
248function warning(message)
249{
250    # Although gawk provides "/dev/stderr" for writing to stderr, nawk
251    # requires a subterfuge: see Aho, Kernighan, and Weinberger, ``The
252    # AWK Programming Language'', Addison-Wesley (1986), ISBN
253    # 0-201-07981-X, LCCN QA76.73.A95 A35 1988, p. 59.  We need to be
254    # able to output to the true stderr unit in order for the ftnchek
255    # validation suite to check these warnings.  The configure script
256    # puts in appropriate redirect for nawk or gawk, depending on which
257    # one your system has.
258    print FILENAME ":" FNR ":\t" message  > "/dev/stderr"
259}
260