Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                          GNAT SYSTEM UTILITIES                           --
--                                                                          --
--                               X N M A K E                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------
 
--  Program to construct the spec and body of the Nmake package
 
--    Input files:
 
--       sinfo.ads     Spec of Sinfo package
--       nmake.adt     Template for Nmake package
 
--    Output files:
 
--       nmake.ads     Spec of Nmake package
--       nmake.adb     Body of Nmake package
 
--  Note: this program assumes that sinfo.ads has passed the error checks that
--  are carried out by the csinfo utility, so it does not duplicate these
--  checks and assumes that sinfo.ads has the correct form.
 
--   In the absence of any switches, both the ads and adb files are output.
--   The switch -s or /s indicates that only the ads file is to be output.
--   The switch -b or /b indicates that only the adb file is to be output.
 
--   If a file name argument is given, then the output is written to this file
--   rather than to nmake.ads or nmake.adb. A file name can only be given if
--   exactly one of the -s or -b options is present.
 
with Ada.Command_Line;              use Ada.Command_Line;
with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Strings.Maps;              use Ada.Strings.Maps;
with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
with Ada.Streams.Stream_IO;         use Ada.Streams.Stream_IO;
with Ada.Text_IO;                   use Ada.Text_IO;
 
with GNAT.Spitbol;                  use GNAT.Spitbol;
with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
 
with XUtil;
 
procedure XNmake is
 
   Err : exception;
   --  Raised to terminate execution
 
   A        : VString := Nul;
   Arg      : VString := Nul;
   Arg_List : VString := Nul;
   Comment  : VString := Nul;
   Default  : VString := Nul;
   Field    : VString := Nul;
   Line     : VString := Nul;
   Node     : VString := Nul;
   Op_Name  : VString := Nul;
   Prevl    : VString := Nul;
   Synonym  : VString := Nul;
   X        : VString := Nul;
 
   NWidth : Natural;
 
   FileS : VString := V ("nmake.ads");
   FileB : VString := V ("nmake.adb");
   --  Set to null if corresponding file not to be generated
 
   Given_File : VString := Nul;
   --  File name given by command line argument
 
   subtype Sfile is Ada.Streams.Stream_IO.File_Type;
 
   InS,  InT  : Ada.Text_IO.File_Type;
   OutS, OutB : Sfile;
 
   wsp : constant Pattern := Span (' ' & ASCII.HT);
 
   Body_Only : constant Pattern := BreakX (' ') * X
                                   & Span (' ') & "--  body only";
   Spec_Only : constant Pattern := BreakX (' ') * X
                                   & Span (' ') & "--  spec only";
 
   Node_Hdr  : constant Pattern := wsp & "--  N_" & Rest * Node;
   Punc      : constant Pattern := BreakX (" .,");
 
   Binop     : constant Pattern := wsp
                                   & "--  plus fields for binary operator";
   Unop      : constant Pattern := wsp
                                   & "--  plus fields for unary operator";
   Syn       : constant Pattern := wsp & "--  " & Break (' ') * Synonym
                                   & " (" & Break (')') * Field
                                   & Rest * Comment;
 
   Templ     : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
   Spec      : constant Pattern := BreakX ('S') * A & "S p e c";
 
   Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
   Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
 
   Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
 
   Get_Dflt  : constant Pattern := BreakX ('(') & "(set to "
                                   & Break (" ") * Default & " if";
 
   Next_Arg  : constant Pattern := Break (',') * Arg & ',';
 
   Op_Node   : constant Pattern := "Op_" & Rest * Op_Name;
 
   Shft_Rot  : constant Pattern := "Shift_" or "Rotate_";
 
   No_Ent    : constant Pattern := "Or_Else" or "And_Then"
                                     or "In" or "Not_In";
 
   M : Match_Result;
 
   V_String_Id : constant VString := V ("String_Id");
   V_Node_Id   : constant VString := V ("Node_Id");
   V_Name_Id   : constant VString := V ("Name_Id");
   V_List_Id   : constant VString := V ("List_Id");
   V_Elist_Id  : constant VString := V ("Elist_Id");
   V_Boolean   : constant VString := V ("Boolean");
 
   procedure Put_Line (F : Sfile; S : String)  renames XUtil.Put_Line;
   procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line;
   --  Local version of Put_Line ensures Unix style line endings
 
   procedure WriteS  (S : String);
   procedure WriteB  (S : String);
   procedure WriteBS (S : String);
   procedure WriteS  (S : VString);
   procedure WriteB  (S : VString);
   procedure WriteBS (S : VString);
   --  Write given line to spec or body file or both if active
 
   procedure WriteB (S : String) is
   begin
      if FileB /= Nul then
         Put_Line (OutB, S);
      end if;
   end WriteB;
 
   procedure WriteB (S : VString) is
   begin
      if FileB /= Nul then
         Put_Line (OutB, S);
      end if;
   end WriteB;
 
   procedure WriteBS (S : String) is
   begin
      if FileB /= Nul then
         Put_Line (OutB, S);
      end if;
 
      if FileS /= Nul then
         Put_Line (OutS, S);
      end if;
   end WriteBS;
 
   procedure WriteBS (S : VString) is
   begin
      if FileB /= Nul then
         Put_Line (OutB, S);
      end if;
 
      if FileS /= Nul then
         Put_Line (OutS, S);
      end if;
   end WriteBS;
 
   procedure WriteS (S : String) is
   begin
      if FileS /= Nul then
         Put_Line (OutS, S);
      end if;
   end WriteS;
 
   procedure WriteS (S : VString) is
   begin
      if FileS /= Nul then
         Put_Line (OutS, S);
      end if;
   end WriteS;
 
