Subversion Repositories openrisc_me

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

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             G E T _ S C O S                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--             Copyright (C) 2009, 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 SCOs;  use SCOs;

with Types; use Types;

with Ada.IO_Exceptions; use Ada.IO_Exceptions;

procedure Get_SCOs is

   Dnum : Nat;

   C    : Character;

   Loc1 : Source_Location;

   Loc2 : Source_Location;

   Cond : Character;

   Dtyp : Character;

   use ASCII;

   --  For CR/LF

   function At_EOL return Boolean;

   --  Skips any spaces, then checks if we are the end of a line. If so,

   --  returns True (but does not skip over 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_Int return Int;

   --  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_Sloc_Range (Loc1, Loc2 : out Source_Location);

   --  Skips initial spaces, then reads a source location range in the form

   --  line:col-line:col and places the two source locations in Loc1 and Loc2.

   --  Raises Data_Error if format does not match this requirement.

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

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

   function Get_Int return Int is

      Val : Int;

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

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

   -- Get_Sloc_Range --

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

   procedure Get_Sloc_Range (Loc1, Loc2 : out Source_Location) is

      pragma Unsuppress (Range_Check);

   begin

      Skip_Spaces;

      Loc1.Line := Logical_Line_Number (Get_Int);

      Check (':');

      Loc1.Col := Column_Number (Get_Int);

      Check ('-');

      Loc2.Line := Logical_Line_Number (Get_Int);

      Check (':');

      Loc2.Col := Column_Number (Get_Int);

   exception

      when Constraint_Error =>

         raise Data_Error;

   end Get_Sloc_Range;

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

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

begin

   SCOs.Initialize;

   --  Loop through lines of SCO information

   while Nextc = 'C' loop

      Skipc;

      C := Getc;

      --  Make sure first line is a header line

      if SCO_Unit_Table.Last = 0 and then C /= ' ' then

         raise Data_Error;

      end if;

      --  Otherwise dispatch on type of line

      case C is

         --  Header entry

         when ' ' =>

            --  Complete previous entry if any

            if SCO_Unit_Table.Last /= 0 then

               SCO_Unit_Table.Table (SCO_Unit_Table.Last).To :=

                 SCO_Table.Last;

            end if;

            --  Scan out dependency number and file name

            declare

               Ptr  : String_Ptr := new String (1 .. 32768);

               N    : Integer;

            begin

               Skip_Spaces;

               Dnum := Get_Int;

               Skip_Spaces;

               N := 0;

               while Nextc > ' ' loop

                  N := N + 1;

                  Ptr.all (N) := Getc;

               end loop;

               --  Make new unit table entry (will fill in To later)

               SCO_Unit_Table.Append (

                 (File_Name => new String'(Ptr.all (1 .. N)),

                  Dep_Num   => Dnum,

                  From      => SCO_Table.Last + 1,

                  To        => 0));

               Free (Ptr);

            end;

         --  Statement entry

         when 'S' =>

            declare

               Typ : Character;

               Key : Character;

            begin

               Skip_Spaces;

               Key := 'S';

               loop

                  Typ := Nextc;

                  if Typ in '1' .. '9' then

                     Typ := ' ';

                  else

                     Skipc;

                  end if;

                  Get_Sloc_Range (Loc1, Loc2);

                  Add_SCO

                    (C1   => Key,

                     C2   => Typ,

                     From => Loc1,

                     To   => Loc2,

                     Last => At_EOL);

                  exit when At_EOL;

                  Key := 's';

               end loop;

            end;

         --  Decision entry

         when 'I' | 'E' | 'P' | 'W' | 'X' =>

            Dtyp := C;

            Skip_Spaces;

            C := Getc;

            --  Case of simple condition

            if C = 'c' or else C = 't' or else C = 'f' then

               Cond := C;

               Get_Sloc_Range (Loc1, Loc2);

               Add_SCO

                 (C1   => Dtyp,

                  C2   => Cond,

                  From => Loc1,

                  To   => Loc2,

                  Last => True);

            --  Complex expression

            else

               Add_SCO (C1 => Dtyp, Last => False);

               --  Loop through terms in complex expression

               while C /= CR and then C /= LF loop

                  if C = 'c' or else C = 't' or else C = 'f' then

                     Cond := C;

                     Skipc;

                     Get_Sloc_Range (Loc1, Loc2);

                     Add_SCO

                       (C2   => Cond,

                        From => Loc1,

                        To   => Loc2,

                        Last => False);

                  elsif C = '!' or else

                        C = '^' or else

                        C = '&' or else

                        C = '|'

                  then

                     Skipc;

                     Add_SCO (C1 => C, Last => False);

                  elsif C = ' ' then

                     Skip_Spaces;

                  else

                     raise Data_Error;

                  end if;

                  C := Nextc;

               end loop;

               --  Reset Last indication to True for last entry

               SCO_Table.Table (SCO_Table.Last).Last := True;

            end if;

         when others =>

            raise Data_Error;

      end case;

      Skip_EOL;

   end loop;

   --  Here with all SCO's stored, complete last SCO Unit table entry

   SCO_Unit_Table.Table (SCO_Unit_Table.Last).To := SCO_Table.Last;

end Get_SCOs;