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 / xnmake.spt < prev    next >
Text File  |  1996-09-28  |  10KB  |  257 lines
  1. *-----------------------------------------------------------------------------
  2. *-                                                                          --
  3. *-                                 G N A T                                  --
  4. *-                                                                          --
  5. *-                            COMPILER UTILITIES                            --
  6. *-                                                                          --
  7. *-                               X N M A K E                                --
  8. *-                                                                          --
  9. *-                            $Revision: 1.20 $                             --
  10. *-                                                                          --
  11. *-        Copyright (c) 1992,1993,1994,1995 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 the spec and body of the Nmake package
  26. *
  27. *   Input files:
  28. *
  29. *      sinfo.ads     Spec of Sinfo package
  30. *      nmake.adt     Template for Nmake package
  31. *
  32. *   Output files:
  33. *
  34. *      nmake.ads     Spec of Nmake package
  35. *      nmake.adb     Body of Nmake package
  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. *  In the absence of any switches, both the ads and adb files are constructed.
  41. *  The switch -s or /s indicates that only the ads file is to be constructed.
  42. *  The switch -b or /b indicates that only the adb file is to be constructed.
  43. *
  44. *  If a file name argument is given, then the output is written to this file
  45. *  rather than to nmake.ads or nmake.adb. A file name can only be given if
  46. *  exactly one of the -s or -b options is present.
  47.  
  48.         "$Revision: 1.20 $" "$Rev" "ision: " break(' ') $ xnmakerev
  49.  
  50.         terminal =
  51.         lineno = 0
  52.         &stlimit = -1
  53.         nwidth = 28
  54.         &anchor = 1
  55.  
  56.         files = 'nmake.ads'
  57.         fileb = 'nmake.adb'
  58.  
  59.         args = trim(host(1))
  60.         args = ident(args, "0") trim(host(0))
  61.  
  62.         args breakx('-/') $ a len(1) any('bB') (span(' ') | '') = a :f(o1)
  63.         files =
  64.  
  65. o1      args breakx('-/') $ a len(1) any('sS') (span(' ') | '') = a :f(o2)
  66.         fileb =
  67.  
  68. o2      args span(' ') =
  69.         args break(' ') $ a span(' ') rpos(0) = a
  70.         args break(' ')                                       :f(o3)
  71.  
  72. bado    terminal = "invalid arguments"                        :(end)
  73.  
  74. o3      ident(args)                                           :s(o4)
  75.         ident(files)    :s(o5)
  76.         ident(fileb)    :s(o6)
  77.         terminal = "if file name given, must use -b or -s"    :(end)
  78.  
  79. o5      fileb = args                                          :(o4)
  80. o6      files = args                                          :(o4)
  81. o4
  82.         input(.ins,1,'sinfo.ads')
  83.         input(.int,2,'nmake.adt')
  84.  
  85.         (differ(files) output(.outs,3,files))
  86.         (differ(fileb) output(.outb,4,fileb))
  87.  
  88.         &anchor = 1
  89.         wsp = span(' ' char(9))
  90.         digits = '0123456789'
  91.         digit = any(digits)
  92.  
  93. * Get sinfo rev
  94.  
  95. slp     line = ins
  96.         line breakx('$') '$Rev' 'ision: ' break(' ') $ sinforev :f(slp)
  97.  
  98.  
  99. * Copy initial part of template to spec and body
  100.  
  101. lp1     line = int                              :f(err)
  102.  
  103.         line breakx('$') '$Rev' 'ision: ' break(' ') $ temprev :f(lp1a)
  104.  
  105.         outb = outs =
  106. .        '--                 Generated by xnmake revision '
  107. .        xnmakerev ' using'
  108. .        '                   --'
  109.  
  110.         outb = outs =
  111. .        '--                         sinfo.ads revision ' sinforev
  112. .        '                          --'
  113.  
  114.         outb = outs =
  115. .        '--                         nmake.adt revision ' temprev
  116. .        '                          --'    :(lp1)
  117.  
  118. * Skip lines describing the template
  119.  
  120. lp1a    line '--  This file is a template'      :f(lp1c)
  121. lp1b    line = trim(int)                        :f(err)
  122.         differ(line)                            :s(lp1b)
  123.  
  124. lp1c    line 'package'                          :s(p1)
  125.         line breakx(' ') $ x span(' ') '--  body only' = x :s(lpbb)
  126.         line breakx(' ') $ x span(' ') '--  spec only' = x :s(lpss)
  127.         line breakx('T') $ a 'T e m p l a t e' =
  128. .            a '    S p e c    '
  129.         outs = line
  130.         line breakx('S') $ a 'S p e c' = a 'B o d y'
  131.         outb = line                             :(lp1)
  132.  
  133. lpbb    outb = line                             :(lp1)
  134. lpss    outs = line                             :(lp1)
  135.  
  136. * Package line reached
  137.  
  138. p1      outs = 'package Nmake is'
  139.         outb = 'package body Nmake is'
  140.         outb =
  141.  
  142. * Copy rest of lines up to template insert point to spec only
  143.  
  144. lp2     line = int                              :f(err)
  145.         line '!!TEMPLATE INSERTION POINT'       :s(lp3)
  146.         outs = line                             :(lp2)
  147.  
  148. * Here we are doing the actual insertions
  149.  
  150. lp3     line = trim(ins)                        :f(err)
  151.         line wsp '--  N_' rem $ node            :f(lp3)
  152.         node breakx(' .,')                      :s(lp3)
  153.         ident(node,'Unused')                    :s(lp3)
  154.         ident(node,'Empty')                     :s(done)
  155.  
  156.         prevl = '   function Make_' node ' (Sloc : Source_Ptr'
  157.         arg_list =
  158.  
  159. lp4     line = trim(ins)                        :f(err)
  160.         ident(line)                             :s(ef)
  161.  
  162.         line wsp '--  plus fields for binary operator'    :s(cb)
  163.         line wsp '--  plus fields for unary operator'     :s(cu)
  164.  
  165.         line wsp '--  ' break(' ') $ synonym ' (' break(')') $ field
  166. .                 rem $ comment                 :f(lp4)
  167.  
  168.         ident(synonym, "Prev_Ids")              :s(lp4)
  169.         ident(synonym, "More_Ids")              :s(lp4)
  170.         ident(synonym, "Comes_From_Source")     :s(lp4)
  171.         ident(synonym, "Paren_Count")           :s(lp4)
  172.         field breakx('-') '-Sem'                :s(lp4)
  173.         field breakx('-') '-Lib'                :s(lp4)
  174.  
  175.         type =
  176.  
  177.         field breakx(digits) $ field
  178.  
  179.         field = ident(field, 'Str')      'String_Id'
  180.         field = ident(field, 'Node')     'Node_Id'
  181.         field = ident(field, 'Name')     'Name_Id'
  182.         field = ident(field, 'List')     'List_Id'
  183.         field = ident(field, 'Elist')    'Elist_Id'
  184.         field = ident(field, 'Flag')     'Boolean'
  185.  
  186.         default =
  187.         default = ident(field, 'Boolean') 'False'
  188.         comment breakx('(') '(set to ' break(' ') $ default ' if'
  189.  
  190.         outb = outs = prevl ';'
  191.  
  192.         arg_list = arg_list synonym ','
  193.         synonym = rpad(synonym,nwidth)
  194.  
  195.         prevl = ident(default) "      " synonym ' : ' field  :s(lp4)
  196.         prevl = "      " synonym ' : ' field ' := ' default :(lp4)
  197.  
  198. cu      outb = outs = prevl ';'
  199.         arg_list = arg_list 'Right_Opnd,'
  200.         prevl =       "      " rpad('Right_Opnd',nwidth) ' : Node_Id' :(lp4)
  201.  
  202. cb      outb = outs = prevl ';'
  203.         arg_list = arg_list 'Left_Opnd,Right_Opnd,'
  204.         outb = outs = "      " rpad('Left_Opnd',nwidth) ' : Node_Id;'
  205.         prevl =       "      " rpad('Right_Opnd',nwidth) ' : Node_Id' :(lp4)
  206.  
  207. ef      outb = outs = prevl ')'
  208.         outs = '      return Node_Id;'
  209.         outs = '   pragma Inline (Make_' node ');'
  210.         outb = '      return Node_Id'
  211.         outb = '   is'
  212.         outb =
  213. .       '      N : constant Node_Id :='
  214.  
  215.         node 'Defining_Identifier'   :s(extend)
  216.         node 'Defining_Character'    :s(extend)
  217.         node 'Defining_Operator'     :s(extend)
  218.         outb =
  219. .       '            New_Node (N_' node ', Sloc);' :(merge)
  220.  
  221. extend  outb =
  222. .       '            New_Entity (N_' node ', Sloc);'
  223.  
  224. merge   outb = '   begin'
  225.  
  226. efl     arg_list  break(',') $ arg ',' =                :f(efe)
  227.         outb = lt(size(arg),28) '      Set_' arg ' (N, ' arg ');'    :s(efl)
  228.         outb = '      Set_' arg
  229.         outb = '        (N, ' arg ');'    :(efl)
  230.  
  231. efe     node 'Op_' rem $ Op_Name        :f(efx)
  232.  
  233.         outb = ident(node,'Op_Plus')
  234. .              '      Set_Chars (N, Name_Op_Add);'       :s(eff1)
  235.  
  236.         outb = ident(node,'Op_Minus')
  237. .              '      Set_Chars (N, Name_Op_Subtract);'  :s(eff1)
  238.  
  239.         Op_Name ('Shift_' | 'Rotate_')                   :f(eff)
  240.  
  241.         outb = '      Set_Chars (N, Name_' Op_Name ');'  :(eff2)
  242.  
  243. eff     outb = '      Set_Chars (N, Name_' node ');'
  244.  
  245. eff1    Op_Name ('Or_Else' | 'And_Then' | 'In' | 'Not_In')  :s(efx)
  246. eff2    outb = '      Set_Entity (N, Standard_' node ');'
  247.  
  248. efx     outb = Ident(node, "Expression_Actions")
  249. .              '      Set_Cannot_Be_Constant (N);'
  250.         outb = '      return N;'
  251.         outb = '   end Make_' node ';'
  252.         outs =
  253.         outb =                                  :(lp3)
  254.  
  255. done    outs = outb = 'end Nmake;'
  256. end
  257.