--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/xsinfo.adb	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,262 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                          GNAT SYSTEM UTILITIES                           --
+--                                                                          --
+--                               X S I N F O                                --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2011, 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 C header file sinfo.h (C version of sinfo.ads spec,
+--  for use by Gigi, contains all definitions and access functions, but does
+--  not contain set procedures, since Gigi never modifies the GNAT tree)
+
+--    Input files:
+
+--       sinfo.ads     Spec of Sinfo package
+
+--    Output files:
+
+--       sinfo.h       Corresponding c header file
+
+--  An optional argument allows the specification of an output file name to
+--  override the default sinfo.h file name for the generated output file.
+
+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.Text_IO;                   use Ada.Text_IO;
+
+with GNAT.Spitbol;                  use GNAT.Spitbol;
+with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
+
+with CSinfo;
+
+procedure XSinfo is
+
+   Done : exception;
+   Err  : exception;
+
+   A         : VString := Nul;
+   Arg       : VString := Nul;
+   Comment   : VString := Nul;
+   Line      : VString := Nul;
+   N         : VString := Nul;
+   N1, N2    : VString := Nul;
+   Nam       : VString := Nul;
+   Rtn       : VString := Nul;
+   Term      : VString := Nul;
+
+   InS   : File_Type;
+   Ofile : File_Type;
+
+   wsp     : constant Pattern := Span (' ' & ASCII.HT);
+   Wsp_For : constant Pattern := wsp & "for";
+   Is_Cmnt : constant Pattern := wsp & "--";
+   Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
+   Get_Nam : constant Pattern := wsp * A & "N_" &  Break (",)") * Nam
+                                 & Len (1) * Term;
+   Sub_Typ : constant Pattern := wsp * A & "subtype " &  Break (' ') * N;
+   No_Cont : constant Pattern := wsp & Break (' ') * N1
+                                 & " .. " & Break (';') * N2;
+   Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
+   Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
+   Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
+   Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
+                                 & ") return " & Break (';') * Rtn
+                                 & ';' & wsp & "--" & wsp & Rest * Comment;
+
+   NKV : Natural;
+
+   M : Match_Result;
+
+   procedure Getline;
+   --  Get non-comment, non-blank line. Also skips "for " rep clauses
+
+   -------------
+   -- Getline --
+   -------------
+
+   procedure Getline is
+   begin
+      loop
+         Line := Get_Line (InS);
+
+         if Line /= ""
+           and then not Match (Line, Wsp_For)
+           and then not Match (Line, Is_Cmnt)
+         then
+            return;
+
+         elsif Match (Line, "   --  End functions (note") then
+            raise Done;
+         end if;
+      end loop;
+   end Getline;
+
+--  Start of processing for XSinfo
+
+begin
+   --  First run CSinfo to check for errors. Note that CSinfo is also a
+   --  stand-alone program that can be run separately.
+
+   CSinfo;
+
+   Set_Exit_Status (1);
+   Anchored_Mode := True;
+
+   if Argument_Count > 0 then
+      Create (Ofile, Out_File, Argument (1));
+   else
+      Create (Ofile, Out_File, "sinfo.h");
+   end if;
+
+   Open (InS, In_File, "sinfo.ads");
+
+   --  Write header to output file
+
+   loop
+      Line := Get_Line (InS);
+      exit when Line = "";
+
+      Match
+        (Line,
+         "--                                 S p e c       ",
+         "--                              C Header File    ");
+
+      Match (Line, "--", "/*");
+      Match (Line, Rtab (2) * A & "--", M);
+      Replace (M, A & "*/");
+      Put_Line (Ofile, Line);
+   end loop;
+
+   --  Skip to package line
+
+   loop
+      Getline;
+      exit when Match (Line, "package");
+   end loop;
+
+   --  Skip to first node kind line
+
+   loop
+      Getline;
+      exit when Match (Line, Typ_Nod);
+      Put_Line (Ofile, Line);
+   end loop;
+
+   Put_Line (Ofile, "");
+
+   Put_Line (Ofile, "#ifdef __cplusplus");
+   Put_Line (Ofile, "extern ""C"" {");
+   Put_Line (Ofile, "#endif");
+
+   NKV := 0;
+
+   --  Loop through node kind codes
+
+   loop
+      Getline;
+
+      if Match (Line, Get_Nam) then
+         Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
+         NKV := NKV + 1;
+         exit when not Match (Term, ",");
+
+      else
+         Put_Line (Ofile, Line);
+      end if;
+   end loop;
+
+   Put_Line (Ofile, "");
+   Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
+
+   --  Loop through subtype declarations
+
+   loop
+      Getline;
+
+      if not Match (Line, Sub_Typ) then
+         exit when Match (Line, "   function");
+         Put_Line (Ofile, Line);
+
+      else
+         Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
+         Getline;
+
+         --  Normal case
+
+         if Match (Line, No_Cont) then
+            Put_Line (Ofile, A & "   " & N1 & ", " & N2 & ')');
+
+         --  Continuation case
+
+         else
+            if not Match (Line, Cont_N1) then
+               raise Err;
+            end if;
+
+            Getline;
+
+            if not Match (Line, Cont_N2) then
+               raise Err;
+            end if;
+
+            Put_Line (Ofile,  A & "   " & N1 & ',');
+            Put_Line (Ofile,  A & "   " & N2 & ')');
+         end if;
+      end if;
+   end loop;
+
+   --  Loop through functions. Note that this loop is terminated by
+   --  the call to Getfile encountering the end of functions sentinel
+
+   loop
+      if Match (Line, Is_Func) then
+         Getline;
+            if not Match (Line, Get_Arg) then
+               raise Err;
+            end if;
+         Put_Line
+           (Ofile,
+            A &  "INLINE " & Rpad (Rtn, 9)
+            & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
+
+         Put_Line (Ofile,  A & "   { return " & Comment & " (N); }");
+
+      else
+         Put_Line (Ofile, Line);
+      end if;
+
+      Getline;
+   end loop;
+
+   --  Can't get here since above loop only left via raise
+
+exception
+   when Done =>
+      Close (InS);
+      Put_Line (Ofile, "");
+      Put_Line (Ofile, "#ifdef __cplusplus");
+      Put_Line (Ofile, "}");
+      Put_Line (Ofile, "#endif");
+      Close (Ofile);
+      Set_Exit_Status (0);
+
+end XSinfo;