[thirdparty/gcc.git] / gcc / ada / put_scos.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             P U T _ S C O S                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2009-2019, 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;
with 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);
                              pragma Assert (T.C2 /= '?');
                              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;
Commit	Line	Data
f7f0159d AC	1	------------------------------------------------------------------------------
	2	-- --
	3	-- GNAT COMPILER COMPONENTS --
	4	-- --
5ffe0bab	5	-- P U T _ S C O S --
f7f0159d AC	6	-- --
	7	-- B o d y --
	8	-- --
1d005acc	9	-- Copyright (C) 2009-2019, Free Software Foundation, Inc. --
f7f0159d AC	10	-- --
	11	-- GNAT is free software; you can redistribute it and/or modify it under --
	12	-- terms of the GNU General Public License as published by the Free Soft- --
	13	-- ware Foundation; either version 3, or (at your option) any later ver- --
	14	-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
	15	-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
	16	-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
	17	-- for more details. You should have received a copy of the GNU General --
	18	-- Public License distributed with GNAT; see file COPYING3. If not, go to --
	19	-- http://www.gnu.org/licenses for a complete copy of the license. --
	20	-- --
	21	-- GNAT was originally developed by the GNAT team at New York University. --
	22	-- Extensive contributions were provided by Ada Core Technologies Inc. --
	23	-- --
	24	------------------------------------------------------------------------------
	25
851e9f19 PMR	26	with Namet;
	27	with Opt;
	28	with SCOs; use SCOs;
f7f0159d AC	29
f7f0159d AC	30	procedure Put_SCOs is
11bc76df AC	31	Current_SCO_Unit : SCO_Unit_Index := 0;
	32	-- Initial value must not be a valid unit index
	33
	34	procedure Write_SCO_Initiate (SU : SCO_Unit_Index);
	35	-- Start SCO line for unit SU, also emitting SCO unit header if necessary
25adc5fb	36
cf427f02 AC	37	procedure Write_Instance_Table;
	38	-- Output the SCO table of instances
	39
25adc5fb AC	40	procedure Output_Range (T : SCO_Table_Entry);
	41	-- Outputs T.From and T.To in line:col-line:col format
	42
	43	procedure Output_Source_Location (Loc : Source_Location);
	44	-- Output source location in line:col format
	45
828d4cf0 TQ	46	procedure Output_String (S : String);
	47	-- Output S
	48
25adc5fb AC	49	------------------
	50	-- Output_Range --
	51	------------------
	52
	53	procedure Output_Range (T : SCO_Table_Entry) is
	54	begin
	55	Output_Source_Location (T.From);
	56	Write_Info_Char ('-');
	57	Output_Source_Location (T.To);
	58	end Output_Range;
	59
	60	----------------------------
	61	-- Output_Source_Location --
	62	----------------------------
	63
	64	procedure Output_Source_Location (Loc : Source_Location) is
	65	begin
	66	Write_Info_Nat (Nat (Loc.Line));
	67	Write_Info_Char (':');
	68	Write_Info_Nat (Nat (Loc.Col));
	69	end Output_Source_Location;
	70
828d4cf0 TQ	71	-------------------
	72	-- Output_String --
	73	-------------------
	74
	75	procedure Output_String (S : String) is
	76	begin
	77	for J in S'Range loop
	78	Write_Info_Char (S (J));
	79	end loop;
	80	end Output_String;
	81
cf427f02 AC	82	--------------------------
	83	-- Write_Instance_Table --
	84	--------------------------
	85
	86	procedure Write_Instance_Table is
	87	begin
	88	for J in 1 .. SCO_Instance_Table.Last loop
	89	declare
	90	SIE : SCO_Instance_Table_Entry
	91	renames SCO_Instance_Table.Table (J);
	92	begin
	93	Output_String ("C i ");
	94	Write_Info_Nat (Nat (J));
	95	Write_Info_Char (' ');
	96	Write_Info_Nat (SIE.Inst_Dep_Num);
	97	Write_Info_Char ('\|');
	98	Output_Source_Location (SIE.Inst_Loc);
	99
	100	if SIE.Enclosing_Instance > 0 then
	101	Write_Info_Char (' ');
	102	Write_Info_Nat (Nat (SIE.Enclosing_Instance));
	103	end if;
	104	Write_Info_Terminate;
	105	end;
	106	end loop;
	107	end Write_Instance_Table;
	108
