diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/get_alfa.adb')
-rw-r--r-- | gcc-4.8/gcc/ada/get_alfa.adb | 499 |
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; |