diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-12-05 11:15:35 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-12-05 11:15:35 +0000 |
commit | 29b6ba3e1646dc62b2a7d8e8b94004b8f7db7222 (patch) | |
tree | c11a325254c0fff96f54a201f14e401c959ece35 | |
parent | c826347acfa81044d3222bb4531f57527334848a (diff) | |
download | gcc-29b6ba3e1646dc62b2a7d8e8b94004b8f7db7222.tar.gz |
2012-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
get_scos.adb: Generation of SCOs for aspects.
2012-12-05 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb (Check_Precondition_Postcondition): Remove
redundant call to Set_SCO_Pragma_Enabled (the pragma will be
rewritten into a pragma Check later on, and the call will be
made when processing the rewritten pragma).
(Analyze_Pragma, case Pragma_Check): Omit call to
Set_SCO_Pragma_Enabled if Split_PPC is set.
2012-12-05 Olivier Hainque <hainque@adacore.com>
* tracebak.c: Add partial support for Lynx178.
2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Analyze_Attribute): Improve
the error message related to loop assertions.
2012-12-05 Gary Dismukes <dismukes@adacore.com>
* atree.ads: Minor reformatting.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@194211 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
-rw-r--r-- | gcc/ada/atree.ads | 2 | ||||
-rw-r--r-- | gcc/ada/get_scos.adb | 68 | ||||
-rw-r--r-- | gcc/ada/par_sco.adb | 265 | ||||
-rw-r--r-- | gcc/ada/put_scos.adb | 89 | ||||
-rw-r--r-- | gcc/ada/put_scos.ads | 8 | ||||
-rw-r--r-- | gcc/ada/scos.ads | 52 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 3 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 9 | ||||
-rw-r--r-- | gcc/ada/tracebak.c | 21 |
10 files changed, 375 insertions, 169 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c0e6d1aa15e..c323d7cf4aa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2012-12-05 Thomas Quinot <quinot@adacore.com> + + * par_sco.adb, scos.ads, put_scos.adb, put_scos.ads, + get_scos.adb: Generation of SCOs for aspects. + +2012-12-05 Thomas Quinot <quinot@adacore.com> + + * sem_prag.adb (Check_Precondition_Postcondition): Remove + redundant call to Set_SCO_Pragma_Enabled (the pragma will be + rewritten into a pragma Check later on, and the call will be + made when processing the rewritten pragma). + (Analyze_Pragma, case Pragma_Check): Omit call to + Set_SCO_Pragma_Enabled if Split_PPC is set. + +2012-12-05 Olivier Hainque <hainque@adacore.com> + + * tracebak.c: Add partial support for Lynx178. + +2012-12-05 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Improve + the error message related to loop assertions. + +2012-12-05 Gary Dismukes <dismukes@adacore.com> + + * atree.ads: Minor reformatting. + 2012-12-05 Robert Dewar <dewar@adacore.com> * atree.ads, par-ch4.adb, sem_attr.adb, sem_ch13.adb: Minor diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index e685ead0049..d503dc2a660 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -107,7 +107,7 @@ package Atree is -- Note: the required parentheses surrounding conditional -- and quantified expressions count as a level of parens - -- for this purposes, so e.g. in X := (if A then B else C); + -- for this purpose, so e.g. in X := (if A then B else C); -- Paren_Count for the right side will be 1. -- Comes_From_Source diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index 4fb00102929..0020bea0868 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -28,8 +28,8 @@ pragma Ada_2005; -- read SCO information from ALI files (Xcov and sco_test). Ada 2005 -- constructs may therefore be used freely (and are indeed). +with Namet; use Namet; with SCOs; use SCOs; -with Snames; use Snames; with Types; use Types; with Ada.IO_Exceptions; use Ada.IO_Exceptions; @@ -203,6 +203,8 @@ procedure Get_SCOs is N : Natural; -- Scratch buffer, and index into it + Nam : Name_Id; + -- Start of processing for Get_Scos begin @@ -308,7 +310,6 @@ begin declare Typ : Character; Key : Character; - Pid : Pragma_Id; begin Key := 'S'; @@ -327,7 +328,7 @@ begin -- Loop through items on one line loop - Pid := Unknown_Pragma; + Nam := No_Name; Typ := Nextc; case Typ is @@ -348,25 +349,16 @@ begin Skipc; if Typ = 'P' or else Typ = 'p' then if Nextc not in '1' .. '9' then - N := 1; + Name_Len := 0; loop - Buf (N) := Getc; + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Getc; exit when Nextc = ':'; - N := N + 1; end loop; - Skipc; - - begin - Pid := - Pragma_Id'Value ("pragma_" & Buf (1 .. N)); - exception - when Constraint_Error => + Skipc; -- Past ':' - -- Pid remains set to Unknown_Pragma - - null; - end; + Nam := Name_Find; end if; end if; end case; @@ -379,13 +371,13 @@ begin end if; SCO_Table.Append - ((C1 => Key, - C2 => Typ, - From => Loc1, - To => Loc2, - Last => At_EOL, - Pragma_Sloc => No_Location, - Pragma_Name => Pid)); + ((C1 => Key, + C2 => Typ, + From => Loc1, + To => Loc2, + Last => At_EOL, + Pragma_Sloc => No_Location, + Pragma_Aspect_Name => Nam)); if Key = '>' then Key := 'S'; @@ -397,8 +389,21 @@ begin -- Decision entry - when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' => + when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' => Dtyp := C; + + if C = 'A' then + Name_Len := 0; + while Nextc /= ' ' loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Getc; + end loop; + Nam := Name_Find; + + else + Nam := No_Name; + end if; + Skip_Spaces; -- Output header @@ -416,12 +421,13 @@ begin end if; SCO_Table.Append - ((C1 => Dtyp, - C2 => ' ', - From => Loc, - To => No_Source_Location, - Last => False, - others => <>)); + ((C1 => Dtyp, + C2 => ' ', + From => Loc, + To => No_Source_Location, + Last => False, + Pragma_Aspect_Name => Nam, + others => <>)); end; -- Loop through terms in complex expression diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 2fdd6c5e8e9..4ce6951a755 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Errout; use Errout; @@ -125,13 +126,13 @@ package body Par_SCO is -- Calls above procedure for each element of the list L procedure Set_Table_Entry - (C1 : Character; - C2 : Character; - From : Source_Ptr; - To : Source_Ptr; - Last : Boolean; - Pragma_Sloc : Source_Ptr := No_Location; - Pragma_Name : Pragma_Id := Unknown_Pragma); + (C1 : Character; + C2 : Character; + From : Source_Ptr; + To : Source_Ptr; + Last : Boolean; + Pragma_Sloc : Source_Ptr := No_Location; + Pragma_Aspect_Name : Name_Id := No_Name); -- Append an entry to SCO_Table with fields set as per arguments type Dominant_Info is record @@ -487,15 +488,22 @@ package body Par_SCO is Loc : Source_Ptr := No_Location; -- Node whose Sloc is used for the decision + Nam : Name_Id := No_Name; + -- For the case of an aspect, aspect name + begin case T is - when 'I' | 'E' | 'W' => + when 'I' | 'E' | 'W' | 'a' => - -- For IF, EXIT, WHILE, the token SLOC can be found from - -- the SLOC of the parent of the expression. + -- For IF, EXIT, WHILE, or aspects, the token SLOC is that of + -- the parent of the expression. Loc := Sloc (Parent (N)); + if T = 'a' then + Nam := Chars (Identifier (Parent (N))); + end if; + when 'G' | 'P' => -- For entry guard, the token sloc is from the N_Entry_Body. @@ -533,12 +541,20 @@ package body Par_SCO is end case; Set_Table_Entry - (C1 => T, - C2 => ' ', - From => Loc, - To => No_Location, - Last => False, - Pragma_Sloc => Pragma_Sloc); + (C1 => T, + C2 => ' ', + From => Loc, + To => No_Location, + Last => False, + Pragma_Sloc => Pragma_Sloc, + Pragma_Aspect_Name => Nam); + + -- For an aspect specification, which will be rewritten into a + -- pragma, enter a hash table entry now. + + if T = 'a' then + Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last); + end if; end Output_Header; ------------------------------ @@ -731,6 +747,8 @@ package body Par_SCO is procedure Populate_SCO_Instance_Table is new Sinput.Iterate_On_Instances (Record_Instance); + SCO_Index : Nat; + begin if Debug_Flag_Dot_OO then dsco; @@ -796,6 +814,24 @@ package body Par_SCO is end; end loop; + -- Stamp out SCO entries for decisions in disabled constructs (pragmas + -- or aspects). + + SCO_Index := 1; + while SCO_Index <= SCO_Table.Last loop + if Is_Decision (SCO_Table.Table (SCO_Index).C1) + and then SCO_Pragma_Disabled + (SCO_Table.Table (SCO_Index).Pragma_Sloc) + then + loop + SCO_Table.Table (SCO_Index).C1 := ASCII.NUL; + exit when SCO_Table.Table (SCO_Index).Last; + SCO_Index := SCO_Index + 1; + end loop; + end if; + SCO_Index := SCO_Index + 1; + end loop; + -- Now the tables are all setup for output to the ALI file Write_SCOs_To_ALI_File; @@ -824,8 +860,30 @@ package body Par_SCO is declare T : SCO_Table_Entry renames SCO_Table.Table (Index); begin - pragma Assert (T.C1 = 'S'); - return T.C2 = 'p'; + case T.C1 is + when 'S' => + -- Pragma statement + + return T.C2 = 'p'; + + when 'A' => + -- Aspect decision (enabled) + + return False; + + when 'a' => + -- Aspect decision (not enabled) + + return True; + + when ASCII.NUL => + -- Nullified disabled SCO + + return True; + + when others => + raise Program_Error; + end case; end; else @@ -976,13 +1034,28 @@ package body Par_SCO is T : SCO_Table_Entry renames SCO_Table.Table (Index); begin - -- Called multiple times for the same sloc (need to allow for - -- C2 = 'P') ??? + -- Note: may be called multiple times for the same sloc, so + -- account for the fact that the entry may already have been + -- marked enabled. + + case T.C1 is + -- Aspect (decision SCO) + + when 'a' => + T.C1 := 'A'; - pragma Assert (T.C1 = 'S' - and then - (T.C2 = 'p' or else T.C2 = 'P')); - T.C2 := 'P'; + when 'A' => + null; + + -- Pragma (statement SCO) + + when 'S' => + pragma Assert (T.C2 = 'p' or else T.C2 = 'P'); + T.C2 := 'P'; + + when others => + raise Program_Error; + end case; end; end if; end Set_SCO_Pragma_Enabled; @@ -992,23 +1065,23 @@ package body Par_SCO is --------------------- procedure Set_Table_Entry - (C1 : Character; - C2 : Character; - From : Source_Ptr; - To : Source_Ptr; - Last : Boolean; - Pragma_Sloc : Source_Ptr := No_Location; - Pragma_Name : Pragma_Id := Unknown_Pragma) + (C1 : Character; + C2 : Character; + From : Source_Ptr; + To : Source_Ptr; + Last : Boolean; + Pragma_Sloc : Source_Ptr := No_Location; + Pragma_Aspect_Name : Name_Id := No_Name) is begin 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)); + ((C1 => C1, + C2 => C2, + From => To_Source_Location (From), + To => To_Source_Location (To), + Last => Last, + Pragma_Sloc => Pragma_Sloc, + Pragma_Aspect_Name => Pragma_Aspect_Name)); end Set_Table_Entry; ------------------------ @@ -1133,6 +1206,9 @@ package body Par_SCO is procedure Traverse_One (N : Node_Id); -- Traverse one declaration or statement + procedure Traverse_Aspects (N : Node_Id); + -- Helper for Traverse_One: traverse N's aspect specifications + ------------------------- -- Set_Statement_Entry -- ------------------------- @@ -1156,21 +1232,21 @@ package body Par_SCO is 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); + (C1 => '>', + C2 => Current_Dominant.K, + From => From, + To => To, + Last => False, + Pragma_Sloc => No_Location, + Pragma_Aspect_Name => No_Name); end; end if; end if; declare - SCE : SC_Entry renames SC.Table (J); - Pragma_Sloc : Source_Ptr := No_Location; - Pragma_Name : Pragma_Id := Unknown_Pragma; + SCE : SC_Entry renames SC.Table (J); + Pragma_Sloc : Source_Ptr := No_Location; + Pragma_Aspect_Name : Name_Id := No_Name; 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 @@ -1181,20 +1257,22 @@ 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)); + Pragma_Aspect_Name := Pragma_Name (SCE.N); + pragma Assert (Pragma_Aspect_Name /= No_Name); elsif SCE.Typ = 'P' then - Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N)); + Pragma_Aspect_Name := Pragma_Name (SCE.N); + pragma Assert (Pragma_Aspect_Name /= No_Name); end if; Set_Table_Entry - (C1 => 'S', - C2 => SCE.Typ, - From => SCE.From, - To => SCE.To, - Last => (J = SC_Last), - Pragma_Sloc => Pragma_Sloc, - Pragma_Name => Pragma_Name); + (C1 => 'S', + C2 => SCE.Typ, + From => SCE.From, + To => SCE.To, + Last => (J = SC_Last), + Pragma_Sloc => Pragma_Sloc, + Pragma_Aspect_Name => Pragma_Aspect_Name); end; end loop; @@ -1293,6 +1371,76 @@ package body Par_SCO is SD.Append ((Empty, L, T, Current_Pragma_Sloc)); end Process_Decisions_Defer; + ---------------------- + -- Traverse_Aspects -- + ---------------------- + + procedure Traverse_Aspects (N : Node_Id) is + AN : Node_Id; + AE : Node_Id; + + begin + AN := First (Aspect_Specifications (N)); + while Present (AN) loop + AE := Expression (AN); + + case Get_Aspect_Id (Chars (Identifier (AN))) is + + -- Aspects rewritten into pragmas controlled by a Check_Policy: + -- Current_Pragma_Sloc must be set to the sloc of the aspect + -- specification. The corresponding pragma will have the same + -- sloc. + + when Aspect_Pre | + Aspect_Precondition | + Aspect_Post | + Aspect_Postcondition => + + -- SCOs are generated before semantic analysis/expansion: + -- PPCs are not split yet. + + pragma Assert (not Split_PPC (AN)); + + -- A Pre/Post aspect will be rewritten into a pragma + -- Precondition/Postcondition with the same sloc. + + pragma Assert (Current_Pragma_Sloc = No_Location); + + Current_Pragma_Sloc := Sloc (AN); + + -- Create the decision as potentially disabled aspect ('a'). + -- Set_SCO_Pragma_Enabled will subsequently switch to 'A'. + + Process_Decisions_Defer (AE, 'a'); + Current_Pragma_Sloc := No_Location; + + -- Aspects whose checks are generated in client units, + -- regardless of whether or not the check is activated in the + -- unit which contains the declaration. + + when Aspect_Predicate | + Aspect_Static_Predicate | + Aspect_Dynamic_Predicate | + Aspect_Invariant | + Aspect_Type_Invariant => + + Process_Decisions_Defer (AE, 'A'); + + -- Other aspects: just process any decision nested in the + -- aspect expression. + + when others => + + if Has_Decision (AE) then + Process_Decisions_Defer (AE, 'X'); + end if; + + end case; + + Next (AN); + end loop; + end Traverse_Aspects; + ------------------ -- Traverse_One -- ------------------ @@ -1825,6 +1973,9 @@ package body Par_SCO is end if; end case; + -- Process aspects if present + + Traverse_Aspects (N); end Traverse_One; -- Start of processing for Traverse_Declarations_Or_Statements diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 05184d7a985..e9b03fc8294 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -23,10 +23,9 @@ -- -- ------------------------------------------------------------------------------ +with Namet; use Namet; with Opt; use Opt; -with Par_SCO; use Par_SCO; with SCOs; use SCOs; -with Snames; use Snames; procedure Put_SCOs is Current_SCO_Unit : SCO_Unit_Index := 0; @@ -195,18 +194,10 @@ begin if Sent.C1 = 'S' and then (Sent.C2 = 'P' or else Sent.C2 = 'p') - and then Sent.Pragma_Name /= Unknown_Pragma + and then Sent.Pragma_Aspect_Name /= No_Name then - -- Strip leading "PRAGMA_" - - declare - Pnam : constant String := - Sent.Pragma_Name'Img; - begin - Output_String - (Pnam (Pnam'First + 7 .. Pnam'Last)); - Write_Info_Char (':'); - end; + Write_Info_Name (Sent.Pragma_Aspect_Name); + Write_Info_Char (':'); end if; end if; @@ -240,57 +231,55 @@ begin -- Decision - when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' => + when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' => Start := Start + 1; - -- For disabled pragma, or nested decision therein, skip - -- decision output. + Write_SCO_Initiate (U); + Write_Info_Char (T.C1); - if SCO_Pragma_Disabled (T.Pragma_Sloc) then - while not SCO_Table.Table (Start).Last loop - Start := Start + 1; - end loop; + if T.C1 = 'A' then + Write_Info_Name (T.Pragma_Aspect_Name); + end if; + + if T.C1 /= 'X' then + Write_Info_Char (' '); + Output_Source_Location (T.From); + end if; - -- For all other cases output decision line + -- Loop through table entries for this decision - else - Write_SCO_Initiate (U); - Write_Info_Char (T.C1); + loop + declare + T : SCO_Table_Entry + renames SCO_Table.Table (Start); - if T.C1 /= 'X' then + begin Write_Info_Char (' '); - Output_Source_Location (T.From); - end if; - -- Loop through table entries for this decision + if T.C1 = '!' or else + T.C1 = '&' or else + T.C1 = '|' + then + Write_Info_Char (T.C1); + Output_Source_Location (T.From); - loop - declare - T : SCO_Table_Entry - renames SCO_Table.Table (Start); + else + Write_Info_Char (T.C2); + Output_Range (T); + end if; - begin - Write_Info_Char (' '); + exit when T.Last; + Start := Start + 1; + end; + end loop; - if T.C1 = '!' or else - T.C1 = '&' or else - T.C1 = '|' - then - Write_Info_Char (T.C1); - Output_Source_Location (T.From); + Write_Info_Terminate; - else - Write_Info_Char (T.C2); - Output_Range (T); - end if; + when ASCII.NUL => - exit when T.Last; - Start := Start + 1; - end; - end loop; + -- Nullified entry: skip - Write_Info_Terminate; - end if; + null; when others => raise Program_Error; diff --git a/gcc/ada/put_scos.ads b/gcc/ada/put_scos.ads index d8d77202b7d..323e6528458 100644 --- a/gcc/ada/put_scos.ads +++ b/gcc/ada/put_scos.ads @@ -2,11 +2,11 @@ -- -- -- GNAT COMPILER COMPONENTS -- -- -- --- P U T _ S C O S -- +-- P U T _ S C O S -- -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -28,6 +28,7 @@ -- the ALI file. The interface allows control over the destination of the -- output, so that this routine can also be used for debugging purposes. +with Namet; use Namet; with Types; use Types; generic @@ -43,6 +44,9 @@ generic -- Initiates write of new line to output file, the parameter is the -- keyword character for the line. + with procedure Write_Info_Name (Nam : Name_Id) is <>; + -- Outputs one name + with procedure Write_Info_Nat (N : Nat) is <>; -- Writes image of N to output file with no leading or trailing blanks diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 076a66ef3c9..0082099afb4 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -28,11 +28,8 @@ -- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that -- is used in the ALI file. -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 Namet; use Namet; +with Types; use Types; with GNAT.Table; @@ -248,18 +245,21 @@ package SCOs is -- C* sloc expression - -- Here * is one of the following characters: + -- Here * is one of the following: - -- E decision in EXIT WHEN statement - -- G decision in entry guard - -- I decision in IF statement or if expression - -- P decision in pragma Assert/Check/Pre_Condition/Post_Condition - -- W decision in WHILE iteration scheme - -- X decision appearing in some other expression context + -- E decision in EXIT WHEN statement + -- G decision in entry guard + -- I decision in IF statement or if expression + -- P decision in pragma Assert / Check / Pre/Post_Condition + -- A[name] decision in aspect Pre/Post (aspect name optional) + -- W decision in WHILE iteration scheme + -- X decision in some other expression context -- For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF, -- PRAGMA or WHILE token, respectively + -- For A sloc is the source location of the aspect identifier + -- For X, sloc is omitted -- The expression is a prefix polish form indicating the structure of @@ -369,10 +369,12 @@ package SCOs is 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). + -- control of SCO output, value not recorded in ALI file). For the + -- decision SCO for an aspect, or for any expression SCO nested in an + -- aspect, location of aspect identifier token (likewise). - Pragma_Name : Pragma_Id := Unknown_Pragma; - -- For the statement SCO for a pragma, gives the pragma name + Pragma_Aspect_Name : Name_Id := No_Name; + -- For the SCO for a pragma/aspect, gives the pragma/apsect name end record; package SCO_Table is new GNAT.Table ( @@ -382,6 +384,11 @@ package SCOs is Table_Initial => 500, Table_Increment => 300); + Is_Decision : constant array (Character) of Boolean := + ('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True, + others => False); + -- Indicates which C1 values correspond to decisions + -- The SCO_Table_Entry values appear as follows: -- Statements @@ -432,7 +439,20 @@ package SCOs is -- SCO contexts, the only pragmas with decisions are Assert, Check, -- dyadic Debug, Precondition and Postcondition). These entries will -- be omitted in output if the pragma is disabled (see comments for - -- statement entries). + -- statement entries). This is achieved by setting C1 to NUL for all + -- SCO entries of the decision. + + -- Decision (ASPECT) + -- C1 = 'A' + -- C2 = ' ' + -- From = aspect identifier + -- To = No_Source_Location + -- Last = unused + + -- Note: when the parse tree is first scanned, we unconditionally build a + -- pragma decision entry for any decision in an aspect (Pre/Post/ + -- [Type_]Invariant/[Static_|Dynamic_]Predicate). Entries for disabled + -- Pre/Post aspects will be omitted from output. -- Decision (Expression) -- C1 = 'X' diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 836c278621e..94cbd9e730a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3847,7 +3847,8 @@ package body Sem_Attr is if not In_Loop_Assertion then Error_Attr - ("attribute % must appear within pragma Loop_Assertion", N); + ("attribute % must appear within pragma Loop_Variant or " & + "Loop_Invariant", N); end if; -- A Loop_Entry that applies to a given loop statement shall not diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index ec7f3b95d97..ddd84822ce1 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2181,13 +2181,6 @@ package body Sem_Prag is (Get_Pragma_Arg (Arg2), Standard_String); end if; - -- For a pragma in the extended main source unit, record enabled - -- status in SCO (note: there is never any SCO for an instance). - - if Check_Enabled (Pname) then - Set_SCO_Pragma_Enabled (Loc); - end if; - -- If we are within an inlined body, the legality of the pragma -- has been checked already. @@ -7407,7 +7400,7 @@ package body Sem_Prag is Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1))); - if Check_On then + if Check_On and then not Split_PPC (N) then Set_SCO_Pragma_Enabled (Loc); end if; diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c index 2c8335de68b..01b96548baf 100644 --- a/gcc/ada/tracebak.c +++ b/gcc/ada/tracebak.c @@ -287,9 +287,10 @@ __gnat_backtrace (void **array, #error Unhandled darwin architecture. #endif -/*------------------------ PPC AIX/Older Darwin -------------------------*/ +/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/ #elif ((defined (_POWER) && defined (_AIX)) || \ -(defined (__ppc__) && defined (__APPLE__))) + (defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \ + (defined (__ppc__) && defined (__APPLE__))) #define USE_GENERIC_UNWINDER @@ -307,9 +308,23 @@ struct layout should to feature a null backchain, AIX might expose a null return address instead. */ +/* Then LynxOS-178 features yet another variation, with return_address + == &__start, which we only add conditionally as this symbol is not + necessarily present elsewhere. Beware that &bla returns the + address of a descriptor when "bla" is a function. Getting the code + address requires an extra dereference. */ + +#if defined (__Lynx__) +extern void __start(); +#define EXTRA_STOP_CONDITION(CURRENT) ((CURRENT)->return_address == *(void**)&__start) +#else +#define EXTRA_STOP_CONDITION(CURRENT) (0) +#endif + #define STOP_FRAME(CURRENT, TOP_STACK) \ (((void *) (CURRENT) < (TOP_STACK)) \ - || (CURRENT)->return_address == NULL) + || (CURRENT)->return_address == NULL \ + || EXTRA_STOP_CONDITION(CURRENT)) /* The PPC ABI has an interesting specificity: the return address saved by a function is located in it's caller's frame, and the save operation only |