Subversion Repositories openrisc_me

------------------------------------------------------------------------------

--                                                                          --

--                          GNAT SYSTEM UTILITIES                           --

--                                                                          --

--                               X S I N F O                                --

--                                                                          --

--                                 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 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

--  Note: this program assumes that sinfo.ads has passed the error checks

--  which are carried out by the CSinfo utility, so it does not duplicate

--  these checks and assumes the source is correct.

--  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;

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

   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, "");

   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;

exception

   when Done =>

      Put_Line (Ofile, "");

      Set_Exit_Status (0);

end XSinfo;