aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8/gcc/ada/put_scos.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.8/gcc/ada/put_scos.adb')
-rw-r--r--gcc-4.8/gcc/ada/put_scos.adb296
1 files changed, 0 insertions, 296 deletions
diff --git a/gcc-4.8/gcc/ada/put_scos.adb b/gcc-4.8/gcc/ada/put_scos.adb
deleted file mode 100644
index de44c45d0..000000000
--- a/gcc-4.8/gcc/ada/put_scos.adb
+++ /dev/null
@@ -1,296 +0,0 @@
-------------------------------------------------------------------------------
--- --
--- 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 Namet; use Namet;
-with Opt; use Opt;
-with SCOs; use SCOs;
-
-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 Write_Instance_Table;
- -- Output the SCO table of instances
-
- 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_Instance_Table --
- --------------------------
-
- procedure Write_Instance_Table is
- begin
- for J in 1 .. SCO_Instance_Table.Last loop
- declare
- SIE : SCO_Instance_Table_Entry
- renames SCO_Instance_Table.Table (J);
- begin
- Output_String ("C i ");
- Write_Info_Nat (Nat (J));
- Write_Info_Char (' ');
- Write_Info_Nat (SIE.Inst_Dep_Num);
- Write_Info_Char ('|');
- Output_Source_Location (SIE.Inst_Loc);
-
- if SIE.Enclosing_Instance > 0 then
- Write_Info_Char (' ');
- Write_Info_Nat (Nat (SIE.Enclosing_Instance));
- end if;
- Write_Info_Terminate;
- end;
- end loop;
- end Write_Instance_Table;
-
- ------------------------
- -- 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_Aspect_Name /= No_Name
- then
- Write_Info_Name (Sent.Pragma_Aspect_Name);
- Write_Info_Char (':');
- 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' | 'A' =>
- Start := Start + 1;
-
- Write_SCO_Initiate (U);
- Write_Info_Char (T.C1);
-
- if T.C1 = 'A' then
- Write_Info_Name (T.Pragma_Aspect_Name);
- end if;
-
- 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;
-
- when ASCII.NUL =>
-
- -- Nullified entry: skip
-
- null;
-
- when others =>
- raise Program_Error;
- end case;
- end Output_SCO_Line;
-
- Start := Start + 1;
- end loop;
- end;
- end loop;
-
- if Opt.Generate_SCO_Instance_Table then
- Write_Instance_Table;
- end if;
-end Put_SCOs;
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-26 10:14:30 +0000