File: dcl2inc.awk

package info (click to toggle)
ftnchek 3.3.1-7
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 8,684 kB
  • sloc: ansic: 21,908; fortran: 5,748; yacc: 4,071; sh: 3,035; makefile: 895; lisp: 322; f90: 118; perl: 76
file content (259 lines) | stat: -rw-r--r-- 7,359 bytes parent folder | download | duplicates (5)
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
### ====================================================================
###  @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"
}