From f280dd8f6d4e3f95357707c3064253cb87698b66 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 22 May 2015 12:53:21 +0000 Subject: [PATCH] exp_ch5.adb, [...]: This is a general change that deals with the fact that most of the special... 2015-05-22 Robert Dewar * exp_ch5.adb, layout.adb, einfo.adb, einfo.ads, sem_prag.adb, freeze.adb, freeze.ads, sem_util.adb, sem_util.ads, exp_ch2.adb, exp_ch4.adb, errout.adb, exp_aggr.adb, sem_ch13.adb: This is a general change that deals with the fact that most of the special coding for Atomic should also apply to the case of Volatile_Full_Access. A new attribute Is_Atomic_Or_VFA is introduced, and many of the references to Is_Atomic now use this new attribute. From-SVN: r223560 --- gcc/ada/ChangeLog | 10 +++++++++ gcc/ada/einfo.adb | 9 ++++++++ gcc/ada/einfo.ads | 14 ++++++++++++ gcc/ada/errout.adb | 10 +++++++++ gcc/ada/exp_aggr.adb | 8 +++---- gcc/ada/exp_ch2.adb | 5 +++-- gcc/ada/exp_ch4.adb | 4 ++-- gcc/ada/exp_ch5.adb | 12 +++++----- gcc/ada/freeze.adb | 53 ++++++++++++++++++++++++-------------------- gcc/ada/freeze.ads | 9 ++++---- gcc/ada/layout.adb | 44 +++++++++++++++++++++++++----------- gcc/ada/sem_ch13.adb | 25 ++++++++++++++++++++- gcc/ada/sem_prag.adb | 18 +++++++-------- gcc/ada/sem_util.adb | 14 ++++++++++++ gcc/ada/sem_util.ads | 4 ++++ 15 files changed, 173 insertions(+), 66 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7105a7a1ea4..569402443fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2015-05-22 Robert Dewar + + * exp_ch5.adb, layout.adb, einfo.adb, einfo.ads, sem_prag.adb, + freeze.adb, freeze.ads, sem_util.adb, sem_util.ads, exp_ch2.adb, + exp_ch4.adb, errout.adb, exp_aggr.adb, sem_ch13.adb: This is a general + change that deals with the fact that most of the special coding for + Atomic should also apply to the case of Volatile_Full_Access. + A new attribute Is_Atomic_Or_VFA is introduced, and many of the + references to Is_Atomic now use this new attribute. + 2015-05-22 Robert Dewar * exp_ch4.adb (Expand_N_Op_Eq): Introduce 'Machine for 'Result diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 9b7cced24cb..9de5ce9c259 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -7329,6 +7329,15 @@ package body Einfo is end if; end Invariant_Procedure; + ---------------------- + -- Is_Atomic_Or_VFA -- + ---------------------- + + function Is_Atomic_Or_VFA (Id : E) return B is + begin + return Is_Atomic (Id) or else Has_Volatile_Full_Access (Id); + end Is_Atomic_Or_VFA; + ------------------ -- Is_Base_Type -- ------------------ diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 76a8ff7e098..38a6c16cad8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2218,6 +2218,14 @@ package Einfo is -- In the case of private and incomplete types, this flag is set in -- both the partial view and the full view. +-- Is_Atomic_Or_VFA (synth) +-- Defined in all type entities, and also in constants, components and +-- variables. Set if a pragma Atomic or Shared or Volatile_Full_Access +-- applies to the entity. For many purposes VFA objects should be treated +-- the same as Atomic objects, and this predicate is intended for that +-- usage. In the case of private and incomplete types, the predicate +-- applies to both the partial view and the full view. + -- Is_Array_Type (synthesized) -- Applies to all entities, true for array types and subtypes @@ -5476,6 +5484,7 @@ package Einfo is -- Implementation_Base_Type (synth) -- Invariant_Procedure (synth) -- Is_Access_Protected_Subprogram_Type (synth) + -- Is_Atomic_Or_VFA (synth) -- Predicate_Function (synth) -- Predicate_Function_M (synth) -- Root_Type (synth) @@ -5628,6 +5637,7 @@ package Einfo is -- Is_Tag (Flag78) -- Is_Volatile (Flag16) -- Treat_As_Volatile (Flag41) + -- Is_Atomic_Or_VFA (synth) -- Next_Component (synth) -- Next_Component_Or_Discriminant (synth) @@ -5676,6 +5686,7 @@ package Einfo is -- Treat_As_Volatile (Flag41) -- Address_Clause (synth) -- Alignment_Clause (synth) + -- Is_Atomic_Or_VFA (synth) -- Size_Clause (synth) -- E_Decimal_Fixed_Point_Type @@ -6413,6 +6424,7 @@ package Einfo is -- Treat_As_Volatile (Flag41) -- Address_Clause (synth) -- Alignment_Clause (synth) + -- Is_Atomic_Or_VFA (synth) -- Size_Clause (synth) -- E_Void @@ -6869,6 +6881,7 @@ package Einfo is function Is_Aliased (Id : E) return B; function Is_Asynchronous (Id : E) return B; function Is_Atomic (Id : E) return B; + function Is_Atomic_Or_VFA (Id : E) return B; function Is_Bit_Packed_Array (Id : E) return B; function Is_Called (Id : E) return B; function Is_Character_Type (Id : E) return B; @@ -9041,6 +9054,7 @@ package Einfo is -- be handled by xeinfo. pragma Inline (Base_Type); + pragma Inline (Is_Atomic_Or_VFA); pragma Inline (Is_Base_Type); pragma Inline (Is_Package_Or_Generic_Package); pragma Inline (Is_Packed_Array); diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index d236bb53c54..9ad887c0130 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -3159,6 +3159,16 @@ package body Errout is return True; end if; + -- Similar processing for "volatile full access cannot be guaranteed" + + elsif Msg = "volatile full access to & cannot be guaranteed" then + if Is_Type (E) + and then Has_Volatile_Full_Access (E) + and then No (Get_Rep_Pragma (E, Name_Volatile_Full_Access)) + then + return True; + end if; + -- Processing for "Size too small" messages elsif Msg = "size for& too small, minimum allowed is ^" then diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index b53b28febf5..70f49688b86 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4175,7 +4175,7 @@ package body Exp_Aggr is Ctyp := Component_Type (Ctyp); - if Is_Atomic (Ctyp) then + if Is_Atomic_Or_VFA (Ctyp) then return False; end if; end loop; @@ -5935,15 +5935,15 @@ package body Exp_Aggr is -- Start of processing for Expand_Record_Aggregate begin - -- If the aggregate is to be assigned to an atomic variable, we have + -- If the aggregate is to be assigned to an atomic/VFA variable, we have -- to prevent a piecemeal assignment even if the aggregate is to be -- expanded. We create a temporary for the aggregate, and assign the -- temporary instead, so that the back end can generate an atomic move -- for it. - if Is_Atomic (Typ) + if Is_Atomic_Or_VFA (Typ) and then Comes_From_Source (Parent (N)) - and then Is_Atomic_Aggregate (N, Typ) + and then Is_Atomic_VFA_Aggregate (N, Typ) then return; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index 0aa7878464e..b926e102d3b 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -396,7 +396,8 @@ package body Exp_Ch2 is Write_Eol; end if; - -- Set Atomic_Sync_Required if necessary for atomic variable + -- Set Atomic_Sync_Required if necessary for atomic variable. Note that + -- this processing does NOT apply to Volatile_Full_Access variables. if Nkind_In (N, N_Identifier, N_Expanded_Name) and then Ekind (E) = E_Variable diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index df73482a4d5..0ef690b0f93 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7313,12 +7313,12 @@ package body Exp_Ch4 is -- Where the component type is elementary we can use a block bit -- comparison (if supported on the target) exception in the case -- of floating-point (negative zero issues require element by - -- element comparison), and atomic types (where we must be sure + -- element comparison), and atomic/VFA types (where we must be sure -- to load elements independently) and possibly unaligned arrays. elsif Is_Elementary_Type (Component_Type (Typl)) and then not Is_Floating_Point_Type (Component_Type (Typl)) - and then not Is_Atomic (Component_Type (Typl)) + and then not Is_Atomic_Or_VFA (Component_Type (Typl)) and then not Is_Possibly_Unaligned_Object (Lhs) and then not Is_Possibly_Unaligned_Object (Rhs) and then Support_Composite_Compare_On_Target diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index d88016f8921..145da2cf977 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -429,11 +429,11 @@ package body Exp_Ch5 is elsif Has_Controlled_Component (L_Type) then Loop_Required := True; - -- If object is atomic, we cannot tolerate a loop + -- If object is atomic/VFA, we cannot tolerate a loop - elsif Is_Atomic_Object (Act_Lhs) + elsif Is_Atomic_Or_VFA_Object (Act_Lhs) or else - Is_Atomic_Object (Act_Rhs) + Is_Atomic_Or_VFA_Object (Act_Rhs) then return; @@ -442,8 +442,8 @@ package body Exp_Ch5 is elsif Has_Atomic_Components (L_Type) or else Has_Atomic_Components (R_Type) - or else Is_Atomic (Component_Type (L_Type)) - or else Is_Atomic (Component_Type (R_Type)) + or else Is_Atomic_Or_VFA (Component_Type (L_Type)) + or else Is_Atomic_Or_VFA (Component_Type (R_Type)) then Loop_Required := True; @@ -3395,7 +3395,7 @@ package body Exp_Ch5 is Next_Elmt (Prim); end loop; - -- default iterator must exist. + -- Default iterator must exist pragma Assert (False); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1c4615bbba2..ec37b4f0b8a 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -942,13 +942,13 @@ package body Freeze is Packed_Size_Known := False; end if; - -- We do not know the packed size if we have an atomic type + -- We do not know the packed size for an atomic/VFA type -- or component, or an independent type or component, or a -- by reference type or aliased component (because packing -- does not touch these). - if Is_Atomic (Ctyp) - or else Is_Atomic (Comp) + if Is_Atomic_Or_VFA (Ctyp) + or else Is_Atomic_Or_VFA (Comp) or else Is_Independent (Ctyp) or else Is_Independent (Comp) or else Is_By_Reference_Type (Ctyp) @@ -1036,11 +1036,11 @@ package body Freeze is and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Ctyp))) then - -- Packed size unknown if we have an atomic type - -- or a by reference type, since the back end - -- knows how these are layed out. + -- Packed size unknown if we have an atomic/VFA type + -- or a by reference type, since the back end knows + -- how these are layed out. - if Is_Atomic (Ctyp) + if Is_Atomic_Or_VFA (Ctyp) or else Is_By_Reference_Type (Ctyp) then Packed_Size_Known := False; @@ -1455,11 +1455,11 @@ package body Freeze is end loop; end Check_Unsigned_Type; - ------------------------- - -- Is_Atomic_Aggregate -- - ------------------------- + ----------------------------- + -- Is_Atomic_VFA_Aggregate -- + ----------------------------- - function Is_Atomic_Aggregate + function Is_Atomic_VFA_Aggregate (E : Entity_Id; Typ : Entity_Id) return Boolean is @@ -1495,7 +1495,7 @@ package body Freeze is else return False; end if; - end Is_Atomic_Aggregate; + end Is_Atomic_VFA_Aggregate; ----------------------------------------------- -- Explode_Initialization_Compound_Statement -- @@ -2423,12 +2423,12 @@ package body Freeze is end if; end; - -- Check for Aliased or Atomic_Components/Atomic with unsuitable - -- packing or explicit component size clause given. + -- Check for Aliased or Atomic_Components/Atomic/VFA with + -- unsuitable packing or explicit component size clause given. if (Has_Aliased_Components (Arr) or else Has_Atomic_Components (Arr) - or else Is_Atomic (Ctyp)) + or else Is_Atomic_Or_VFA (Ctyp)) and then (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) then @@ -2436,8 +2436,8 @@ package body Freeze is procedure Complain_CS (T : String); -- Outputs error messages for incorrect CS clause or pragma - -- Pack for aliased or atomic components (T is "aliased" or - -- "atomic"); + -- Pack for aliased or atomic/VFA components (T is "aliased" + -- or "atomic/vfa"); ----------------- -- Complain_CS -- @@ -2498,9 +2498,13 @@ package body Freeze is elsif Has_Aliased_Components (Arr) then Complain_CS ("aliased"); - elsif Has_Atomic_Components (Arr) or else Is_Atomic (Ctyp) + elsif Has_Atomic_Components (Arr) + or else Is_Atomic (Ctyp) then Complain_CS ("atomic"); + + elsif Has_Volatile_Full_Access (Ctyp) then + Complain_CS ("volatile full access"); end if; end Alias_Atomic_Check; end if; @@ -2509,8 +2513,8 @@ package body Freeze is -- packing or explicit component size clause given. if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp)) - and then - (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) + and then + (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) then begin -- If object size of component type isn't known, we cannot @@ -2772,7 +2776,7 @@ package body Freeze is -- For non-packed arrays set the alignment of the array to the -- alignment of the component type if it is unknown. Skip this - -- in atomic case (atomic arrays may need larger alignments). + -- in atomic/VFA case (atomic/VFA arrays may need larger alignments). if not Is_Packed (Arr) and then Unknown_Alignment (Arr) @@ -2780,7 +2784,7 @@ package body Freeze is and then Known_Static_Component_Size (Arr) and then Known_Static_Esize (Ctyp) and then Esize (Ctyp) = Component_Size (Arr) - and then not Is_Atomic (Arr) + and then not Is_Atomic_Or_VFA (Arr) then Set_Alignment (Arr, Alignment (Component_Type (Arr))); end if; @@ -4813,11 +4817,12 @@ package body Freeze is -- than component-wise (the assignment to the temp may be done -- component-wise, but that is harmless). - elsif Is_Atomic (E) + elsif Is_Atomic_Or_VFA (E) and then Nkind (Parent (E)) = N_Object_Declaration and then Present (Expression (Parent (E))) and then Nkind (Expression (Parent (E))) = N_Aggregate - and then Is_Atomic_Aggregate (Expression (Parent (E)), Etype (E)) + and then + Is_Atomic_VFA_Aggregate (Expression (Parent (E)), Etype (E)) then null; end if; diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads index e88acbf31d2..3179e4b1412 100644 --- a/gcc/ada/freeze.ads +++ b/gcc/ada/freeze.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -174,12 +174,11 @@ package Freeze is -- do not allow a size clause if the size would not otherwise be known at -- compile time in any case. - function Is_Atomic_Aggregate + function Is_Atomic_VFA_Aggregate (E : Entity_Id; Typ : Entity_Id) return Boolean; - - -- If an atomic object is initialized with an aggregate or is assigned an - -- aggregate, we have to prevent a piecemeal access or assignment to the + -- If an atomic/VFA object is initialized with an aggregate or is assigned + -- an aggregate, we have to prevent a piecemeal access or assignment to the -- object, even if the aggregate is to be expanded. We create a temporary -- for the aggregate, and assign the temporary instead, so that the back -- end can generate an atomic move for it. This is only done in the context diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 7721eefdd9d..c44941667ba 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2015, 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- -- @@ -2684,11 +2684,11 @@ package body Layout is elsif Is_Array_Type (E) then - -- For arrays that are required to be atomic, we do the same + -- For arrays that are required to be atomic/VFA, we do the same -- processing as described above for short records, since we -- really need to have the alignment set for the whole array. - if Is_Atomic (E) and then not Debug_Flag_Q then + if Is_Atomic_Or_VFA (E) and then not Debug_Flag_Q then Set_Composite_Alignment (E); end if; @@ -2903,11 +2903,19 @@ package body Layout is and then Is_Record_Type (E) and then Is_Packed (E) then - -- No effect for record with atomic components + -- No effect for record with atomic/VFA components - if Is_Atomic (E) then + if Is_Atomic_Or_VFA (E) then Error_Msg_N ("Optimize_Alignment has no effect for &??", E); - Error_Msg_N ("\pragma ignored for atomic record??", E); + + if Is_Atomic (E) then + Error_Msg_N + ("\pragma ignored for atomic record??", E); + else + Error_Msg_N + ("\pragma ignored for bolatile full access record??", E); + end if; + return; end if; @@ -2920,20 +2928,30 @@ package body Layout is return; end if; - -- No effect if any component is atomic or is a by reference type + -- No effect if any component is atomic/VFA or is a by reference type declare Ent : Entity_Id; + begin Ent := First_Component_Or_Discriminant (E); while Present (Ent) loop if Is_By_Reference_Type (Etype (Ent)) - or else Is_Atomic (Etype (Ent)) - or else Is_Atomic (Ent) + or else Is_Atomic_Or_VFA (Etype (Ent)) + or else Is_Atomic_Or_VFA (Ent) then Error_Msg_N ("Optimize_Alignment has no effect for &??", E); - Error_Msg_N - ("\pragma is ignored if atomic components present??", E); + + if Is_Atomic (Etype (Ent)) or else Is_Atomic (Ent) then + Error_Msg_N + ("\pragma is ignored if atomic " + & "components present??", E); + else + Error_Msg_N + ("\pragma is ignored if bolatile full access " + & "components present??", E); + end if; + return; else Next_Component_Or_Discriminant (Ent); @@ -3026,9 +3044,9 @@ package body Layout is -- Further processing for record types only to reduce the alignment -- set by the above processing in some specific cases. We do not - -- do this for atomic records, since we need max alignment there, + -- do this for atomic/VFA records, since we need max alignment there, - if Is_Record_Type (E) and then not Is_Atomic (E) then + if Is_Record_Type (E) and then not Is_Atomic_Or_VFA (E) then -- For records, there is generally no point in setting alignment -- higher than word size since we cannot do better than move by diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8a513833cb5..1afdd4d6992 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -965,6 +965,13 @@ package body Sem_Ch13 is Set_Is_Volatile (E); end if; + -- Volatile_Full_Access + + when Aspect_Volatile_Full_Access => + if Has_Volatile_Full_Access (P) then + Set_Has_Volatile_Full_Access (E); + end if; + -- Volatile_Components when Aspect_Volatile_Components => @@ -1057,6 +1064,11 @@ package body Sem_Ch13 is return; end if; + when Aspect_Volatile_Full_Access => + if not Has_Volatile_Full_Access (Par) then + return; + end if; + when others => return; end case; @@ -1066,7 +1078,6 @@ package body Sem_Ch13 is Error_Msg_Name_1 := A_Name; Error_Msg_NE ("derived type& inherits aspect%, cannot cancel", Expr, E); - end Check_False_Aspect_For_Derived_Type; -- Start of processing for Make_Pragma_From_Boolean_Aspect @@ -11164,6 +11175,18 @@ package body Sem_Ch13 is Set_Is_Volatile (Typ); end if; + -- Volatile_Full_Access + + if not Has_Rep_Item (Typ, Name_Volatile_Full_Access, False) + and then Has_Rep_Pragma (Typ, Name_Volatile_Full_Access) + and then Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item + (Get_Rep_Item (Typ, Name_Volatile_Full_Access)) + then + Set_Has_Volatile_Full_Access (Typ); + Set_Treat_As_Volatile (Typ); + Set_Is_Volatile (Typ); + end if; + -- Inheritance for derived types only if Is_Derived_Type (Typ) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d3babe8cc47..375d1d99a55 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5842,17 +5842,17 @@ package body Sem_Prag is K : Node_Kind; Utyp : Entity_Id; - procedure Set_Atomic_Full (E : Entity_Id); + procedure Set_Atomic_VFA (E : Entity_Id); -- Set given type as Is_Atomic or Has_Volatile_Full_Access. Also, if -- no explicit alignment was given, set alignment to unknown, since -- back end knows what the alignment requirements are for atomic and -- full access arrays. Note: this is necessary for derived types. - --------------------- - -- Set_Atomic_Full -- - --------------------- + -------------------- + -- Set_Atomic_VFA -- + -------------------- - procedure Set_Atomic_Full (E : Entity_Id) is + procedure Set_Atomic_VFA (E : Entity_Id) is begin if Prag_Id = Pragma_Volatile_Full_Access then Set_Has_Volatile_Full_Access (E); @@ -5863,7 +5863,7 @@ package body Sem_Prag is if not Has_Alignment_Clause (E) then Set_Alignment (E, Uint_0); end if; - end Set_Atomic_Full; + end Set_Atomic_VFA; -- Start of processing for Process_Atomic_Independent_Shared_Volatile @@ -5956,9 +5956,9 @@ package body Sem_Prag is or else Prag_Id = Pragma_Volatile_Full_Access then - Set_Atomic_Full (E); - Set_Atomic_Full (Base_Type (E)); - Set_Atomic_Full (Underlying_Type (E)); + Set_Atomic_VFA (E); + Set_Atomic_VFA (Base_Type (E)); + Set_Atomic_VFA (Underlying_Type (E)); end if; -- Atomic/Shared/Volatile_Full_Access imply Independent diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d1f222eec1c..13882676443 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10276,6 +10276,20 @@ package body Sem_Util is end if; end Is_Atomic_Object; + ----------------------------- + -- Is_Atomic_Or_VFA_Object -- + ----------------------------- + + function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is + begin + return Is_Atomic_Object (N) + or else (Is_Object_Reference (N) + and then Is_Entity_Name (N) + and then (Has_Volatile_Full_Access (Entity (N)) + or else + Has_Volatile_Full_Access (Etype (Entity (N))))); + end Is_Atomic_Or_VFA_Object; + ------------------------- -- Is_Attribute_Result -- ------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 910b282d4d4..bb537edf4cb 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1168,6 +1168,10 @@ package Sem_Util is -- Determines if the given node denotes an atomic object in the sense of -- the legality checks described in RM C.6(12). + function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean; + -- Determines if the given node is an atomic object (Is_Atomic_Object true) + -- or else is an object for which VFA is present. + function Is_Attribute_Result (N : Node_Id) return Boolean; -- Determine whether node N denotes attribute 'Result -- 2.30.2