diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/put_scos.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/put_scos.adb | 273 |
1 files changed, 273 insertions, 0 deletions
diff --git a/gcc-4.7/gcc/ada/put_scos.adb b/gcc-4.7/gcc/ada/put_scos.adb new file mode 100644 index 000000000..39fd04fcc --- /dev/null +++ b/gcc-4.7/gcc/ada/put_scos.adb @@ -0,0 +1,273 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P U 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. -- +-- -- +------------------------------------------------------------------------------ + +with Par_SCO; use Par_SCO; +with SCOs; use SCOs; +with Snames; use Snames; + +procedure Put_SCOs is + Current_SCO_Unit : SCO_Unit_Index := 0; + -- Initial value must not be a valid unit index + + procedure Write_SCO_Initiate (SU : SCO_Unit_Index); + -- Start SCO line for unit SU, also emitting SCO unit header if necessary + + procedure Output_Range (T : SCO_Table_Entry); + -- Outputs T.From and T.To in line:col-line:col format + + procedure Output_Source_Location (Loc : Source_Location); + -- Output source location in line:col format + + procedure Output_String (S : String); + -- Output S + + ------------------ + -- Output_Range -- + ------------------ + + procedure Output_Range (T : SCO_Table_Entry) is + begin + Output_Source_Location (T.From); + Write_Info_Char ('-'); + Output_Source_Location (T.To); + end Output_Range; + + ---------------------------- + -- Output_Source_Location -- + ---------------------------- + + procedure Output_Source_Location (Loc : Source_Location) is + begin + Write_Info_Nat (Nat (Loc.Line)); + Write_Info_Char (':'); + Write_Info_Nat (Nat (Loc.Col)); + end Output_Source_Location; + + ------------------- + -- Output_String -- + ------------------- + + procedure Output_String (S : String) is + begin + for J in S'Range loop + Write_Info_Char (S (J)); + end loop; + end Output_String; + + ------------------------ + -- Write_SCO_Initiate -- + ------------------------ + + procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is + SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU); + + begin + if Current_SCO_Unit /= SU then + Write_Info_Initiate ('C'); + Write_Info_Char (' '); + Write_Info_Nat (SUT.Dep_Num); + Write_Info_Char (' '); + + Output_String (SUT.File_Name.all); + + Write_Info_Terminate; + + Current_SCO_Unit := SU; + end if; + + Write_Info_Initiate ('C'); + end Write_SCO_Initiate; + +-- Start of processing for Put_SCOs + +begin + -- Loop through entries in SCO_Unit_Table. Note that entry 0 is by + -- convention present but unused. + + for U in 1 .. SCO_Unit_Table.Last loop + declare + SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U); + + Start : Nat; + Stop : Nat; + + begin + Start := SUT.From; + Stop := SUT.To; + + -- Loop through SCO entries for this unit + + loop + exit when Start = Stop + 1; + pragma Assert (Start <= Stop); + + Output_SCO_Line : declare + T : SCO_Table_Entry renames SCO_Table.Table (Start); + Continuation : Boolean; + + Ctr : Nat; + -- Counter for statement entries + + begin + case T.C1 is + + -- Statements (and dominance markers) + + when 'S' | '>' => + Ctr := 0; + Continuation := False; + loop + if Ctr = 0 then + Write_SCO_Initiate (U); + if not Continuation then + Write_Info_Char ('S'); + Continuation := True; + else + Write_Info_Char ('s'); + end if; + end if; + + Write_Info_Char (' '); + + declare + Sent : SCO_Table_Entry + renames SCO_Table.Table (Start); + begin + if Sent.C1 = '>' then + Write_Info_Char (Sent.C1); + end if; + + if Sent.C2 /= ' ' then + Write_Info_Char (Sent.C2); + + if Sent.C1 = 'S' + and then (Sent.C2 = 'P' or else Sent.C2 = 'p') + and then Sent.Pragma_Name /= Unknown_Pragma + then + -- Strip leading "PRAGMA_" + + declare + Pnam : constant String := + Sent.Pragma_Name'Img; + begin + Output_String + (Pnam (Pnam'First + 7 .. Pnam'Last)); + Write_Info_Char (':'); + end; + end if; + end if; + + -- For dependence markers (except E), output sloc. + -- For >E and all statement entries, output sloc + -- range. + + if Sent.C1 = '>' and then Sent.C2 /= 'E' then + Output_Source_Location (Sent.From); + else + Output_Range (Sent); + end if; + end; + + -- Increment entry counter (up to 6 entries per line, + -- continuation lines are marked Cs). + + Ctr := Ctr + 1; + if Ctr = 6 then + Write_Info_Terminate; + Ctr := 0; + end if; + + exit when SCO_Table.Table (Start).Last; + Start := Start + 1; + end loop; + + if Ctr > 0 then + Write_Info_Terminate; + end if; + + -- Decision + + when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' => + Start := Start + 1; + + -- For disabled pragma, or nested decision therein, skip + -- decision output. + + if SCO_Pragma_Disabled (T.Pragma_Sloc) then + while not SCO_Table.Table (Start).Last loop + Start := Start + 1; + end loop; + + -- For all other cases output decision line + + else + Write_SCO_Initiate (U); + Write_Info_Char (T.C1); + + if T.C1 /= 'X' then + Write_Info_Char (' '); + Output_Source_Location (T.From); + end if; + + -- Loop through table entries for this decision + + loop + declare + T : SCO_Table_Entry + renames SCO_Table.Table (Start); + + begin + Write_Info_Char (' '); + + if T.C1 = '!' or else + T.C1 = '&' or else + T.C1 = '|' + then + Write_Info_Char (T.C1); + Output_Source_Location (T.From); + + else + Write_Info_Char (T.C2); + Output_Range (T); + end if; + + exit when T.Last; + Start := Start + 1; + end; + end loop; + + Write_Info_Terminate; + end if; + + when others => + raise Program_Error; + end case; + end Output_SCO_Line; + + Start := Start + 1; + end loop; + end; + end loop; +end Put_SCOs; |