Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             G E T _ A L F A                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--             Copyright (C) 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.      --
--                                                                          --
------------------------------------------------------------------------------
 
with Alfa;  use Alfa;
with Types; use Types;
 
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
 
procedure Get_Alfa is
   C : Character;
 
   use ASCII;
   --  For CR/LF
 
   Cur_File : Nat;
   --  Dependency number for the current file
 
   Cur_Scope : Nat;
   --  Scope number for the current scope entity
 
   Cur_File_Idx : File_Index;
   --  Index in Alfa_File_Table of the current file
 
   Cur_Scope_Idx : Scope_Index;
   --  Index in Alfa_Scope_Table of the current scope
 
   Name_Str : String (1 .. 32768);
   Name_Len : Natural := 0;
   --  Local string used to store name of File/entity scanned as
   --  Name_Str (1 .. Name_Len).
 
   -----------------------
   -- Local Subprograms --
   -----------------------
 
   function At_EOL return Boolean;
   --  Skips any spaces, then checks if at the end of a line. If so, returns
   --  True (but does not skip the EOL sequence). If not, then returns False.
 
   procedure Check (C : Character);
   --  Checks that file is positioned at given character, and if so skips past
   --  it, If not, raises Data_Error.
 
   function Get_Nat return Nat;
   --  On entry the file is positioned to a digit. On return, the file is
   --  positioned past the last digit, and the returned result is the decimal
   --  value read. Data_Error is raised for overflow (value greater than
   --  Int'Last), or if the initial character is not a digit.
 
   procedure Get_Name;
   --  On entry the file is positioned to a name. On return, the file is
   --  positioned past the last character, and the name scanned is returned
   --  in Name_Str (1 .. Name_Len).
 
   procedure Skip_EOL;
   --  Called with the current character about to be read being LF or CR. Skips
   --  past CR/LF characters until either a non-CR/LF character is found, or
   --  the end of file is encountered.
 
   procedure Skip_Spaces;
   --  Skips zero or more spaces at the current position, leaving the file
   --  positioned at the first non-blank character (or Types.EOF).
 
   ------------
   -- At_EOL --
   ------------
 
   function At_EOL return Boolean is
   begin
      Skip_Spaces;
      return Nextc = CR or else Nextc = LF;
   end At_EOL;
 
   -----------
   -- Check --
   -----------
 
   procedure Check (C : Character) is
   begin
      if Nextc = C then
         Skipc;
      else
         raise Data_Error;
      end if;
   end Check;
 
   -------------
   -- Get_Nat --
   -------------
 
   function Get_Nat return Nat is
      Val : Nat;
      C   : Character;
 
   begin
      C := Nextc;
      Val := 0;
 
      if C not in '0' .. '9' then
         raise Data_Error;
      end if;
 
      --  Loop to read digits of integer value
 
      loop
         declare
            pragma Unsuppress (Overflow_Check);
         begin
            Val := Val * 10 + (Character'Pos (C) - Character'Pos ('0'));
         end;
 
         Skipc;
         C := Nextc;
 
         exit when C not in '0' .. '9';
      end loop;
 
      return Val;
 
   exception
      when Constraint_Error =>
         raise Data_Error;
   end Get_Nat;
 
   --------------
   -- Get_Name --
   --------------
 
   procedure Get_Name is
      N : Integer;
 
   begin
      N := 0;
      while Nextc > ' ' loop
         N := N + 1;
         Name_Str (N) := Getc;
      end loop;
 
      Name_Len := N;
   end Get_Name;
 
   --------------
   -- Skip_EOL --
   --------------
 
   procedure Skip_EOL is
      C : Character;
 
   begin
      loop
         Skipc;
         C := Nextc;
         exit when C /= LF and then C /= CR;
 
         if C = ' ' then
            Skip_Spaces;
            C := Nextc;
            exit when C /= LF and then C /= CR;
         end if;
      end loop;
   end Skip_EOL;
 
   -----------------
   -- Skip_Spaces --
   -----------------
 
   procedure Skip_Spaces is
   begin
      while Nextc = ' ' loop
         Skipc;
      end loop;
   end Skip_Spaces;
 
--  Start of processing for Get_Alfa
 
begin
   Initialize_Alfa_Tables;
 
   Cur_File      := 0;
   Cur_Scope     := 0;
   Cur_File_Idx  := 1;
   Cur_Scope_Idx := 0;
 
   --  Loop through lines of Alfa information
 
   while Nextc = 'F' loop
      Skipc;
 
      C := Getc;
 
      --  Make sure first line is a File line
 
      if Alfa_File_Table.Last = 0 and then C /= 'D' then
         raise Data_Error;
      end if;
 
      --  Otherwise dispatch on type of line
 
      case C is
 
         --  Header entry for scope section
 
         when 'D' =>
 
            --  Complete previous entry if any
 
            if Alfa_File_Table.Last /= 0 then
               Alfa_File_Table.Table (Alfa_File_Table.Last).To_Scope :=
                 Alfa_Scope_Table.Last;
            end if;
 
            --  Scan out dependency number and file name
 
            Skip_Spaces;
            Cur_File := Get_Nat;
            Skip_Spaces;
            Get_Name;
 
            --  Make new File table entry (will fill in To_Scope later)
 
            Alfa_File_Table.Append (
              (File_Name  => new String'(Name_Str (1 .. Name_Len)),
               File_Num   => Cur_File,
               From_Scope => Alfa_Scope_Table.Last + 1,
               To_Scope   => 0));
 
            --  Initialize counter for scopes
 
            Cur_Scope := 1;
 
         --  Scope entry
 
         when 'S' =>
            declare
               Spec_File  : Nat;
               Spec_Scope : Nat;
               Scope      : Nat;
               Line       : Nat;
               Col        : Nat;
               Typ        : Character;
 
            begin
               --  Scan out location
 
               Skip_Spaces;
               Check ('.');
               Scope := Get_Nat;
               Check (' ');
               Line  := Get_Nat;
               Typ   := Getc;
               Col   := Get_Nat;
 
               pragma Assert (Scope = Cur_Scope);
               pragma Assert         (Typ = 'K'
                              or else Typ = 'V'
                              or else Typ = 'U');
 
               --  Scan out scope entity name
 
               Skip_Spaces;
               Get_Name;
               Skip_Spaces;
 
               if Nextc = '-' then
                  Skipc;
                  Check ('>');
                  Skip_Spaces;
                  Spec_File := Get_Nat;
                  Check ('.');
                  Spec_Scope := Get_Nat;
 
               else
                  Spec_File  := 0;
                  Spec_Scope := 0;
               end if;
 
               --  Make new scope table entry (will fill in From_Xref and
               --  To_Xref later). Initial range (From_Xref .. To_Xref) is
               --  empty for scopes without entities.
 
               Alfa_Scope_Table.Append (
                 (Scope_Entity   => Empty,
                  Scope_Name     => new String'(Name_Str (1 .. Name_Len)),
                  File_Num       => Cur_File,
                  Scope_Num      => Cur_Scope,
                  Spec_File_Num  => Spec_File,
                  Spec_Scope_Num => Spec_Scope,
                  Line           => Line,
                  Stype          => Typ,
                  Col            => Col,
                  From_Xref      => 1,
                  To_Xref        => 0));
            end;
 
            --  Update counter for scopes
 
            Cur_Scope := Cur_Scope + 1;
 
         --  Header entry for cross-ref section
 
         when 'X' =>
 
            --  Scan out dependency number and file name (ignored)
 
            Skip_Spaces;
            Cur_File := Get_Nat;
            Skip_Spaces;
            Get_Name;
 
            --  Update component From_Xref of current file if first reference
            --  in this file.
 
            while Alfa_File_Table.Table (Cur_File_Idx).File_Num /= Cur_File
            loop
               Cur_File_Idx := Cur_File_Idx + 1;
            end loop;
 
            --  Scan out scope entity number and entity name (ignored)
 
            Skip_Spaces;
            Check ('.');
            Cur_Scope := Get_Nat;
            Skip_Spaces;
            Get_Name;
 
            --  Update component To_Xref of previous scope
 
            if Cur_Scope_Idx /= 0 then
               Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref :=
                 Alfa_Xref_Table.Last;
            end if;
 
            --  Update component From_Xref of current scope
 
            Cur_Scope_Idx := Alfa_File_Table.Table (Cur_File_Idx).From_Scope;
 
            while Alfa_Scope_Table.Table (Cur_Scope_Idx).Scope_Num /= Cur_Scope
            loop
               Cur_Scope_Idx := Cur_Scope_Idx + 1;
            end loop;
 
            Alfa_Scope_Table.Table (Cur_Scope_Idx).From_Xref :=
              Alfa_Xref_Table.Last + 1;
 
         --  Cross reference entry
 
         when ' ' =>
            declare
               XR_Entity      : String_Ptr;
               XR_Entity_Line : Nat;
               XR_Entity_Col  : Nat;
               XR_Entity_Typ  : Character;
 
               XR_File : Nat;
               --  Keeps track of the current file (changed by nn|)
 
               XR_Scope : Nat;
               --  Keeps track of the current scope (changed by nn:)
 
            begin
               XR_File  := Cur_File;
               XR_Scope := Cur_Scope;
 
               XR_Entity_Line := Get_Nat;
               XR_Entity_Typ  := Getc;
               XR_Entity_Col  := Get_Nat;
 
               Skip_Spaces;
               Get_Name;
               XR_Entity := new String'(Name_Str (1 .. Name_Len));
 
               --  Initialize to scan items on one line
 
               Skip_Spaces;
 
               --  Loop through cross-references for this entity
 
               loop
 
                  declare
                     Line  : Nat;
                     Col   : Nat;
                     N     : Nat;
                     Rtype : Character;
 
                  begin
                     Skip_Spaces;
 
                     if At_EOL then
                        Skip_EOL;
                        exit when Nextc /= '.';
                        Skipc;
                        Skip_Spaces;
                     end if;
 
                     if Nextc = '.' then
                        Skipc;
                        XR_Scope := Get_Nat;
                        Check (':');
 
                     else
                        N := Get_Nat;
 
                        if Nextc = '|' then
                           XR_File := N;
                           Skipc;
 
                        else
                           Line  := N;
                           Rtype := Getc;
                           Col   := Get_Nat;
 
                           pragma Assert
                             (Rtype = 'r' or else
                              Rtype = 'm' or else
                              Rtype = 's');
 
                           Alfa_Xref_Table.Append (
                             (Entity_Name => XR_Entity,
                              Entity_Line => XR_Entity_Line,
                              Etype       => XR_Entity_Typ,
                              Entity_Col  => XR_Entity_Col,
                              File_Num    => XR_File,
                              Scope_Num   => XR_Scope,
                              Line        => Line,
                              Rtype       => Rtype,
                              Col         => Col));
                        end if;
                     end if;
                  end;
               end loop;
            end;
 
         --  No other Alfa lines are possible
 
         when others =>
            raise Data_Error;
      end case;
 
      --  For cross reference lines, the EOL character has been skipped already
 
      if C /= ' ' then
         Skip_EOL;
      end if;
   end loop;
 
   --  Here with all Xrefs stored, complete last entries in File/Scope tables
 
   if Alfa_File_Table.Last /= 0 then
      Alfa_File_Table.Table (Alfa_File_Table.Last).To_Scope :=
        Alfa_Scope_Table.Last;
   end if;
 
   if Cur_Scope_Idx /= 0 then
      Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref := Alfa_Xref_Table.Last;
   end if;
end Get_Alfa;