--  Start of processing for XNmake
 
begin
   NWidth := 28;
   Anchored_Mode := True;
 
   for ArgN in 1 .. Argument_Count loop
      declare
         Arg : constant String := Argument (ArgN);
 
      begin
         if Arg (1) = '-' then
            if Arg'Length = 2
              and then (Arg (2) = 'b' or else Arg (2) = 'B')
            then
               FileS := Nul;
 
            elsif Arg'Length = 2
              and then (Arg (2) = 's' or else Arg (2) = 'S')
            then
               FileB := Nul;
 
            else
               raise Err;
            end if;
 
         else
            if Given_File /= Nul then
               raise Err;
            else
               Given_File := V (Arg);
            end if;
         end if;
      end;
   end loop;
 
   if FileS = Nul and then FileB = Nul then
      raise Err;
 
   elsif Given_File /= Nul then
      if FileB = Nul then
         FileS := Given_File;
 
      elsif FileS = Nul then
         FileB := Given_File;
 
      else
         raise Err;
      end if;
   end if;
 
   Open (InS, In_File, "sinfo.ads");
   Open (InT, In_File, "nmake.adt");
 
   if FileS /= Nul then
      Create (OutS, Out_File, S (FileS));
   end if;
 
   if FileB /= Nul then
      Create (OutB, Out_File, S (FileB));
   end if;
 
   Anchored_Mode := True;
 
   --  Copy initial part of template to spec and body
 
   loop
      Line := Get_Line (InT);
 
      --  Skip lines describing the template
 
      if Match (Line, "--  This file is a template") then
         loop
            Line := Get_Line (InT);
            exit when Line = "";
         end loop;
      end if;
 
      --  Loop keeps going until "package" keyword written
 
      exit when Match (Line, "package");
 
      --  Deal with WITH lines, writing to body or spec as appropriate
 
      if Match (Line, Body_Only, M) then
         Replace (M, X);
         WriteB (Line);
 
      elsif Match (Line, Spec_Only, M) then
         Replace (M, X);
         WriteS (Line);
 
      --  Change header from Template to Spec and write to spec file
 
      else
         if Match (Line, Templ, M) then
            Replace (M, A &  "    S p e c    ");
         end if;
 
         WriteS (Line);
 
         --  Write header line to body file
 
         if Match (Line, Spec, M) then
            Replace (M, A &  "B o d y");
         end if;
 
         WriteB (Line);
      end if;
   end loop;
 
   --  Package line reached
 
   WriteS ("package Nmake is");
   WriteB ("package body Nmake is");
   WriteB ("");
 
   --  Copy rest of lines up to template insert point to spec only
 
   loop
      Line := Get_Line (InT);
      exit when Match (Line, "!!TEMPLATE INSERTION POINT");
      WriteS (Line);
   end loop;
 
   --  Here we are doing the actual insertions, loop through node types
 
   loop
      Line := Get_Line (InS);
 
      if Match (Line, Node_Hdr)
        and then not Match (Node, Punc)
        and then Node /= "Unused"
      then
         exit when Node = "Empty";
         Prevl := "   function Make_" & Node & " (Sloc : Source_Ptr";
         Arg_List := Nul;
 
         --  Loop through fields of one node
 
         loop
            Line := Get_Line (InS);
            exit when Line = "";
 
            if Match (Line, Binop) then
               WriteBS (Prevl & ';');
               Append (Arg_List, "Left_Opnd,Right_Opnd,");
               WriteBS (
                 "      " & Rpad ("Left_Opnd",  NWidth) & " : Node_Id;");
               Prevl :=
                 "      " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
 
            elsif Match (Line, Unop) then
               WriteBS (Prevl & ';');
               Append (Arg_List, "Right_Opnd,");
               Prevl := "      " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
 
            elsif Match (Line, Syn) then
               if         Synonym /= "Prev_Ids"
                 and then Synonym /= "More_Ids"
                 and then Synonym /= "Comes_From_Source"
                 and then Synonym /= "Paren_Count"
                 and then not Match (Field, Sem_Field)
                 and then not Match (Field, Lib_Field)
               then
                  Match (Field, Get_Field);
 
                  if    Field = "Str"   then
                     Field := V_String_Id;
                  elsif Field = "Node"  then
                     Field := V_Node_Id;
                  elsif Field = "Name"  then
                     Field := V_Name_Id;
                  elsif Field = "List"  then
                     Field := V_List_Id;
                  elsif Field = "Elist" then
                     Field := V_Elist_Id;
                  elsif Field = "Flag"  then
                     Field := V_Boolean;
                  end if;
 
                  if Field = "Boolean" then
                     Default := V ("False");
                  else
                     Default := Nul;
                  end if;
 
                  Match (Comment, Get_Dflt);
 
                  WriteBS (Prevl & ';');
                  Append (Arg_List, Synonym & ',');
                  Rpad (Synonym, NWidth);
 
                  if Default = "" then
                     Prevl := "      " & Synonym & " : " & Field;
                  else
                     Prevl :=
                       "      " & Synonym & " : " & Field & " := " & Default;
                  end if;
               end if;
            end if;
         end loop;
 
         WriteBS (Prevl & ')');
         WriteS ("      return Node_Id;");
         WriteS ("   pragma Inline (Make_" & Node & ");");
         WriteB ("      return Node_Id");
         WriteB ("   is");
         WriteB ("      N : constant Node_Id :=");
 
         if Match (Node, "Defining_Identifier") or else
            Match (Node, "Defining_Character")  or else
            Match (Node, "Defining_Operator")
         then
            WriteB ("            New_Entity (N_" & Node & ", Sloc);");
         else
            WriteB ("            New_Node (N_" & Node & ", Sloc);");
         end if;
 
         WriteB ("   begin");
 
         while Match (Arg_List, Next_Arg, "") loop
            if Length (Arg) < NWidth then
               WriteB ("      Set_" & Arg & " (N, " & Arg & ");");
            else
               WriteB ("      Set_" & Arg);
               WriteB ("        (N, " & Arg & ");");
            end if;
         end loop;
 
         if Match (Node, Op_Node) then
            if Node = "Op_Plus" then
               WriteB ("      Set_Chars (N, Name_Op_Add);");
 
            elsif Node = "Op_Minus" then
               WriteB ("      Set_Chars (N, Name_Op_Subtract);");
 
            elsif Match (Op_Name, Shft_Rot) then
               WriteB ("      Set_Chars (N, Name_" & Op_Name & ");");
 
            else
               WriteB ("      Set_Chars (N, Name_" & Node & ");");
            end if;
 
            if not Match (Op_Name, No_Ent) then
               WriteB ("      Set_Entity (N, Standard_" & Node & ");");
            end if;
         end if;
 
         WriteB ("      return N;");
         WriteB ("   end Make_" & Node & ';');
         WriteBS ("");
      end if;
   end loop;
 
   WriteBS ("end Nmake;");
 
exception
 
   when Err =>
      Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]");
      Set_Exit_Status (1);
 
end XNmake;