[Ada] Add dominance information to SCOs
Arnaud Charlet
charlet@adacore.com
Mon Dec 5 10:32:00 GMT 2011
This change enhances Source Coverage Obligations to convey information
about how a basic block can be entered (dominant statement, basic block
entry determined by a decision, or by an exception occurrence).
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Generate dominance
information in SCOs.
-------------- next part --------------
Index: par_sco.adb
===================================================================
--- par_sco.adb (revision 182003)
+++ par_sco.adb (working copy)
@@ -128,10 +128,24 @@
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);
+ type Dominant_Info is record
+ K : Character;
+ -- F/T/S/E for a valid dominance marker, or ' ' for no dominant
+
+ N : Node_Id;
+ -- Node providing the sloc(s) for the dominance marker
+ end record;
+ No_Dominant : constant Dominant_Info := (' ', Empty);
+
+ procedure Traverse_Declarations_Or_Statements
+ (L : List_Id;
+ D : Dominant_Info := No_Dominant);
+
procedure Traverse_Generic_Instantiation (N : Node_Id);
procedure Traverse_Generic_Package_Declaration (N : Node_Id);
- procedure Traverse_Handled_Statement_Sequence (N : Node_Id);
+ procedure Traverse_Handled_Statement_Sequence
+ (N : Node_Id;
+ D : Dominant_Info := No_Dominant);
procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Protected_Body (N : Node_Id);
@@ -763,7 +777,7 @@
declare
T : SCO_Table_Entry renames SCO_Table.Table (Index);
begin
- pragma Assert (T.C1 = 'S' or else T.C1 = 's');
+ pragma Assert (T.C1 = 'S');
return T.C2 = 'p';
end;
@@ -899,7 +913,7 @@
-- Called multiple times for the same sloc (need to allow for
-- C2 = 'P') ???
- pragma Assert ((T.C1 = 'S' or else T.C1 = 's')
+ pragma Assert (T.C1 = 'S'
and then
(T.C2 = 'p' or else T.C2 = 'P'));
T.C2 := 'P';
@@ -1018,7 +1032,16 @@
-- ensure that decisions are output after the CS line for the statements
-- in which the decisions occur.
- procedure Traverse_Declarations_Or_Statements (L : List_Id) is
+ procedure Traverse_Declarations_Or_Statements
+ (L : List_Id;
+ D : Dominant_Info := No_Dominant)
+ is
+ Current_Dominant : Dominant_Info := D;
+ -- Dominance information for the current basic block
+
+ Current_Condition : Node_Id;
+ -- Last tested condition in current IF statement
+
N : Node_Id;
Dummy : Source_Ptr;
@@ -1041,15 +1064,8 @@
-- the range from the CASE token to the last token of the expression.
procedure Set_Statement_Entry;
- -- If Start is No_Location, does nothing, otherwise outputs a SCO_Table
- -- statement entry for the range Start-Stop and then sets both Start
- -- and Stop to No_Location.
- -- What are Start and Stop??? This comment seems completely unrelated
- -- to the implementation!???
- -- Unconditionally sets Term to True. What is Term???
- -- This is called when we find a statement or declaration that generates
- -- its own table entry, so that we must end the current statement
- -- sequence.
+ -- Output CS entries for all statements saved in table SC, and end the
+ -- current CS sequence.
procedure Process_Decisions_Defer (N : Node_Id; T : Character);
pragma Inline (Process_Decisions_Defer);
@@ -1067,7 +1083,6 @@
-------------------------
procedure Set_Statement_Entry is
- C1 : Character;
SC_Last : constant Int := SC.Last;
SD_Last : constant Int := SD.Last;
@@ -1076,9 +1091,25 @@
for J in SC_First .. SC_Last loop
if J = SC_First then
- C1 := 'S';
- else
- C1 := 's';
+
+ if Current_Dominant /= No_Dominant then
+ declare
+ From, To : Source_Ptr;
+ begin
+ Sloc_Range (Current_Dominant.N, From, To);
+ if Current_Dominant.K /= 'E' then
+ To := No_Location;
+ end if;
+ Set_Table_Entry
+ (C1 => '>',
+ C2 => Current_Dominant.K,
+ From => From,
+ To => To,
+ Last => False,
+ Pragma_Sloc => No_Location,
+ Pragma_Name => Unknown_Pragma);
+ end;
+ end if;
end if;
declare
@@ -1102,7 +1133,7 @@
end if;
Set_Table_Entry
- (C1 => C1,
+ (C1 => 'S',
C2 => SCE.Typ,
From => SCE.From,
To => SCE.To,
@@ -1112,6 +1143,13 @@
end;
end loop;
+ -- Last statement of basic block, if present, becomes new current
+ -- dominant.
+
+ if SC_Last >= SC_First then
+ Current_Dominant := ('S', SC.Table (SC_Last).N);
+ end if;
+
-- Clear out used section of SC table
SC.Set_Last (SC_First - 1);
@@ -1261,6 +1299,7 @@
Extend_Statement_Sequence (N, ' ');
Process_Decisions_Defer (Condition (N), 'E');
Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
-- Label, which breaks the current statement sequence, but the
-- label itself is not included in the next statement sequence,
@@ -1268,26 +1307,33 @@
when N_Label =>
Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
-- Block statement, which breaks the current statement sequence
when N_Block_Statement =>
Set_Statement_Entry;
- Traverse_Declarations_Or_Statements (Declarations (N));
+ Traverse_Declarations_Or_Statements
+ (L => Declarations (N),
+ D => Current_Dominant);
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N));
+ (N => Handled_Statement_Sequence (N),
+ D => Current_Dominant);
-- If statement, which breaks the current statement sequence,
-- but we include the condition in the current sequence.
when N_If_Statement =>
- Extend_Statement_Sequence (N, Condition (N), 'I');
- Process_Decisions_Defer (Condition (N), 'I');
+ Current_Condition := Condition (N);
+ Extend_Statement_Sequence (N, Current_Condition, 'I');
+ Process_Decisions_Defer (Current_Condition, 'I');
Set_Statement_Entry;
-- Now we traverse the statements in the THEN part
- Traverse_Declarations_Or_Statements (Then_Statements (N));
+ Traverse_Declarations_Or_Statements
+ (L => Then_Statements (N),
+ D => ('T', Current_Condition));
-- Loop through ELSIF parts if present
@@ -1302,15 +1348,17 @@
-- construct "ELSIF condition", so that we have
-- a statement for the resulting decisions.
+ Current_Condition := Condition (Elif);
Extend_Statement_Sequence
- (Elif, Condition (Elif), 'I');
- Process_Decisions_Defer (Condition (Elif), 'I');
+ (Elif, Current_Condition, 'I');
+ Process_Decisions_Defer (Current_Condition, 'I');
Set_Statement_Entry;
-- Traverse the statements in the ELSIF
Traverse_Declarations_Or_Statements
- (Then_Statements (Elif));
+ (L => Then_Statements (Elif),
+ D => ('T', Current_Condition));
Next (Elif);
end loop;
end;
@@ -1318,7 +1366,9 @@
-- Finally traverse the ELSE statements if present
- Traverse_Declarations_Or_Statements (Else_Statements (N));
+ Traverse_Declarations_Or_Statements
+ (L => Else_Statements (N),
+ D => ('F', Current_Condition));
-- Case statement, which breaks the current statement sequence,
-- but we include the expression in the current sequence.
@@ -1328,14 +1378,17 @@
Process_Decisions_Defer (Expression (N), 'X');
Set_Statement_Entry;
- -- Process case branches
+ -- Process case branches, all of which are dominated by the
+ -- CASE expression.
declare
Alt : Node_Id;
begin
Alt := First (Alternatives (N));
while Present (Alt) loop
- Traverse_Declarations_Or_Statements (Statements (Alt));
+ Traverse_Declarations_Or_Statements
+ (L => Statements (Alt),
+ D => ('S', Expression (N)));
Next (Alt);
end loop;
end;
@@ -1348,6 +1401,7 @@
N_Raise_Statement =>
Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
-- Simple return statement. which is an exit point, but we
-- have to process the return expression for decisions.
@@ -1356,6 +1410,7 @@
Extend_Statement_Sequence (N, ' ');
Process_Decisions_Defer (Expression (N), 'X');
Set_Statement_Entry;
+ Current_Dominant := No_Dominant;
-- Extended return statement
@@ -1367,8 +1422,11 @@
Set_Statement_Entry;
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N));
+ (N => Handled_Statement_Sequence (N),
+ D => Current_Dominant);
+ Current_Dominant := No_Dominant;
+
-- Loop ends the current statement sequence, but we include
-- the iteration scheme if present in the current sequence.
-- But the body of the loop starts a new sequence, since it
@@ -1391,6 +1449,10 @@
Extend_Statement_Sequence (N, ISC, 'W');
Process_Decisions_Defer (Condition (ISC), 'W');
+ -- Set more specific dominant for inner statements
+
+ Current_Dominant := ('T', Condition (ISC));
+
-- For statement
else
@@ -1402,8 +1464,14 @@
end if;
Set_Statement_Entry;
- Traverse_Declarations_Or_Statements (Statements (N));
+ Traverse_Declarations_Or_Statements
+ (L => Statements (N),
+ D => Current_Dominant);
+ -- Reset current dominant
+
+ Current_Dominant := ('S', N);
+
-- Pragma
when N_Pragma =>
@@ -1580,7 +1648,10 @@
-- Traverse_Handled_Statement_Sequence --
-----------------------------------------
- procedure Traverse_Handled_Statement_Sequence (N : Node_Id) is
+ procedure Traverse_Handled_Statement_Sequence
+ (N : Node_Id;
+ D : Dominant_Info := No_Dominant)
+ is
Handler : Node_Id;
begin
@@ -1589,12 +1660,14 @@
-- which does not come from source, does not get a SCO.
if Present (N) and then Comes_From_Source (N) then
- Traverse_Declarations_Or_Statements (Statements (N));
+ Traverse_Declarations_Or_Statements (Statements (N), D);
if Present (Exception_Handlers (N)) then
Handler := First (Exception_Handlers (N));
while Present (Handler) loop
- Traverse_Declarations_Or_Statements (Statements (Handler));
+ Traverse_Declarations_Or_Statements
+ (L => Statements (Handler),
+ D => ('E', Handler));
Next (Handler);
end loop;
end if;
Index: scos.ads
===================================================================
--- scos.ads (revision 182003)
+++ scos.ads (working copy)
@@ -135,14 +135,14 @@
-- any statement with a label (the label itself is not part of the
-- entry point that is recorded).
- -- Each entry point must appear as the first entry on a CS line.
- -- The idea is that if any simple statement on a CS line is known to have
+ -- Each entry point must appear as the first statement entry on a CS
+ -- line. Thus, if any simple statement on a CS line is known to have
-- been executed, then all statements that appear before it on the same
-- CS line are certain to also have been executed.
-- The form of a statement line in the ALI file is:
- -- CS *sloc-range [*sloc-range...]
+ -- CS [dominance] *sloc-range [*sloc-range...]
-- where each sloc-range corresponds to a single statement, and * is
-- one of:
@@ -165,6 +165,23 @@
-- and is omitted for all other cases
+ -- The optional dominance marker is of the form gives additional
+ -- information as to how the sequence of statements denoted by the CS
+ -- line can be entered:
+
+ -- >F<sloc>
+ -- sequence is entered only if the decision at <sloc> is False
+ -- >T<sloc>
+ -- sequence is entered only if the decision at <sloc> is True
+
+ -- >S<sloc>
+ -- sequence is entered only if the statement at <sloc> has been
+ -- executed
+
+ -- >E<sloc-range>
+ -- sequence is the sequence of statements for a exception_handler
+ -- with the given sloc range
+
-- Note: up to 6 entries can appear on a single CS line. If more than 6
-- entries appear in one logical statement sequence, continuation lines
-- are marked by Cs and appear immediately after the CS line.
@@ -381,7 +398,7 @@
-- The SCO_Table_Entry values appear as follows:
-- Statements
- -- C1 = 'S' for entry point, 's' otherwise
+ -- C1 = 'S'
-- C2 = statement type code to appear on CS line (or ' ' if none)
-- From = starting source location
-- To = ending source location
@@ -400,6 +417,15 @@
-- Set_SCO_Pragma_Enabled changes C2 to 'P' to cause the entry to be
-- emitted in Put_SCOs.
+ -- Dominance marker
+ -- C1 = '>'
+ -- C2 = 'F'/'T'/'S'/'E'
+ -- From = Decision/statement sloc ('F'/'T'/'S'),
+ -- handler first sloc ('E')
+ -- To = No_Source_Location ('F'/'T'/'S'), handler last sloc ('E')
+
+ -- Note: A dominance marker is always followed by a statement entry.
+
-- Decision (EXIT/entry guard/IF/WHILE)
-- C1 = 'E'/'G'/'I'/'W' (for EXIT/entry Guard/IF/WHILE)
-- C2 = ' '
Index: put_scos.adb
===================================================================
--- put_scos.adb (revision 182003)
+++ put_scos.adb (working copy)
@@ -133,9 +133,9 @@
begin
case T.C1 is
- -- Statements
+ -- Statements (and dominance markers)
- when 'S' =>
+ when 'S' | '>' =>
Ctr := 0;
Continuation := False;
loop
@@ -161,9 +161,15 @@
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.C2 = 'P'
+
+ if Sent.C1 = 'S'
+ and then Sent.C2 = 'P'
and then Sent.Pragma_Name /= Unknown_Pragma
then
declare
@@ -179,7 +185,15 @@
end if;
end if;
- Output_Range (Sent);
+ -- 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,
@@ -194,19 +208,12 @@
<<Next_Statement>>
exit when SCO_Table.Table (Start).Last;
Start := Start + 1;
- pragma Assert (SCO_Table.Table (Start).C1 = 's');
end loop;
if Ctr > 0 then
Write_Info_Terminate;
end if;
- -- Statement continuations should not occur since they
- -- are supposed to have been handled in the loop above.
-
- when 's' =>
- raise Program_Error;
-
-- Decision
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
Index: get_scos.adb
===================================================================
--- get_scos.adb (revision 182003)
+++ get_scos.adb (working copy)
@@ -266,18 +266,13 @@
Pid : Pragma_Id;
begin
- -- If continuation, reset Last indication in last entry
- -- stored for previous CS or cs line, and start with key
- -- set to s for continuations.
+ Key := 'S';
+ -- If continuation, reset Last indication in last entry stored
+ -- for previous CS or cs line.
+
if C = 's' then
SCO_Table.Table (SCO_Table.Last).Last := False;
- Key := 's';
-
- -- CS case (first line, so start with key set to S)
-
- else
- Key := 'S';
end if;
-- Initialize to scan items on one line
@@ -287,40 +282,55 @@
-- Loop through items on one line
loop
+ Pid := Unknown_Pragma;
Typ := Nextc;
- if Typ in '1' .. '9' then
- Typ := ' ';
- else
- Skipc;
- if Typ = 'P' then
- Pid := Unknown_Pragma;
+ case Typ is
+ when '>' =>
+ -- A dominance marker may be present only at an entry
+ -- point.
- if Nextc not in '1' .. '9' then
- N := 1;
- loop
- Buf (N) := Getc;
- exit when Nextc = ':';
- N := N + 1;
- end loop;
- Skipc;
+ pragma Assert (Key = 'S');
- begin
- Pid :=
- Pragma_Id'Value ("pragma_" & Buf (1 .. N));
- exception
- when Constraint_Error =>
+ Key := '>';
+ Typ := Nextc;
- -- Pid remains set to Unknown_Pragma
+ when '1' .. '9' =>
+ Typ := ' ';
- null;
- end;
+ when others =>
+ Skipc;
+ if Typ = 'P' then
+ if Nextc not in '1' .. '9' then
+ N := 1;
+ loop
+ Buf (N) := Getc;
+ exit when Nextc = ':';
+ N := N + 1;
+ end loop;
+ Skipc;
+
+ begin
+ Pid :=
+ Pragma_Id'Value ("pragma_" & Buf (1 .. N));
+ exception
+ when Constraint_Error =>
+
+ -- Pid remains set to Unknown_Pragma
+
+ null;
+ end;
+ end if;
end if;
- end if;
+ end case;
+
+ if Key = '>' and then Typ /= 'E' then
+ Get_Source_Location (Loc1);
+ Loc2 := No_Source_Location;
+ else
+ Get_Source_Location_Range (Loc1, Loc2);
end if;
- Get_Source_Location_Range (Loc1, Loc2);
-
SCO_Table.Append
((C1 => Key,
C2 => Typ,
@@ -330,8 +340,11 @@
Pragma_Sloc => No_Location,
Pragma_Name => Pid));
+ if Key = '>' then
+ Key := 'S';
+ end if;
+
exit when At_EOL;
- Key := 's';
end loop;
end;
More information about the Gcc-patches
mailing list