11bc76df AC	109	------------------------
	110	-- Write_SCO_Initiate --
	111	------------------------
	112
	113	procedure Write_SCO_Initiate (SU : SCO_Unit_Index) is
	114	SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (SU);
e0c32166	115
11bc76df AC	116	begin
	117	if Current_SCO_Unit /= SU then
	118	Write_Info_Initiate ('C');
	119	Write_Info_Char (' ');
	120	Write_Info_Nat (SUT.Dep_Num);
	121	Write_Info_Char (' ');
	122
	123	Output_String (SUT.File_Name.all);
	124
	125	Write_Info_Terminate;
	126
	127	Current_SCO_Unit := SU;
	128	end if;
	129
	130	Write_Info_Initiate ('C');
	131	end Write_SCO_Initiate;
	132
25adc5fb AC	133	-- Start of processing for Put_SCOs
25adc5fb AC	134
f7f0159d	135	begin
11bc76df AC	136	-- Loop through entries in SCO_Unit_Table. Note that entry 0 is by
11bc76df AC	137	-- convention present but unused.
f7f0159d	138
240fe2a4	139	for U in 1 .. SCO_Unit_Table.Last loop
f7f0159d AC	140	declare
	141	SUT : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (U);
	142
	143	Start : Nat;
	144	Stop : Nat;
	145
	146	begin
c5ff22e7 AC	147	Start := SUT.From;
	148	Stop := SUT.To;
	149
f7f0159d AC	150	-- Loop through SCO entries for this unit
f7f0159d AC	151
f7f0159d	152	loop
240fe2a4 AC	153	exit when Start = Stop + 1;
	154	pragma Assert (Start <= Stop);
	155
	156	Output_SCO_Line : declare
8fb3f5df AC	157	T : SCO_Table_Entry renames SCO_Table.Table (Start);
8fb3f5df AC	158	Continuation : Boolean;
f7f0159d	159
e0c32166	160	Ctr : Nat;
11bc76df AC	161	-- Counter for statement entries
11bc76df AC	162
f7f0159d	163	begin
f7f0159d AC	164	case T.C1 is
f7f0159d AC	165
3128f955	166	-- Statements (and dominance markers)
f7f0159d	167
3128f955	168	when 'S' \| '>' =>
25adc5fb	169	Ctr := 0;
8fb3f5df	170	Continuation := False;
9dbf1c3e	171	loop
8fb3f5df	172	if Ctr = 0 then
11bc76df	173	Write_SCO_Initiate (U);
8fb3f5df AC	174	if not Continuation then
	175	Write_Info_Char ('S');
	176	Continuation := True;
	177	else
	178	Write_Info_Char ('s');
	179	end if;
	180	end if;
	181
9dbf1c3e RD	182	Write_Info_Char (' ');
9dbf1c3e RD	183
828d4cf0 TQ	184	declare
	185	Sent : SCO_Table_Entry
	186	renames SCO_Table.Table (Start);
	187	begin
3128f955 AC	188	if Sent.C1 = '>' then
	189	Write_Info_Char (Sent.C1);
	190	end if;
	191
