Skip to content

R
riscv-gcc-1
Commit 3128f955 by Arnaud Charlet
Options

[multiple changes] 

2011-12-05  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Derive_Progenitor_Subprograms): Add Ultimate_Alias
	to the Comes_From_Source check, to deal properly with the case
	of indirect inheritance of "=".

2011-12-05  Thomas Quinot  <quinot@adacore.com>

	PR ada/51307
	* s-oscons-tmplt.c: On HP-UX, CLOCK_REALTIME is an enum literal,
	not a macro.

2011-12-05  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Generate dominance
	information in SCOs.

From-SVN: r182004
parent 9b554be9
Showing with 212 additions and 69 deletions
gcc/ada/ChangeLog
2011-12-05 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Derive_Progenitor_Subprograms): Add Ultimate_Alias
to the Comes_From_Source check, to deal properly with the case
of indirect inheritance of "=".
2011-12-05 Thomas Quinot <quinot@adacore.com>
PR ada/51307
* s-oscons-tmplt.c: On HP-UX, CLOCK_REALTIME is an enum literal,
not a macro.
2011-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Generate dominance
information in SCOs.
2011-12-02 Eric Botcazou <ebotcazou@adacore.com>
Thomas Quinot <quinot@adacore.com>
......
gcc/ada/get_scos.adb
......@@ -266,18 +266,13 @@ begin
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,15 +282,25 @@ begin
-- Loop through items on one line
loop
Pid := Unknown_Pragma;
Typ := Nextc;
case Typ is
when '>' =>
-- A dominance marker may be present only at an entry
-- point.
pragma Assert (Key = 'S');
Key := '>';
Typ := Nextc;
if Typ in '1' .. '9' then
when '1' .. '9' =>
Typ := ' ';
else
when others =>
Skipc;
if Typ = 'P' then
Pid := Unknown_Pragma;
if Nextc not in '1' .. '9' then
N := 1;
loop
......@@ -317,9 +322,14 @@ begin
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;
SCO_Table.Append
((C1 => Key,
......@@ -330,8 +340,11 @@ begin
Pragma_Sloc => No_Location,
Pragma_Name => Pid));
if Key = '>' then
Key := 'S';
end if;
exit when At_EOL;
Key := 's';
end loop;
end;
......
gcc/ada/par_sco.adb
......@@ -128,10 +128,24 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-------------------------
procedure Set_Statement_Entry is
C1 : Character;
SC_Last : constant Int := SC.Last;
SD_Last : constant Int := SD.Last;
......@@ -1076,9 +1091,25 @@ package body Par_SCO is
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 @@ package body Par_SCO is
end if;
Set_Table_Entry
(C1 => C1,
(C1 => 'S',
C2 => SCE.Typ,
From => SCE.From,
To => SCE.To,
......@@ -1112,6 +1143,13 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
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 @@ package body Par_SCO is
Extend_Statement_Sequence (N, ' ');
Process_Decisions_Defer (Expression (N), 'X');
Set_Statement_Entry;
Current_Dominant := No_Dominant;
-- Extended return statement
......@@ -1367,7 +1422,10 @@ package body Par_SCO is
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.
......@@ -1391,6 +1449,10 @@ package body Par_SCO is
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,7 +1464,13 @@ package body Par_SCO is
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
......@@ -1580,7 +1648,10 @@ package body Par_SCO is
-- 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 @@ package body Par_SCO is
-- 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;
......
gcc/ada/put_scos.adb
......@@ -133,9 +133,9 @@ begin
begin
case T.C1 is
-- Statements
-- Statements (and dominance markers)
when 'S' =>
when 'S' | '>' =>
Ctr := 0;
Continuation := False;
loop
......@@ -161,9 +161,15 @@ begin
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 @@ begin
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,
......@@ -194,19 +208,12 @@ begin
<<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' =>
......
gcc/ada/s-oscons-tmplt.c
......@@ -1343,7 +1343,13 @@ CST(Inet_Pton_Linkname, "")
*/
#ifdef CLOCK_REALTIME
/* Note: On HP-UX, CLOCK_REALTIME is an enum, not a macro. */
#if defined(CLOCK_REALTIME) || defined (__hpux__)
# define HAVE_CLOCK_REALTIME
#endif
#ifdef HAVE_CLOCK_REALTIME
CND(CLOCK_REALTIME, "System realtime clock")
#endif
......@@ -1377,7 +1383,7 @@ CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
# define NEED_PTHREAD_CONDATTR_SETCLOCK
#elif defined(CLOCK_REALTIME)
#elif defined(HAVE_CLOCK_REALTIME)
/* By default use CLOCK_REALTIME */
# define CLOCK_RT_Ada "CLOCK_REALTIME"
#endif
......
gcc/ada/scos.ads
......@@ -135,14 +135,14 @@ package SCOs is
-- 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 @@ package SCOs is
-- 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 @@ package SCOs is
-- 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 @@ package SCOs is
-- 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 = ' '
......
gcc/ada/sem_ch3.adb
......@@ -12820,14 +12820,15 @@ package body Sem_Ch3 is
Iface_Subp := Node (Prim_Elmt);
-- Exclude derivation of predefined primitives except those
-- that come from source. Required to catch declarations of
-- equality operators of interfaces. For example:
-- that come from source, or are inherited from one that comes
-- from source. Required to catch declarations of equality
-- operators of interfaces. For example:
-- type Iface is interface;
-- function "=" (Left, Right : Iface) return Boolean;
if not Is_Predefined_Dispatching_Operation (Iface_Subp)
or else Comes_From_Source (Iface_Subp)
or else Comes_From_Source (Ultimate_Alias (Iface_Subp))
then
E := Find_Primitive_Covering_Interface
(Tagged_Type => Tagged_Type,
......
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