diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/get_scos.adb | 91 | ||||
| -rw-r--r-- | gcc/ada/par_sco.adb | 143 | ||||
| -rw-r--r-- | gcc/ada/put_scos.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/s-oscons-tmplt.c | 10 | ||||
| -rw-r--r-- | gcc/ada/scos.ads | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 7 |
7 files changed, 237 insertions, 94 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b7ac191..d546da6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +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> diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index 923eb35..47af1b2 100644 --- a/gcc/ada/get_scos.adb +++ b/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,39 +282,54 @@ begin -- 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; - - 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; + case Typ is + when '>' => + -- A dominance marker may be present only at an entry + -- point. + + pragma Assert (Key = 'S'); + + Key := '>'; + Typ := Nextc; + + when '1' .. '9' => + Typ := ' '; + + 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 if; + end case; - Get_Source_Location_Range (Loc1, Loc2); + 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; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index f361a9c..cffb76b 100644 --- a/gcc/ada/par_sco.adb +++ b/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; diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 1ff3cb3..ec25981 100644 --- a/gcc/ada/put_scos.adb +++ b/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; - 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 @@ 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' => diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 3d70ceb..e8a3b4d 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/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 diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 904c6bf..1f13e62 100644 --- a/gcc/ada/scos.ads +++ b/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 = ' ' diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e7b5327..d94b94a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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, |