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 / xsinfo.spt < prev    next >
Text File  |  1996-09-28  |  6KB  |  152 lines
  1. *-----------------------------------------------------------------------------
  2. *-                                                                          --
  3. *-                                 G N A T                                  --
  4. *-                                                                          --
  5. *-                            COMPILER UTILITIES                            --
  6. *-                                                                          --
  7. *-                               X S I N F O                                --
  8. *-                                                                          --
  9. *-                            $Revision: 1.13 $                             --
  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 construct C header file a-sinfo.h (C version of sinfo.ads spec,
  26. * for use by Gigi, contains all definitions and access functions, but does not
  27. * contain set procedures, since Gigi is not allowed to modify the GNAT tree)
  28. *
  29. *   Input files:
  30. *
  31. *      sinfo.ads     Spec of Sinfo package
  32. *
  33. *   Output files:
  34. *
  35. *      a-sinfo.h     Corresponding c header file
  36. *
  37. * Note: this program assumes that sinfo.ads has passed the error checks which
  38. * are carried out by the csinfo utility, so it does not duplicate these checks
  39. *
  40. * An optional argument allows the specification of an output file name to
  41. * override the default a-sinfo.h file name for the generated output file.
  42.  
  43.         "$Revision: 1.13 $" "$Rev" "ision: " break(' ') $ xsinforev
  44.  
  45.         arg = trim(host(1))
  46.         arg = ident(arg, "0") trim(host(0))
  47.         ofile = ident(arg) 'a-sinfo.h'
  48.         ofile = differ(arg) arg
  49.  
  50.         lineno = 0
  51.         &stlimit = -1
  52.         input(.in,1,'sinfo.ads')
  53.         output(.out,2,ofile)
  54.         &anchor = 1
  55.         wsp = span(' ' char(9)) | ''
  56.  
  57. * Get sinfo rev and write header to output file
  58.  
  59. slp     line = in
  60.         ident(line)    :s(start)
  61.         line breakx('$') '$Rev' 'ision: ' break(' ') $ sinforev :s(vsn)
  62.         line '--                                 S p e c       ' =
  63. .            '--                              C Header File    '
  64.  
  65.         line '--' = '/*'
  66.         line rtab(2) $ a '--' = a '*/'
  67.         out = line                :(slp)
  68. vsn     out = '/*                 Generated by xsinfo revision ' xsinforev
  69. .             ' using                  */'
  70.         out = '/*                         sinfo.ads revision ' sinforev
  71. .             '                         */'          :(slp)
  72.  
  73. start
  74.  
  75. *  Get non-comment non-blank line
  76.  
  77.         define('getline()a,b')                  :(n1)
  78. getline getline = trim(in)                      :f(err)
  79.         ident(getline)                          :s(getline)
  80.         lineno = lineno + 1
  81.         getline wsp $ a '--' =                  :f(return)
  82.         getline span(' ') 'End functions (note' :s(freturn)f(getline)
  83.  
  84. n1      line = getline()                        :f(err)
  85.         line 'with'                            :s(n2)
  86.         out = line                              :(n1)
  87.  
  88. n2      line = getline()                        :f(err)
  89.         line "package"                          :f(n2)
  90.  
  91. n3      line = getline()                        :f(err)
  92.         line wsp $ a "type Node_Kind is"        :s(n4)
  93.         out = line                              :(n3)
  94.  
  95. n4      out =
  96.         NKV = 0
  97.  
  98. n5      line = getline()                        :f(err)
  99.         line wsp $ a 'N_' break(',)') $ name
  100. .               len(1) $ term                   :s(n6)
  101.         out = line                              :(n5)
  102.  
  103. n6      out = a '#define N_' name ' ' NKV
  104.         NKV = NKV + 1
  105.         ident(term,',')                         :s(n5)
  106.  
  107.         out =
  108.         out = a '#define Number_Node_Kinds ' NKV
  109.  
  110. n7      line = getline()                        :f(err)
  111.         line wsp $ a 'subtype ' break(' ') $ N  :s(n8)
  112.         line wsp $ a 'function'                 :s(n10)
  113.         out = line                              :(n7)
  114.  
  115. n8      out = a 'SUBTYPE (' N ', Node_Kind, '
  116.         line = getline()
  117.  
  118. * normal case
  119.  
  120.         line wsp break(' ') $ N1
  121. .               ' .. ' break(';') $ N2          :f(n8a)
  122.         out = a '   ' N1 ', ' N2 ')'            :(n7)
  123.  
  124. * continuation case
  125.  
  126. n8a     line wsp break(' ') $ N1 " .." rpos(0)  :f(err)
  127.         getline() span(' ') break(";") $ N2     :f(err)
  128.         out = a '   ' N1 ','
  129.         out = a '   ' N2 ')'                    :(n7)
  130.  
  131.  
  132. n9      line = getline()                        :f(n13)
  133. n10     line wsp $ a 'function ' rem $ Name     :s(n11)
  134.         out = line                              :(n9)
  135.  
  136. n11     line = getline()
  137.         line
  138. .          wsp '(N : '
  139. .          break(')') $ arg
  140. .          ') return ' break(';') $ rtn
  141. .          ';' wsp '--' wsp rem $ comment       :f(err)
  142.  
  143.         out = a 'INLINE ' rpad(rtn,9)
  144. .             ' ' rpad(Name,30)
  145. .             ' (' arg ' N)'
  146.  
  147.         out = a '   '
  148. .             '{ return ' comment ' (N); }'     :(n9)
  149.  
  150. n13     out =
  151. end
  152.