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