Skip to content

R
riscv-gcc-1
Commit 828d4cf0 by Thomas Quinot Committed by Arnaud Charlet
Options

par_sco.adb, [...]: Record pragma name for each SCO statement corresponding to a pragma. 

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
	pragma name for each SCO statement corresponding to a pragma.

From-SVN: r178164
parent 5cd7bb15
Showing with 156 additions and 104 deletions
gcc/ada/ChangeLog
2011-08-29 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.adb, scos.ads, put_scos.adb, get_scos.adb: Record
pragma name for each SCO statement corresponding to a pragma.
2011-08-29 Arnaud Charlet <charlet@adacore.com> 2011-08-29 Arnaud Charlet <charlet@adacore.com>
* opt.ads: Minor editing. * opt.ads: Minor editing.
......
gcc/ada/get_scos.adb
...@@ -23,8 +23,11 @@ ...@@ -23,8 +23,11 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with SCOs; use SCOs; pragma Ada_2005;
with Types; use Types;
with SCOs; use SCOs;
with Snames; use Snames;
with Types; use Types;
with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.IO_Exceptions; use Ada.IO_Exceptions;
...@@ -193,6 +196,10 @@ procedure Get_SCOs is ...@@ -193,6 +196,10 @@ procedure Get_SCOs is
end loop; end loop;
end Skip_Spaces; end Skip_Spaces;
Buf : String (1 .. 32_768);
N : Natural;
-- Scratch buffer, and index into it
-- Start of processing for Get_Scos -- Start of processing for Get_Scos
begin begin
...@@ -228,32 +235,24 @@ begin ...@@ -228,32 +235,24 @@ begin
-- Scan out dependency number and file name -- Scan out dependency number and file name
declare Skip_Spaces;
Ptr : String_Ptr := new String (1 .. 32768); Dnum := Get_Int;
N : Integer;
begin
Skip_Spaces;
Dnum := Get_Int;
Skip_Spaces;
N := 0; Skip_Spaces;
while Nextc > ' ' loop
N := N + 1;
Ptr.all (N) := Getc;
end loop;
-- Make new unit table entry (will fill in To later) N := 0;
while Nextc > ' ' loop
N := N + 1;
Buf (N) := Getc;
end loop;
SCO_Unit_Table.Append ( -- Make new unit table entry (will fill in To later)
(File_Name => new String'(Ptr.all (1 .. N)),
Dep_Num => Dnum,
From => SCO_Table.Last + 1,
To => 0));
Free (Ptr); SCO_Unit_Table.Append (
end; (File_Name => new String'(Buf (1 .. N)),
Dep_Num => Dnum,
From => SCO_Table.Last + 1,
To => 0));
-- Statement entry -- Statement entry
...@@ -261,6 +260,7 @@ begin ...@@ -261,6 +260,7 @@ begin
declare declare
Typ : Character; Typ : Character;
Key : Character; Key : Character;
Pid : Pragma_Id;
begin begin
-- If continuation, reset Last indication in last entry -- If continuation, reset Last indication in last entry
...@@ -290,16 +290,33 @@ begin ...@@ -290,16 +290,33 @@ begin
Typ := ' '; Typ := ' ';
else else
Skipc; Skipc;
if Typ = 'P' and then Nextc not in '1' .. '9' then
N := 1;
loop
Buf (N) := Getc;
exit when Nextc = ':';
N := N + 1;
end loop;
begin
Pid := Pragma_Id'Value (Buf (1 .. N));
exception
when Constraint_Error =>
Pid := Unknown_Pragma;
end;
Skipc;
end if;
end if; end if;
Get_Source_Location_Range (Loc1, Loc2); Get_Source_Location_Range (Loc1, Loc2);
Add_SCO SCO_Table.Append
(C1 => Key, ((C1 => Key,
C2 => Typ, C2 => Typ,
From => Loc1, From => Loc1,
To => Loc2, To => Loc2,
Last => At_EOL); Last => At_EOL,
Pragma_Sloc => No_Location,
Pragma_Name => Pid));
exit when At_EOL; exit when At_EOL;
Key := 's'; Key := 's';
...@@ -326,12 +343,13 @@ begin ...@@ -326,12 +343,13 @@ begin
Get_Source_Location (Loc); Get_Source_Location (Loc);
end if; end if;
Add_SCO SCO_Table.Append
(C1 => Dtyp, ((C1 => Dtyp,
C2 => ' ', C2 => ' ',
From => Loc, From => Loc,
To => No_Source_Location, To => No_Source_Location,
Last => False); Last => False,
others => <>));
end; end;
-- Loop through terms in complex expression -- Loop through terms in complex expression
...@@ -342,11 +360,12 @@ begin ...@@ -342,11 +360,12 @@ begin
Cond := C; Cond := C;
Skipc; Skipc;
Get_Source_Location_Range (Loc1, Loc2); Get_Source_Location_Range (Loc1, Loc2);
Add_SCO SCO_Table.Append
(C2 => Cond, ((C2 => Cond,
From => Loc1, From => Loc1,
To => Loc2, To => Loc2,
Last => False); Last => False,
others => <>));
elsif C = '!' or else elsif C = '!' or else
C = '&' or else C = '&' or else
...@@ -358,7 +377,11 @@ begin ...@@ -358,7 +377,11 @@ begin
Loc : Source_Location; Loc : Source_Location;
begin begin
Get_Source_Location (Loc); Get_Source_Location (Loc);
Add_SCO (C1 => C, From => Loc, Last => False); SCO_Table.Append
((C1 => C,
From => Loc,
Last => False,
others => <>));
end; end;
elsif C = ' ' then elsif C = ' ' then
......
gcc/ada/par_sco.adb
...@@ -124,7 +124,8 @@ package body Par_SCO is ...@@ -124,7 +124,8 @@ package body Par_SCO is
From : Source_Ptr; From : Source_Ptr;
To : Source_Ptr; To : Source_Ptr;
Last : Boolean; Last : Boolean;
Pragma_Sloc : Source_Ptr := No_Location); Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma);
-- Append an entry to SCO_Table with fields set as per arguments -- Append an entry to SCO_Table with fields set as per arguments
procedure Traverse_Declarations_Or_Statements (L : List_Id); procedure Traverse_Declarations_Or_Statements (L : List_Id);
...@@ -916,7 +917,8 @@ package body Par_SCO is ...@@ -916,7 +917,8 @@ package body Par_SCO is
From : Source_Ptr; From : Source_Ptr;
To : Source_Ptr; To : Source_Ptr;
Last : Boolean; Last : Boolean;
Pragma_Sloc : Source_Ptr := No_Location) Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma)
is is
function To_Source_Location (S : Source_Ptr) return Source_Location; function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format -- Converts Source_Ptr value to Source_Location (line/col) format
...@@ -939,13 +941,14 @@ package body Par_SCO is ...@@ -939,13 +941,14 @@ package body Par_SCO is
-- Start of processing for Set_Table_Entry -- Start of processing for Set_Table_Entry
begin begin
Add_SCO SCO_Table.Append
(C1 => C1, ((C1 => C1,
C2 => C2, C2 => C2,
From => To_Source_Location (From), From => To_Source_Location (From),
To => To_Source_Location (To), To => To_Source_Location (To),
Last => Last, Last => Last,
Pragma_Sloc => Pragma_Sloc); Pragma_Sloc => Pragma_Sloc,
Pragma_Name => Pragma_Name));
end Set_Table_Entry; end Set_Table_Entry;
----------------------------------------- -----------------------------------------
...@@ -957,6 +960,7 @@ package body Par_SCO is ...@@ -957,6 +960,7 @@ package body Par_SCO is
-- since they are shared by recursive calls to this procedure. -- since they are shared by recursive calls to this procedure.
type SC_Entry is record type SC_Entry is record
N : Node_Id;
From : Source_Ptr; From : Source_Ptr;
To : Source_Ptr; To : Source_Ptr;
Typ : Character; Typ : Character;
...@@ -1080,6 +1084,7 @@ package body Par_SCO is ...@@ -1080,6 +1084,7 @@ package body Par_SCO is
declare declare
SCE : SC_Entry renames SC.Table (J); SCE : SC_Entry renames SC.Table (J);
Pragma_Sloc : Source_Ptr := No_Location; Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma;
begin begin
-- For the case of a statement SCO for a pragma controlled by -- For the case of a statement SCO for a pragma controlled by
-- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and -- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
...@@ -1090,6 +1095,10 @@ package body Par_SCO is ...@@ -1090,6 +1095,10 @@ package body Par_SCO is
Pragma_Sloc := SCE.From; Pragma_Sloc := SCE.From;
Condition_Pragma_Hash_Table.Set Condition_Pragma_Hash_Table.Set
(Pragma_Sloc, SCO_Table.Last + 1); (Pragma_Sloc, SCO_Table.Last + 1);
Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
elsif SCE.Typ = 'P' then
Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
end if; end if;
Set_Table_Entry Set_Table_Entry
...@@ -1098,7 +1107,8 @@ package body Par_SCO is ...@@ -1098,7 +1107,8 @@ package body Par_SCO is
From => SCE.From, From => SCE.From,
To => SCE.To, To => SCE.To,
Last => (J = SC_Last), Last => (J = SC_Last),
Pragma_Sloc => Pragma_Sloc); Pragma_Sloc => Pragma_Sloc,
Pragma_Name => Pragma_Name);
end; end;
end loop; end loop;
...@@ -1134,7 +1144,7 @@ package body Par_SCO is ...@@ -1134,7 +1144,7 @@ package body Par_SCO is
T : Source_Ptr; T : Source_Ptr;
begin begin
Sloc_Range (N, F, T); Sloc_Range (N, F, T);
SC.Append ((F, T, Typ)); SC.Append ((N, F, T, Typ));
end Extend_Statement_Sequence; end Extend_Statement_Sequence;
procedure Extend_Statement_Sequence procedure Extend_Statement_Sequence
...@@ -1147,7 +1157,7 @@ package body Par_SCO is ...@@ -1147,7 +1157,7 @@ package body Par_SCO is
begin begin
Sloc_Range (From, F, Dummy); Sloc_Range (From, F, Dummy);
Sloc_Range (To, Dummy, T); Sloc_Range (To, Dummy, T);
SC.Append ((F, T, Typ)); SC.Append ((From, F, T, Typ));
end Extend_Statement_Sequence; end Extend_Statement_Sequence;
----------------------------- -----------------------------
......
gcc/ada/put_scos.adb
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
with Par_SCO; use Par_SCO; with Par_SCO; use Par_SCO;
with SCOs; use SCOs; with SCOs; use SCOs;
with Snames; use Snames;
procedure Put_SCOs is procedure Put_SCOs is
Ctr : Nat; Ctr : Nat;
...@@ -35,6 +36,9 @@ procedure Put_SCOs is ...@@ -35,6 +36,9 @@ procedure Put_SCOs is
procedure Output_Source_Location (Loc : Source_Location); procedure Output_Source_Location (Loc : Source_Location);
-- Output source location in line:col format -- Output source location in line:col format
procedure Output_String (S : String);
-- Output S
------------------ ------------------
-- Output_Range -- -- Output_Range --
------------------ ------------------
...@@ -57,6 +61,17 @@ procedure Put_SCOs is ...@@ -57,6 +61,17 @@ procedure Put_SCOs is
Write_Info_Nat (Nat (Loc.Col)); Write_Info_Nat (Nat (Loc.Col));
end Output_Source_Location; 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;
-- Start of processing for Put_SCOs -- Start of processing for Put_SCOs
begin begin
...@@ -81,9 +96,7 @@ begin ...@@ -81,9 +96,7 @@ begin
Write_Info_Nat (SUT.Dep_Num); Write_Info_Nat (SUT.Dep_Num);
Write_Info_Char (' '); Write_Info_Char (' ');
for N in SUT.File_Name'Range loop Output_String (SUT.File_Name.all);
Write_Info_Char (SUT.File_Name (N));
end loop;
Write_Info_Terminate; Write_Info_Terminate;
end if; end if;
...@@ -125,11 +138,30 @@ begin ...@@ -125,11 +138,30 @@ begin
Write_Info_Char (' '); Write_Info_Char (' ');
if SCO_Table.Table (Start).C2 /= ' ' then declare
Write_Info_Char (SCO_Table.Table (Start).C2); Sent : SCO_Table_Entry
end if; renames SCO_Table.Table (Start);
begin
if Sent.C2 /= ' ' then
Write_Info_Char (Sent.C2);
if Sent.C2 = 'P'
and then Sent.Pragma_Name /= Unknown_Pragma
then
declare
Pnam : constant String :=
Sent.Pragma_Name'Img;
begin
-- Strip leading "PRAGMA_"
Output_String
(Pnam (Pnam'First + 7 .. Pnam'Last));
Write_Info_Char (':');
end;
end if;
end if;
Output_Range (SCO_Table.Table (Start)); Output_Range (Sent);
end;
-- Increment entry counter (up to 6 entries per line, -- Increment entry counter (up to 6 entries per line,
-- continuation lines are marked Cs). -- continuation lines are marked Cs).
......
gcc/ada/scos.adb
...@@ -25,22 +25,6 @@ ...@@ -25,22 +25,6 @@
package body SCOs is package body SCOs is
-------------
-- Add_SCO --
-------------
procedure Add_SCO
(From : Source_Location := No_Source_Location;
To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Last : Boolean := False;
Pragma_Sloc : Source_Ptr := No_Location)
is
begin
SCO_Table.Append ((From, To, C1, C2, Last, Pragma_Sloc));
end Add_SCO;
---------------- ----------------
-- Initialize -- -- Initialize --
---------------- ----------------
......
gcc/ada/scos.ads
...@@ -28,7 +28,11 @@ ...@@ -28,7 +28,11 @@
-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that -- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
-- is used in the ALI file. -- is used in the ALI file.
with Types; use Types; with Snames; use Snames;
-- Note: used for Pragma_Id only, no other feature from Snames should be used,
-- as a simplified version is maintained in Xcov.
with Types; use Types;
with GNAT.Table; with GNAT.Table;
...@@ -143,18 +147,18 @@ package SCOs is ...@@ -143,18 +147,18 @@ package SCOs is
-- where each sloc-range corresponds to a single statement, and * is -- where each sloc-range corresponds to a single statement, and * is
-- one of: -- one of:
-- t type declaration -- t type declaration
-- s subtype declaration -- s subtype declaration
-- o object declaration -- o object declaration
-- r renaming declaration -- r renaming declaration
-- i generic instantiation -- i generic instantiation
-- C CASE statement (from CASE through end of expression) -- C CASE statement (from CASE through end of expression)
-- E EXIT statement -- E EXIT statement
-- F FOR loop statement (from FOR through end of iteration scheme) -- F FOR loop (from FOR through end of iteration scheme)
-- I IF statement (from IF through end of condition) -- I IF statement (from IF through end of condition)
-- P PRAGMA -- P[name:] PRAGMA with the indicated name
-- R extended RETURN statement -- R extended RETURN statement
-- W WHILE loop statement (from WHILE through end of condition) -- W WHILE loop statement (from WHILE through end of condition)
-- Note: for I and W, condition above is in the RM syntax sense (this -- Note: for I and W, condition above is in the RM syntax sense (this
-- condition is a decision in SCO terminology). -- condition is a decision in SCO terminology).
...@@ -352,16 +356,19 @@ package SCOs is ...@@ -352,16 +356,19 @@ package SCOs is
No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number); No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
type SCO_Table_Entry is record type SCO_Table_Entry is record
From : Source_Location; From : Source_Location := No_Source_Location;
To : Source_Location; To : Source_Location := No_Source_Location;
C1 : Character; C1 : Character := ' ';
C2 : Character; C2 : Character := ' ';
Last : Boolean; Last : Boolean := False;
Pragma_Sloc : Source_Ptr := No_Location; Pragma_Sloc : Source_Ptr := No_Location;
-- For the statement SCO for a pragma, or for any expression SCO nested -- For the statement SCO for a pragma, or for any expression SCO nested
-- in a pragma Debug/Assert/PPC, location of PRAGMA token (used for -- in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
-- control of SCO output, value not recorded in ALI file). -- control of SCO output, value not recorded in ALI file).
Pragma_Name : Pragma_Id := Unknown_Pragma;
-- For the statement SCO for a pragma, gives the pragma name
end record; end record;
package SCO_Table is new GNAT.Table ( package SCO_Table is new GNAT.Table (
...@@ -486,13 +493,4 @@ package SCOs is ...@@ -486,13 +493,4 @@ package SCOs is
procedure Initialize; procedure Initialize;
-- Reset tables for a new compilation -- Reset tables for a new compilation
procedure Add_SCO
(From : Source_Location := No_Source_Location;
To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Last : Boolean := False;
Pragma_Sloc : Source_Ptr := No_Location);
-- Adds one entry to SCO table with given field values
end SCOs; end SCOs;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment