diff options
Diffstat (limited to 'gcc-4.8/gcc/ada/get_scos.adb')
-rw-r--r-- | gcc-4.8/gcc/ada/get_scos.adb | 510 |
1 files changed, 0 insertions, 510 deletions
diff --git a/gcc-4.8/gcc/ada/get_scos.adb b/gcc-4.8/gcc/ada/get_scos.adb deleted file mode 100644 index ca90a85b4..000000000 --- a/gcc-4.8/gcc/ada/get_scos.adb +++ /dev/null @@ -1,510 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G E T _ S C O S -- --- -- --- B o d y -- --- -- --- Copyright (C) 2009-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. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2005; --- This unit is not part of the compiler proper, it is used in tools that --- read SCO information from ALI files (Xcov and sco_test). Ada 2005 --- constructs may therefore be used freely (and are indeed). - -with Namet; use Namet; -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_Source_Location (Loc : out Source_Location); - -- Reads a source location in the form line:col and places the source - -- location in Loc. Raises Data_Error if the format does not match this - -- requirement. Note that initial spaces are not skipped. - - procedure Get_Source_Location_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_Source_Location -- - ------------------------- - - procedure Get_Source_Location (Loc : out Source_Location) is - pragma Unsuppress (Range_Check); - begin - Loc.Line := Logical_Line_Number (Get_Int); - Check (':'); - Loc.Col := Column_Number (Get_Int); - exception - when Constraint_Error => - raise Data_Error; - end Get_Source_Location; - - ------------------------------- - -- Get_Source_Location_Range -- - ------------------------------- - - procedure Get_Source_Location_Range (Loc1, Loc2 : out Source_Location) is - begin - Skip_Spaces; - Get_Source_Location (Loc1); - Check ('-'); - Get_Source_Location (Loc2); - end Get_Source_Location_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; - - Buf : String (1 .. 32_768); - N : Natural; - -- Scratch buffer, and index into it - - Nam : Name_Id; - --- 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 or instance table 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; - - Skip_Spaces; - - case Nextc is - - -- Instance table entry - - when 'i' => - declare - Inum : SCO_Instance_Index; - begin - Skipc; - Skip_Spaces; - - Inum := SCO_Instance_Index (Get_Int); - SCO_Instance_Table.Increment_Last; - pragma Assert (SCO_Instance_Table.Last = Inum); - - Skip_Spaces; - declare - SIE : SCO_Instance_Table_Entry - renames SCO_Instance_Table.Table (Inum); - begin - SIE.Inst_Dep_Num := Get_Int; - C := Getc; - pragma Assert (C = '|'); - Get_Source_Location (SIE.Inst_Loc); - - if At_EOL then - SIE.Enclosing_Instance := 0; - else - Skip_Spaces; - SIE.Enclosing_Instance := - SCO_Instance_Index (Get_Int); - pragma Assert (SIE.Enclosing_Instance in - SCO_Instance_Table.First - .. SCO_Instance_Table.Last); - end if; - end; - end; - - -- Unit header - - when '0' .. '9' => - -- Scan out dependency number and file name - - Dnum := Get_Int; - - Skip_Spaces; - - N := 0; - while Nextc > ' ' loop - N := N + 1; - Buf (N) := Getc; - end loop; - - -- Make new unit table entry (will fill in To later) - - SCO_Unit_Table.Append ( - (File_Name => new String'(Buf (1 .. N)), - Dep_Num => Dnum, - From => SCO_Table.Last + 1, - To => 0)); - - when others => - raise Program_Error; - - end case; - - -- Statement entry - - when 'S' | 's' => - declare - Typ : Character; - Key : Character; - - begin - Key := 'S'; - - -- If continuation, reset Last indication in last entry stored - -- for previous CS or cs line. - - if C = 's' then - SCO_Table.Table (SCO_Table.Last).Last := False; - end if; - - -- Initialize to scan items on one line - - Skip_Spaces; - - -- Loop through items on one line - - loop - Nam := No_Name; - Typ := Nextc; - - case Typ is - when '>' => - - -- Dominance marker may be present only at entry point - - pragma Assert (Key = 'S'); - - Skipc; - Key := '>'; - Typ := Getc; - - -- Sanity check on dominance marker type indication - - pragma Assert (Typ in 'A' .. 'Z'); - - when '1' .. '9' => - Typ := ' '; - - when others => - Skipc; - if Typ = 'P' or else Typ = 'p' then - if Nextc not in '1' .. '9' then - Name_Len := 0; - loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Getc; - exit when Nextc = ':'; - end loop; - - Skipc; -- Past ':' - - Nam := Name_Find; - end if; - end if; - end case; - - if Key = '>' and then Typ /= 'E' then - Get_Source_Location (Loc1); - Loc2 := No_Source_Location; - else - Get_Source_Location_Range (Loc1, Loc2); - end if; - - SCO_Table.Append - ((C1 => Key, - C2 => Typ, - From => Loc1, - To => Loc2, - Last => At_EOL, - Pragma_Sloc => No_Location, - Pragma_Aspect_Name => Nam)); - - if Key = '>' then - Key := 'S'; - end if; - - exit when At_EOL; - end loop; - end; - - -- Decision entry - - when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' => - Dtyp := C; - - if C = 'A' then - Name_Len := 0; - while Nextc /= ' ' loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := Getc; - end loop; - - Nam := Name_Find; - - else - Nam := No_Name; - end if; - - Skip_Spaces; - - -- Output header - - declare - Loc : Source_Location; - - begin - -- Acquire location information - - if Dtyp = 'X' then - Loc := No_Source_Location; - else - Get_Source_Location (Loc); - end if; - - SCO_Table.Append - ((C1 => Dtyp, - C2 => ' ', - From => Loc, - To => No_Source_Location, - Last => False, - Pragma_Aspect_Name => Nam, - others => <>)); - end; - - -- Loop through terms in complex expression - - C := Nextc; - while C /= CR and then C /= LF loop - if C = 'c' or else C = 't' or else C = 'f' then - Cond := C; - Skipc; - Get_Source_Location_Range (Loc1, Loc2); - SCO_Table.Append - ((C2 => Cond, - From => Loc1, - To => Loc2, - Last => False, - others => <>)); - - elsif C = '!' or else - C = '&' or else - C = '|' - then - Skipc; - - declare - Loc : Source_Location; - begin - Get_Source_Location (Loc); - SCO_Table.Append - ((C1 => C, - From => Loc, - Last => False, - others => <>)); - end; - - elsif C = ' ' then - Skip_Spaces; - - elsif C = 'T' or else C = 'F' then - - -- Chaining indicator: skip for now??? - - declare - Loc1, Loc2 : Source_Location; - pragma Unreferenced (Loc1, Loc2); - begin - Skipc; - Get_Source_Location_Range (Loc1, Loc2); - end; - - 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; - - -- No other SCO lines are possible - - 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; |