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>
* opt.ads: Minor editing.
......
gcc/ada/get_scos.adb
......@@ -23,8 +23,11 @@
-- --
------------------------------------------------------------------------------
with SCOs; use SCOs;
with Types; use Types;
pragma Ada_2005;
with SCOs; use SCOs;
with Snames; use Snames;
with Types; use Types;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
......@@ -193,6 +196,10 @@ procedure Get_SCOs is
end loop;
end Skip_Spaces;
Buf : String (1 .. 32_768);
N : Natural;
-- Scratch buffer, and index into it
-- Start of processing for Get_Scos
begin
......@@ -228,32 +235,24 @@ begin
-- Scan out dependency number and file name
declare
Ptr : String_Ptr := new String (1 .. 32768);
N : Integer;
begin
Skip_Spaces;
Dnum := Get_Int;
Skip_Spaces;
Skip_Spaces;
Dnum := Get_Int;
N := 0;
while Nextc > ' ' loop
N := N + 1;
Ptr.all (N) := Getc;
end loop;
Skip_Spaces;
-- 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 (
(File_Name => new String'(Ptr.all (1 .. N)),
Dep_Num => Dnum,
From => SCO_Table.Last + 1,
To => 0));
-- Make new unit table entry (will fill in To later)
Free (Ptr);
end;
SCO_Unit_Table.Append (
(File_Name => new String'(Buf (1 .. N)),
Dep_Num => Dnum,
From => SCO_Table.Last + 1,
To => 0));
-- Statement entry
......@@ -261,6 +260,7 @@ begin
declare
Typ : Character;
Key : Character;
Pid : Pragma_Id;
begin
-- If continuation, reset Last indication in last entry
......@@ -290,16 +290,33 @@ begin
Typ := ' ';
else
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;
Get_Source_Location_Range (Loc1, Loc2);
Add_SCO
(C1 => Key,
C2 => Typ,
From => Loc1,
To => Loc2,
Last => At_EOL);
SCO_Table.Append
((C1 => Key,
C2 => Typ,
From => Loc1,
To => Loc2,
Last => At_EOL,
Pragma_Sloc => No_Location,
Pragma_Name => Pid));
exit when At_EOL;
Key := 's';
......@@ -326,12 +343,13 @@ begin
Get_Source_Location (Loc);
end if;
Add_SCO
(C1 => Dtyp,
C2 => ' ',
From => Loc,
To => No_Source_Location,
Last => False);
SCO_Table.Append
((C1 => Dtyp,
C2 => ' ',
From => Loc,
To => No_Source_Location,
Last => False,
others => <>));
end;
-- Loop through terms in complex expression
......@@ -342,11 +360,12 @@ begin
Cond := C;
Skipc;
Get_Source_Location_Range (Loc1, Loc2);
Add_SCO
(C2 => Cond,
From => Loc1,
To => Loc2,
Last => False);
SCO_Table.Append
((C2 => Cond,
From => Loc1,
To => Loc2,
Last => False,
others => <>));
elsif C = '!' or else
C = '&' or else
......@@ -358,7 +377,11 @@ begin
Loc : Source_Location;
begin
Get_Source_Location (Loc);
Add_SCO (C1 => C, From => Loc, Last => False);
SCO_Table.Append
((C1 => C,
From => Loc,
Last => False,
others => <>));
end;
elsif C = ' ' then
......
gcc/ada/par_sco.adb
......@@ -124,7 +124,8 @@ package body Par_SCO is
From : Source_Ptr;
To : Source_Ptr;
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
procedure Traverse_Declarations_Or_Statements (L : List_Id);
......@@ -916,7 +917,8 @@ package body Par_SCO is
From : Source_Ptr;
To : Source_Ptr;
Last : Boolean;
Pragma_Sloc : Source_Ptr := No_Location)
Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma)
is
function To_Source_Location (S : Source_Ptr) return Source_Location;
-- Converts Source_Ptr value to Source_Location (line/col) format
......@@ -939,13 +941,14 @@ package body Par_SCO is
-- Start of processing for Set_Table_Entry
begin
Add_SCO
(C1 => C1,
C2 => C2,
From => To_Source_Location (From),
To => To_Source_Location (To),
Last => Last,
Pragma_Sloc => Pragma_Sloc);
SCO_Table.Append
((C1 => C1,
C2 => C2,
From => To_Source_Location (From),
To => To_Source_Location (To),
Last => Last,
Pragma_Sloc => Pragma_Sloc,
Pragma_Name => Pragma_Name));
end Set_Table_Entry;
-----------------------------------------
......@@ -957,6 +960,7 @@ package body Par_SCO is
-- since they are shared by recursive calls to this procedure.
type SC_Entry is record
N : Node_Id;
From : Source_Ptr;
To : Source_Ptr;
Typ : Character;
......@@ -1080,6 +1084,7 @@ package body Par_SCO is
declare
SCE : SC_Entry renames SC.Table (J);
Pragma_Sloc : Source_Ptr := No_Location;
Pragma_Name : Pragma_Id := Unknown_Pragma;
begin
-- For the case of a statement SCO for a pragma controlled by
-- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
......@@ -1090,6 +1095,10 @@ package body Par_SCO is
Pragma_Sloc := SCE.From;
Condition_Pragma_Hash_Table.Set
(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;
Set_Table_Entry
......@@ -1098,7 +1107,8 @@ package body Par_SCO is
From => SCE.From,
To => SCE.To,
Last => (J = SC_Last),
Pragma_Sloc => Pragma_Sloc);
Pragma_Sloc => Pragma_Sloc,
Pragma_Name => Pragma_Name);
end;
end loop;
......@@ -1134,7 +1144,7 @@ package body Par_SCO is
T : Source_Ptr;
begin
Sloc_Range (N, F, T);
SC.Append ((F, T, Typ));
SC.Append ((N, F, T, Typ));
end Extend_Statement_Sequence;
procedure Extend_Statement_Sequence
......@@ -1147,7 +1157,7 @@ package body Par_SCO is
begin
Sloc_Range (From, F, Dummy);
Sloc_Range (To, Dummy, T);
SC.Append ((F, T, Typ));
SC.Append ((From, F, T, Typ));
end Extend_Statement_Sequence;
-----------------------------
......
gcc/ada/put_scos.adb
......@@ -25,6 +25,7 @@
with Par_SCO; use Par_SCO;
with SCOs; use SCOs;
with Snames; use Snames;
procedure Put_SCOs is
Ctr : Nat;
......@@ -35,6 +36,9 @@ procedure Put_SCOs is
procedure Output_Source_Location (Loc : Source_Location);
-- Output source location in line:col format
procedure Output_String (S : String);
-- Output S
------------------
-- Output_Range --
------------------
......@@ -57,6 +61,17 @@ procedure Put_SCOs is
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;
-- Start of processing for Put_SCOs
begin
......@@ -81,9 +96,7 @@ begin
Write_Info_Nat (SUT.Dep_Num);
Write_Info_Char (' ');
for N in SUT.File_Name'Range loop
Write_Info_Char (SUT.File_Name (N));
end loop;
Output_String (SUT.File_Name.all);
Write_Info_Terminate;
end if;
......@@ -125,11 +138,30 @@ begin
Write_Info_Char (' ');
if SCO_Table.Table (Start).C2 /= ' ' then
Write_Info_Char (SCO_Table.Table (Start).C2);
end if;
declare
Sent : SCO_Table_Entry
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,
-- continuation lines are marked Cs).
......
gcc/ada/scos.adb
......@@ -25,22 +25,6 @@
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 --
----------------
......
gcc/ada/scos.ads
......@@ -28,7 +28,11 @@
-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
-- 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;
......@@ -143,18 +147,18 @@ package SCOs is
-- where each sloc-range corresponds to a single statement, and * is
-- one of:
-- t type declaration
-- s subtype declaration
-- o object declaration
-- r renaming declaration
-- i generic instantiation
-- C CASE statement (from CASE through end of expression)
-- E EXIT statement
-- F FOR loop statement (from FOR through end of iteration scheme)
-- I IF statement (from IF through end of condition)
-- P PRAGMA
-- R extended RETURN statement
-- W WHILE loop statement (from WHILE through end of condition)
-- t type declaration
-- s subtype declaration
-- o object declaration
-- r renaming declaration
-- i generic instantiation
-- C CASE statement (from CASE through end of expression)
-- E EXIT statement
-- F FOR loop (from FOR through end of iteration scheme)
-- I IF statement (from IF through end of condition)
-- P[name:] PRAGMA with the indicated name
-- R extended RETURN statement
-- W WHILE loop statement (from WHILE through end of condition)
-- Note: for I and W, condition above is in the RM syntax sense (this
-- condition is a decision in SCO terminology).
......@@ -352,16 +356,19 @@ package SCOs is
No_Source_Location : Source_Location := (No_Line_Number, No_Column_Number);
type SCO_Table_Entry is record
From : Source_Location;
To : Source_Location;
C1 : Character;
C2 : Character;
Last : Boolean;
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;
-- 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
-- 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;
package SCO_Table is new GNAT.Table (
......@@ -486,13 +493,4 @@ package SCOs is
procedure Initialize;
-- 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;
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