diff options
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 78 |
1 files changed, 68 insertions, 10 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 35adaaf6a61..b2af6ae85b8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -2573,6 +2573,15 @@ package body Sem_Attr is Set_Etype (N, RTE (RE_AST_Handler)); end AST_Entry; + ----------------------------- + -- Atomic_Always_Lock_Free -- + ----------------------------- + + when Attribute_Atomic_Always_Lock_Free => + Check_E0; + Check_Type; + Set_Etype (N, Standard_Boolean); + ---------- -- Base -- ---------- @@ -5956,6 +5965,13 @@ package body Sem_Attr is return; end if; + -- For Lock_Free, we apply the attribute to the type of the object. + -- This is allowed since we have already verified that the type is a + -- protected type. + + elsif Id = Attribute_Lock_Free then + P_Entity := Etype (P); + -- No other attributes for objects are folded else @@ -6021,10 +6037,13 @@ package body Sem_Attr is -- Definite must be folded if the prefix is not a generic type, -- that is to say if we are within an instantiation. Same processing - -- applies to the GNAT attributes Has_Discriminants, Type_Class, - -- Has_Tagged_Value, and Unconstrained_Array. + -- applies to the GNAT attributes Atomic_Always_Lock_Free, + -- Has_Discriminants, Lock_Free, Type_Class, Has_Tagged_Value, and + -- Unconstrained_Array. - elsif (Id = Attribute_Definite + elsif (Id = Attribute_Atomic_Always_Lock_Free + or else + Id = Attribute_Definite or else Id = Attribute_Has_Access_Values or else @@ -6032,6 +6051,8 @@ package body Sem_Attr is or else Id = Attribute_Has_Tagged_Values or else + Id = Attribute_Lock_Free + or else Id = Attribute_Type_Class or else Id = Attribute_Unconstrained_Array @@ -6136,16 +6157,19 @@ package body Sem_Attr is -- since we can't do anything with unconstrained arrays. In addition, -- only the First, Last and Length attributes are possibly static. - -- Definite, Has_Access_Values, Has_Discriminants, Has_Tagged_Values, - -- Type_Class, and Unconstrained_Array are again exceptions, because - -- they apply as well to unconstrained types. + -- Atomic_Always_Lock_Free, Definite, Has_Access_Values, + -- Has_Discriminants, Has_Tagged_Values, Lock_Free, Type_Class, and + -- Unconstrained_Array are again exceptions, because they apply as well + -- to unconstrained types. -- In addition Component_Size is an exception since it is possibly -- foldable, even though it is never static, and it does apply to -- unconstrained arrays. Furthermore, it is essential to fold this -- in the packed case, since otherwise the value will be incorrect. - elsif Id = Attribute_Definite + elsif Id = Attribute_Atomic_Always_Lock_Free + or else + Id = Attribute_Definite or else Id = Attribute_Has_Access_Values or else @@ -6153,6 +6177,8 @@ package body Sem_Attr is or else Id = Attribute_Has_Tagged_Values or else + Id = Attribute_Lock_Free + or else Id = Attribute_Type_Class or else Id = Attribute_Unconstrained_Array @@ -6381,6 +6407,30 @@ package body Sem_Attr is null; end if; + ----------------------------- + -- Atomic_Always_Lock_Free -- + ----------------------------- + + -- Atomic_Always_Lock_Free attribute is a Boolean, thus no need to fold + -- here. + + when Attribute_Atomic_Always_Lock_Free => Atomic_Always_Lock_Free : + declare + V : constant Entity_Id := + Boolean_Literals + (Support_Atomic_Primitives_On_Target + and then Support_Atomic_Primitives (P_Type)); + + begin + Rewrite (N, New_Occurrence_Of (V, Loc)); + + -- Analyze and resolve as boolean. Note that this attribute is a + -- static attribute in GNAT. + + Analyze_And_Resolve (N, Standard_Boolean); + Static := True; + end Atomic_Always_Lock_Free; + --------- -- Bit -- --------- @@ -6801,10 +6851,18 @@ package body Sem_Attr is -- Lock_Free -- --------------- - -- Lock_Free attribute is a Boolean, thus no need to fold here. + when Attribute_Lock_Free => Lock_Free : declare + V : constant Entity_Id := Boolean_Literals (Uses_Lock_Free (P_Type)); - when Attribute_Lock_Free => - null; + begin + Rewrite (N, New_Occurrence_Of (V, Loc)); + + -- Analyze and resolve as boolean. Note that this attribute is a + -- static attribute in GNAT. + + Analyze_And_Resolve (N, Standard_Boolean); + Static := True; + end Lock_Free; ---------- -- Last -- |