--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/xnmake.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,467 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                          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;