-- --
-- GNAT COMPILER COMPONENTS --
-- --
--- P U T _ S C O S --
+-- P U T _ S C O S --
-- --
-- B o d y --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2011, 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- --
-- --
------------------------------------------------------------------------------
-with SCOs; use SCOs;
+with Par_SCO; use Par_SCO;
+with SCOs; use SCOs;
procedure Put_SCOs is
+ Ctr : Nat;
+
+ 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
+
+ ------------------
+ -- 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;
+
+-- Start of processing for Put_SCOs
+
begin
-- Loop through entries in SCO_Unit_Table
Stop : Nat;
begin
- Write_Info_Initiate ('C');
- Write_Info_Char (' ');
- Write_Info_Nat (SUT.Dep_Num);
- Write_Info_Char (' ');
+ Start := SUT.From;
+ Stop := SUT.To;
- for N in SUT.File_Name'Range loop
- Write_Info_Char (SUT.File_Name (N));
- end loop;
+ -- Write unit header (omitted if no SCOs are generated for this unit)
+
+ if Start <= Stop then
+ Write_Info_Initiate ('C');
+ Write_Info_Char (' ');
+ Write_Info_Nat (SUT.Dep_Num);
+ Write_Info_Char (' ');
- Write_Info_Terminate;
+ for N in SUT.File_Name'Range loop
+ Write_Info_Char (SUT.File_Name (N));
+ end loop;
+
+ Write_Info_Terminate;
+ end if;
-- Loop through SCO entries for this unit
- Start := SUT.From;
- Stop := SUT.To;
loop
exit when Start = Stop + 1;
pragma Assert (Start <= Stop);
Output_SCO_Line : declare
- T : SCO_Table_Entry renames SCO_Table.Table (Start);
+ T : SCO_Table_Entry renames SCO_Table.Table (Start);
+ Continuation : Boolean;
- procedure Output_Range (T : SCO_Table_Entry);
- -- Outputs T.From and T.To in line:col-line:col format
-
- ------------------
- -- Output_Range --
- ------------------
+ begin
+ case T.C1 is
- procedure Output_Range (T : SCO_Table_Entry) is
- begin
- Write_Info_Nat (Nat (T.From.Line));
- Write_Info_Char (':');
- Write_Info_Nat (Nat (T.From.Col));
- Write_Info_Char ('-');
- Write_Info_Nat (Nat (T.To.Line));
- Write_Info_Char (':');
- Write_Info_Nat (Nat (T.To.Col));
- end Output_Range;
+ -- Statements
- -- Start of processing for Output_SCO_Line
+ when 'S' =>
+ Ctr := 0;
+ Continuation := False;
+ loop
+ if SCO_Pragma_Disabled
+ (SCO_Table.Table (Start).Pragma_Sloc)
+ then
+ goto Next_Statement;
+ end if;
+
+ if Ctr = 0 then
+ Write_Info_Initiate ('C');
+ if not Continuation then
+ Write_Info_Char ('S');
+ Continuation := True;
+ else
+ Write_Info_Char ('s');
+ end if;
+ end if;
- begin
- Write_Info_Initiate ('C');
- Write_Info_Char (T.C1);
+ Write_Info_Char (' ');
- case T.C1 is
+ if SCO_Table.Table (Start).C2 /= ' ' then
+ Write_Info_Char (SCO_Table.Table (Start).C2);
+ end if;
- -- Statements, exit
+ Output_Range (SCO_Table.Table (Start));
- when 'S' | 'T' =>
- Write_Info_Char (' ');
- Output_Range (T);
+ -- Increment entry counter (up to 6 entries per line,
+ -- continuation lines are marked Cs).
- -- Decision
+ Ctr := Ctr + 1;
+ if Ctr = 6 then
+ Write_Info_Terminate;
+ Ctr := 0;
+ end if;
- when 'I' | 'E' | 'W' | 'X' =>
- if T.C2 = ' ' then
+ <<Next_Statement>>
+ exit when SCO_Table.Table (Start).Last;
Start := Start + 1;
- end if;
+ pragma Assert (SCO_Table.Table (Start).C1 = 's');
+ end loop;
- -- Loop through table entries for this decision
+ Write_Info_Terminate;
- loop
- declare
- T : SCO_Table_Entry renames SCO_Table.Table (Start);
+ -- Statement continuations should not occur since they
+ -- are supposed to have been handled in the loop above.
- begin
- Write_Info_Char (' ');
+ when 's' =>
+ raise Program_Error;
- if T.C1 = '!' or else
- T.C1 = '^' or else
- T.C1 = '&' or else
- T.C1 = '|'
- then
- Write_Info_Char (T.C1);
+ -- Decision
- else
- Write_Info_Char (T.C2);
- Output_Range (T);
- end if;
+ when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
+ Start := Start + 1;
+
+ -- For disabled pragma, or nested decision therein, skip
+ -- decision output.
- exit when T.Last;
+ if SCO_Pragma_Disabled (T.Pragma_Sloc) then
+ while not SCO_Table.Table (Start).Last loop
Start := Start + 1;
- end;
- end loop;
+ end loop;
+
+ -- For all other cases output decision line
+
+ else
+ Write_Info_Initiate ('C');
+ 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;
-
- Write_Info_Terminate;
end Output_SCO_Line;
Start := Start + 1;
OSDN Git Service
