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"
}
|