828d4cf0 TQ	192	if Sent.C2 /= ' ' then
828d4cf0 TQ	193	Write_Info_Char (Sent.C2);
3128f955 AC	194
3128f955 AC	195	if Sent.C1 = 'S'
88a27b18	196	and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
06ad40d3	197	and then Sent.Pragma_Aspect_Name /= No_Name
828d4cf0	198	then
06ad40d3 AC	199	Write_Info_Name (Sent.Pragma_Aspect_Name);
06ad40d3 AC	200	Write_Info_Char (':');
828d4cf0 TQ	201	end if;
828d4cf0 TQ	202	end if;
9dbf1c3e	203
3128f955 AC	204	-- For dependence markers (except E), output sloc.
	205	-- For >E and all statement entries, output sloc
	206	-- range.
	207
	208	if Sent.C1 = '>' and then Sent.C2 /= 'E' then
	209	Output_Source_Location (Sent.From);
	210	else
	211	Output_Range (Sent);
	212	end if;
828d4cf0	213	end;
9dbf1c3e	214
8fb3f5df AC	215	-- Increment entry counter (up to 6 entries per line,
8fb3f5df AC	216	-- continuation lines are marked Cs).
25adc5fb AC	217
25adc5fb AC	218	Ctr := Ctr + 1;
25adc5fb AC	219	if Ctr = 6 then
25adc5fb AC	220	Write_Info_Terminate;
25adc5fb AC	221	Ctr := 0;
25adc5fb AC	222	end if;
8fb3f5df	223
8fb3f5df AC	224	exit when SCO_Table.Table (Start).Last;
8fb3f5df AC	225	Start := Start + 1;
9dbf1c3e RD	226	end loop;
9dbf1c3e RD	227
b254da66 AC	228	if Ctr > 0 then
	229	Write_Info_Terminate;
	230	end if;
82923c66	231
9dbf1c3e	232	-- Decision
f7f0159d	233
06ad40d3	234	when 'E' \| 'G' \| 'I' \| 'P' \| 'W' \| 'X' \| 'A' =>
25adc5fb AC	235	Start := Start + 1;
25adc5fb AC	236
06ad40d3 AC	237	Write_SCO_Initiate (U);
06ad40d3 AC	238	Write_Info_Char (T.C1);
b26be063	239
06ad40d3 AC	240	if T.C1 = 'A' then
	241	Write_Info_Name (T.Pragma_Aspect_Name);
	242	end if;
	243
	244	if T.C1 /= 'X' then
	245	Write_Info_Char (' ');
	246	Output_Source_Location (T.From);
	247	end if;
f7f0159d	248
06ad40d3	249	-- Loop through table entries for this decision
f7f0159d	250
06ad40d3 AC	251	loop
06ad40d3 AC	252	declare
246ff1ae	253	T : SCO_Table_Entry renames SCO_Table.Table (Start);
f7f0159d	254
06ad40d3	255	begin
f7f0159d AC	256	Write_Info_Char (' ');
f7f0159d AC	257
06ad40d3 AC	258	if T.C1 = '!' or else
	259	T.C1 = '&' or else
	260	T.C1 = '\|'
	261	then
	262	Write_Info_Char (T.C1);
0566484a	263	pragma Assert (T.C2 /= '?');
06ad40d3	264	Output_Source_Location (T.From);
f7f0159d	265
06ad40d3 AC	266	else
	267	Write_Info_Char (T.C2);
	268	Output_Range (T);
	269	end if;
f7f0159d	270
06ad40d3 AC	271	exit when T.Last;
	272	Start := Start + 1;
	273	end;
	274	end loop;
25adc5fb	275
06ad40d3	276	Write_Info_Terminate;
25adc5fb	277
06ad40d3	278	when ASCII.NUL =>
25adc5fb	279
06ad40d3	280	-- Nullified entry: skip
82923c66	281
06ad40d3	282	null;
f7f0159d AC	283
	284	when others =>
	285	raise Program_Error;
	286	end case;
240fe2a4	287	end Output_SCO_Line;
f7f0159d	288
f7f0159d	289	Start := Start + 1;
f7f0159d AC	290	end loop;
f7f0159d AC	291	end;
f7f0159d	292	end loop;
cf427f02 AC	293
	294	if Opt.Generate_SCO_Instance_Table then
	295	Write_Instance_Table;
	296	end if;
f7f0159d	297	end Put_SCOs;