home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / csinfo.spt < prev    next >
Text File  |  1996-09-28  |  14KB  |  418 lines
  1. *-----------------------------------------------------------------------------
  2. *-                                                                          --
  3. *-                                 G N A T                                  --
  4. *-                                                                          --
  5. *-                            COMPILER UTILITIES                            --
  6. *-                                                                          --
  7. *-                               C S I N F O                                --
  8. *-                                                                          --
  9. *-                            $Revision: 1.28 $                             --
  10. *-                                                                          --
  11. *-           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. *-                                                                          --
  13. *- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. *- terms of the  GNU General Public License as published  by the Free Soft- --
  15. *- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. *- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. *- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. *- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. *- for  more details.  You should have  received  a copy of the GNU General --
  20. *- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. *- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. *-                                                                          --
  23. *-----------------------------------------------------------------------------
  24.  
  25. * Program to check consistency of Syntax_Info spec (sinfo.ads) and
  26. * Syntax_Info body (sinfo.adb). Checks that field name usage is consistent
  27. * and that debugging cross-reference lists are correct, as well as making
  28. * sure that all the comments on field name usage are consistent.
  29.  
  30.         terminal =
  31.         lineno = 0
  32.         &stlimit = -1
  33.         input(.in,1,'sinfo.ads')
  34.         &anchor = 1
  35.         wsp = span(' ' char(9))
  36.         fields = table(300)
  37.         refs = table(300)
  38.         terminal = 'Check for field name consistency'
  39.         digit = '0123456789'
  40.  
  41. * Special fields table. The following fields are not recorded or checked by
  42. * csinfo, since they are specially handled. This means that the both the
  43. * field definitions, and the corresponding subprograms are completely ignored.
  44.  
  45.         special = table(20)
  46.         special<'Analyzed'> = 1
  47.         special<'Assignment_OK'> = 1
  48.         special<'Cannot_Be_Constant'> = 1
  49.         special<'Chars'> = 1
  50.         special<'Comes_From_Source'> = 1
  51.         special<'Do_Overflow_Check'> = 1
  52.         special<'Do_Range_Check'> = 1
  53.         special<'Entity'> = 1
  54.         special<'Error_Posted'> = 1
  55.         special<'Etype'> = 1
  56.         special<'Evaluate_Once'> = 1
  57.         special<'First_Itype'> = 1
  58.         special<'Has_Dynamic_Itype'> = 1
  59.         special<'Has_No_Side_Effects'> = 1
  60.         special<'Has_Private_View'> = 1
  61.         special<'Is_Controlling_Actual'> = 1
  62.         special<'Is_Overloaded'> = 1
  63.         special<'Is_Static_Expression'> = 1
  64.         special<'Left_Opnd'> = 1
  65.         special<'Parens'> = 1
  66.         special<'Raises_Constraint_Error'> = 1
  67.         special<'Right_Opnd'> = 1
  68.  
  69. * The following define the standard fields used for binary operator, unary
  70. * operator, and other expression nodes. Numbers in the range 1-5 refer to
  71. * the Fieldn fields. Letters A-K refer to flags:
  72. *
  73. *     A = Flag1
  74. *     B = Flag2
  75. *     C = Flag3
  76. *     D = Flag4
  77. *     E = Flag5
  78. *     F = Flag6
  79. *     G = Flag7
  80. *     H = Flag8
  81. *     I = Flag9
  82. *     J = Flag1
  83. *     K = Flag10
  84. *     L = Flag11
  85. *     M = Flag12
  86. *     N = Flag13
  87. *     O = Flag14
  88. *     P = Flag15
  89. *     Q = Flag16
  90. *     R = Flag17
  91. *     S = Flag18
  92.  
  93.         e_fields = breakx("5EFGHIJ")
  94.         u_fields = breakx("1345EFGHIJKR")
  95.         b_fields = breakx("12345EFGHIJKR")
  96.  
  97. * Loop to acquire information from node definitions in sinfo.ads, checking
  98. * for consistency in Op/Flag assignments to each synonym
  99.  
  100. lp      line = trim(in)         :f(err)
  101.         lineno = lineno + 1
  102.         line '   -- Node Access Functions'    :s(nxt1)
  103.  
  104.         line wsp '--  N_' rem $ node          :f(n0)
  105.         node break(' .,')                     :s(n0)
  106.         fieldsused =                          :(lp)
  107.  
  108. n0      ident(node)    :s(lp)
  109.         node = ident(line)      :s(lp)
  110.  
  111.         line wsp '--  plus fields for binary operator'    :s(cb)
  112.         line wsp '--  plus fields for unary operator'     :s(cu)
  113.         line wsp '--  plus fields for expression'         :s(ce)
  114.  
  115.         line wsp '--  ' break(' ') $ synonym ' (' break(')') $ field
  116. .                                       :f(lp)
  117.         synonym 'plus' :s(lp)
  118.         field breakx('-') $ field
  119.         differ(special<synonym>)                       :s(lp)
  120.         fields<synonym> = ident(fields<synonym>) field :s(n1)
  121.         terminal = differ(field, fields<synonym>)
  122. .       'Inconsistent field reference at line ' lineno ' for ' synonym :s(end)
  123.  
  124. n1      refs<synonym> = node ',' refs<synonym>
  125.         field breakx(digit) span(digit) $ whichfield
  126.         field 'Flag'                    :f(n1a)
  127.         whichfield = substr(&alphabet,whichfield + 65,1)
  128.  
  129. n1a     fieldsused break(whichfield)            :f(n1c)
  130.         terminal = 'Overlapping field at line ' lineno ' for ' synonym :s(end)
  131. n1c     fieldsused = fieldsused whichfield      :(lp)
  132.  
  133. cb      fieldsused b_fields                     :f(lp)s(bad)
  134. cu      fieldsused u_fields                     :f(lp)s(bad)
  135. ce      fieldsused e_fields                     :f(lp)s(bad)
  136. bad     terminal = 'fields conflict with standard fields for node ' node :(lp)
  137.  
  138. * Loop through field function definitions to make sure they are OK
  139.  
  140. nxt1    terminal = '     OK'
  141.         terminal =
  142.         terminal = 'Check for function consistency'
  143.  
  144.         fields1 = copy(fields)
  145.  
  146. lp2     line = trim(in)         :f(err)
  147.         lineno = lineno + 1
  148.  
  149.         line '   -- Node Update' :s(nxt2)
  150.  
  151.         line wsp 'function ' rem $ synonym        :f(lp2)
  152.         differ(special<synonym>)                  :s(lp2)
  153.  
  154.         terminal = ident(fields1<synonym>) 'function on line ' lineno
  155. .       ' is for unused synonym' :s(end)
  156.  
  157.         line = trim(in)         :f(err)
  158.         lineno = lineno + 1
  159.  
  160.         line breakx('-') '-- ' rem $ field    :f(err)
  161.  
  162.         fields1<synonym> = ident(field,fields1<synonym>) :s(lp2)
  163.  
  164.         terminal = 'Wrong field in function ' synonym :(end)
  165.  
  166. * Check no field function definitions were omitted
  167.  
  168. nxt2    terminal = '     OK'
  169.         terminal =
  170.         terminal = 'Check for missing functions'
  171.  
  172.         list = convert(fields1,'ARRAY')
  173.         ident(list)  :s(nxt3)
  174.         terminal = 'No function for field synonym ' list<1,1> :s(end)
  175.  
  176. * Check field set procedures
  177.  
  178. nxt3    terminal = '     OK'
  179.         terminal =
  180.         terminal = 'Check for set procedure consistency'
  181.         fields1 = copy(fields)
  182.  
  183. lp3     line = trim(in)         :f(err)
  184.         lineno = lineno + 1
  185.  
  186.         line '   -- Inline Pragmas' :s(nxt3a)
  187.  
  188.         line wsp 'procedure Set_' rem $ synonym :f(lp3)
  189.         differ(special<synonym>)                :s(lp3)
  190.  
  191.         terminal = ident(fields1<synonym>) 'procedure on line ' lineno
  192. .       ' is for unused synonym' :s(end)
  193.  
  194.         line = trim(in)         :f(err)
  195.         lineno = lineno + 1
  196.  
  197.         line breakx('-') '-- ' rem $ field    :f(err)
  198.  
  199.         fields1<synonym> = ident(field,fields1<synonym>) :s(lp3)
  200.  
  201.         terminal = 'Wrong field in procedure Set_' synonym :(end)
  202.  
  203. * Check no field set procedure definitions were omitted
  204.  
  205. nxt3a   terminal = '     OK'
  206.         terminal =
  207.         terminal = 'Check for missing set procedures'
  208.         list = convert(fields1,'ARRAY')
  209.         ident(list)  :s(nxt4)
  210.         terminal = 'No procedure for field synonym Set_' list<1,1> :(end)
  211.  
  212. *  Check pragma Inlines are all for existing fields
  213.  
  214. nxt4    terminal = '     OK'
  215.         terminal =
  216.         fields1 =
  217.         terminal = 'Check pragma Inlines are all for existing subprograms'
  218.         inlines = table(100)
  219.  
  220. lp4     line = trim(in)   :f(nxt5)
  221.         lineno = lineno + 1
  222.  
  223.         line wsp 'pragma Inline (' break(')') $ name :f(lp4)
  224.         differ(special<name>)                        :s(lp4)
  225.         name 'Set_' rem $ name    :s(nxt5)
  226.  
  227. lp4m    terminal = ident(fields<name>) 'Pragma Inline on line ' lineno
  228. .         ' does not correspond to synonym'
  229. .               :s(end)
  230.         inlines<name> = inlines<name> 'r' :(lp4)
  231.  
  232. * Check no pragma Inlines were omitted
  233.  
  234. nxt5    terminal = '     OK'
  235.         terminal =
  236.         terminal = 'Check no pragma Inlines were omitted'
  237.  
  238.         list = convert(fields,'ARRAY')
  239.         m = 0
  240.  
  241. nxt5l   m = m + 1
  242.         nxt = list<m,1>         :f(nxt7)
  243.  
  244.         ident(inlines<nxt>,'r') :s(nxt5l)
  245. nxt6e   terminal = 'Incorrect pragma Inlines for ' nxt :(end)
  246.  
  247. nxt7    terminal = '     OK'
  248.         terminal =
  249.         inlines =
  250.  
  251. * Check consistency of functions in the body
  252.  
  253.         endfile(1)
  254.         input(.in,1,'sinfo.adb')
  255.         lineno = 0
  256.         terminal = 'Check references in functions in body'
  257.         refscopy = copy(refs)
  258.  
  259. lp7     line = trim(in)         :f(err)
  260.         lineno = lineno + 1
  261.         line '   -- Field Access Functions --' :f(lp7)
  262.  
  263. lp8     line = trim(in)         :f(err)
  264.         lineno = lineno + 1
  265.  
  266.         line '   -- Field Set Procedures --' :s(nxt9)
  267.  
  268.         line '   function ' rem $ synonym  :f(lp8)
  269.         differ(special<synonym>)           :s(lp8)
  270.  
  271.         ref = refs<synonym>
  272.         refs<synonym> =
  273.         terminal = ident(ref) 'Function on line ' lineno
  274. .               ' is for unknown synonym' :s(end)
  275.  
  276. * alpha sort of references for this entry
  277.  
  278.         refa = array(100)
  279.         n = 0
  280. sort1   ref break(',') $ nxtref ',' =   :f(sort2)
  281.         refa<n = n + 1> = nxtref  :(sort1)
  282.  
  283.  
  284. sort2   m = 1
  285.  
  286. sort3   ge(m,n)         :s(sort4)
  287.         m = llt(refa<m>, refa<m + 1>) m + 1 :s(sort3)
  288.         temp = refa<m>
  289.         refa<m> = refa<m + 1>
  290.         refa<m + 1> = temp      :(sort2)
  291.  
  292. sort4   line = trim(in)         :f(err)
  293.         lineno = lineno + 1
  294.         line = trim(in)         :f(err)
  295.         lineno = lineno + 1
  296.         line = trim(in)         :f(err)
  297.         lineno = lineno + 1
  298.  
  299.         m = 0
  300.  
  301. * checking references for one entry
  302.  
  303. checkr  line = trim(in)         :f(err)
  304.         lineno = lineno + 1
  305.         m = m + 1
  306.         line break('=') '= N_' (break(' ,)') | rem)  $ next :f(checke)
  307.         next breakx(',') $ next
  308.         differ(next,refa<m>) :s(checke)
  309.         lt(m,n) :s(checkr)f(checkf1)
  310.  
  311. checke  terminal = 'Expecting N_' refa<m> ' at line ' lineno    :(end)
  312.  
  313. checkf1 line = trim(in) :f(err)
  314.         lineno = lineno + 1
  315.  
  316.         line wsp 'return ' break(' ') $ field
  317.         ident(field, fields<synonym>) :s(lp8)
  318.         terminal = 'Wrong field for function ' synonym ' at line ' lineno
  319. .               ' should be ' fields<synonym>   :(end)
  320.  
  321. * check missing functions in body
  322.  
  323. nxt9    terminal = '     OK'
  324.         terminal =
  325.         terminal = 'Check for missing functions in body'
  326.  
  327.         list = convert(refs,'ARRAY')      :f(nxt10)
  328.  
  329.         ident(list)   :s(nxt10)
  330.  
  331.         terminal = 'Missing function ' list<1,1> ' in body' :(end)
  332.  
  333. * check consistency of Set procedures in body
  334.  
  335. nxt10   terminal = '     OK'
  336.         terminal =
  337.         terminal = 'Check Set procedures in body'
  338.         fields1 = copy(fields)
  339.         refs = refscopy
  340.  
  341. lp10    line = trim(in)         :f(err)
  342.         lineno = lineno + 1
  343.  
  344.         line 'end'                      :s(nxt12)
  345.  
  346.         line '   procedure Set_' rem $ synonym :f(lp10)
  347.         differ(special<synonym>)               :s(lp10)
  348.  
  349.         ref = refs<synonym>
  350.         refs<synonym> =
  351.  
  352.         terminal = ident(fields1<synonym>) 'Procedure on line ' lineno
  353. .               ' is for unknown synonym' :s(end)
  354. * alpha sort of references for this entry
  355.  
  356.         refa = array(100)
  357.         n = 0
  358. sortx1  ref break(',') $ nxtref ',' =   :f(sortx2)
  359.         refa<n = n + 1> = nxtref  :(sortx1)
  360.  
  361.  
  362. sortx2  m = 1
  363.  
  364. sortx3  ge(m,n)         :s(sortx4)
  365.         m = llt(refa<m>, refa<m + 1>) m + 1 :s(sortx3)
  366.         temp = refa<m>
  367.         refa<m> = refa<m + 1>
  368.         refa<m + 1> = temp      :(sortx2)
  369.  
  370. sortx4  line = trim(in)         :f(err)
  371.         lineno = lineno + 1
  372.         line = trim(in)         :f(err)
  373.         lineno = lineno + 1
  374.         line = trim(in)         :f(err)
  375.         lineno = lineno + 1
  376.  
  377.         m = 0
  378.  
  379. * checking references for one entry
  380.  
  381. checkxr line = trim(in)         :f(err)
  382.         lineno = lineno + 1
  383.         m = m + 1
  384.         line break('=') '= N_' (break(' ,)') | rem) $ next :f(checke)
  385.         differ(next,refa<m>) :s(checke)
  386.         lt(m,n) :s(checkxr)f(checkf2)
  387.  
  388. checkxe terminal = 'Expecting N_' refa<m> ' at line ' lineno    :(end)
  389.  
  390. checkf2 line = trim(in) :f(err)
  391.         lineno = lineno + 1
  392.  
  393.         line wsp 'Set_' break(' ') $ field ' (N, Val)' :f(checkf2)
  394.         field break('_') . field '_With_Parent'
  395.  
  396.         ident(field, fields<synonym>) :s(mxt11)
  397.         terminal = 'Wrong field for procedure Set_' synonym ' at line ' lineno
  398. .               ' should be ' fields<synonym>   :(end)
  399.  
  400. mxt11   fields1<synonym> =      :(lp10)
  401.  
  402. * check missing procedures in body
  403.  
  404. nxt12   terminal = '     OK'
  405.         terminal =
  406.         terminal = 'Check for missing set procedures in body'
  407.  
  408.         list = convert(fields1,'ARRAY')   :f(nxt13)
  409.  
  410.         ident(list)   :s(nxt13)
  411.  
  412.         terminal = 'Missing procedure Set_' list<1,1> ' in body' :(end)
  413.  
  414. nxt13   terminal = '     OK'
  415.         terminal =
  416.         terminal = 'All tests completed successfully, no errors detected'
  417. end
  418.