aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8/gcc/ada/get_alfa.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8/gcc/ada/get_alfa.adb')
-rw-r--r--gcc-4.8/gcc/ada/get_alfa.adb499
1 files changed, 0 insertions, 499 deletions
diff --git a/gcc-4.8/gcc/ada/get_alfa.adb b/gcc-4.8/gcc/ada/get_alfa.adb
deleted file mode 100644
index a10637cd3..000000000
--- a/gcc-4.8/gcc/ada/get_alfa.adb
+++ /dev/null
@@ -1,499 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- G E T _ A L F A --
--- --
--- B o d y --
--- --
--- Copyright (C) 2011-2012, 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).
-
- File_Name : String_Ptr;
- Unit_File_Name : String_Ptr;
-
- -----------------------
- -- 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;
- File_Name := new String'(Name_Str (1 .. Name_Len));
- Skip_Spaces;
-
- -- Scan out unit file name when present (for subunits)
-
- if Nextc = '-' then
- Skipc;
- Check ('>');
- Skip_Spaces;
- Get_Name;
- Unit_File_Name := new String'(Name_Str (1 .. Name_Len));
-
- else
- Unit_File_Name := null;
- end if;
-
- -- Make new File table entry (will fill in To_Scope later)
-
- Alfa_File_Table.Append (
- (File_Name => File_Name,
- Unit_File_Name => Unit_File_Name,
- 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;