home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
fchk294b.zip
/
ftnchek-2.9.4
/
dcl2inc.awk
< prev
next >
Wrap
Text File
|
1995-03-13
|
7KB
|
253 lines
### ====================================================================
### @Awk-file{
### author = "Nelson H. F. Beebe",
### version = "1.00",
### date = "13 March 1995",
### 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 = "40611 252 804 6984",
### 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-16
### checksum as the first value, followed by the
### equivalent of the standard UNIX wc (word
### count) utility output of lines, words, and
### characters. This is produced by Robert
### Solovay's checksum utility.",
### }
### ====================================================================
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.
print FILENAME ":" FNR ":\t" message | "cat 1>&2"
}