diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/checks.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 19 |
3 files changed, 36 insertions, 10 deletions
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index da6ca2e..45462db 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5125,10 +5125,12 @@ package body Checks is Exp : Node_Id; begin - -- Do not insert if checks off, or if not checking validity + -- Do not insert if checks off, or if not checking validity or + -- if expression is known to be valid if not Validity_Checks_On or else Range_Or_Validity_Checks_Suppressed (Expr) + or else Expr_Known_Valid (Expr) then return; end if; @@ -5152,6 +5154,14 @@ package body Checks is begin Set_Do_Range_Check (Exp, False); + -- Force evaluation to avoid multiple reads for atomic/volatile + + if Is_Entity_Name (Exp) + and then Is_Volatile (Entity (Exp)) + then + Force_Evaluation (Exp, Name_Req => True); + end if; + -- Insert the validity check. Note that we do this with validity -- checks turned off, to avoid recursion, we do not want validity -- checks on the validity checking code itself! diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 56f8791..d6f0ff0 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -933,17 +933,17 @@ package body CStand is Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype); Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard); Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer)); - Init_Esize (Standard_Debug_Renaming_Type, 0); - Init_RM_Size (Standard_Debug_Renaming_Type, 0); + Init_Esize (Standard_Debug_Renaming_Type, 0); + Init_RM_Size (Standard_Debug_Renaming_Type, 0); Set_Size_Known_At_Compile_Time (Standard_Debug_Renaming_Type); - Set_Integer_Bounds (Standard_Debug_Renaming_Type, - Typ => Base_Type (Standard_Debug_Renaming_Type), + Set_Integer_Bounds (Standard_Debug_Renaming_Type, + Typ => Base_Type (Standard_Debug_Renaming_Type), Lb => Uint_1, Hb => Uint_0); - Set_Is_Constrained (Standard_Debug_Renaming_Type); + Set_Is_Constrained (Standard_Debug_Renaming_Type); Set_Has_Size_Clause (Standard_Debug_Renaming_Type); - Make_Name (Standard_Debug_Renaming_Type, "_renaming_type"); + Make_Name (Standard_Debug_Renaming_Type, "_renaming_type"); -- Note on type names. The type names for the following special types -- are constructed so that they will look reasonable should they ever @@ -1144,6 +1144,7 @@ package body CStand is Set_Is_Unsigned_Type (Standard_Unsigned); Set_Size_Known_At_Compile_Time (Standard_Unsigned); + Set_Is_Known_Valid (Standard_Unsigned, True); R_Node := New_Node (N_Range, Stloc); Set_Low_Bound (R_Node, Make_Integer (Uint_0)); @@ -1311,7 +1312,6 @@ package body CStand is begin Comp := First_Entity (Standard_Exception_Type); Comp_List := New_List; - while Present (Comp) loop Append ( Make_Component_Declaration (Stloc, @@ -1487,7 +1487,6 @@ package body CStand is function Identifier_For (S : Standard_Entity_Type) return Node_Id is Ident_Node : Node_Id; - begin Ident_Node := New_Node (N_Identifier, Stloc); Set_Chars (Ident_Node, Chars (Standard_Entity (S))); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e098924..12abf17 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -603,7 +603,7 @@ package body Sem_Ch3 is -- given kind of type (index constraint to an array type, for example). procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id); - -- Create new modular type. Verify that modulus is in bounds and is + -- Create new modular type. Verify that modulus is in bounds and is -- a power of two (implementation restriction). procedure New_Concatenation_Op (Typ : Entity_Id); @@ -3382,6 +3382,7 @@ package body Sem_Ch3 is Set_Scalar_Range (Id, Scalar_Range (T)); Set_Machine_Radix_10 (Id, Machine_Radix_10 (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Set_Is_Known_Valid (Id, Is_Known_Valid (T)); Set_RM_Size (Id, RM_Size (T)); when Enumeration_Kind => @@ -3390,6 +3391,7 @@ package body Sem_Ch3 is Set_Scalar_Range (Id, Scalar_Range (T)); Set_Is_Character_Type (Id, Is_Character_Type (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Set_Is_Known_Valid (Id, Is_Known_Valid (T)); Set_RM_Size (Id, RM_Size (T)); when Ordinary_Fixed_Point_Kind => @@ -3398,6 +3400,7 @@ package body Sem_Ch3 is Set_Small_Value (Id, Small_Value (T)); Set_Delta_Value (Id, Delta_Value (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Set_Is_Known_Valid (Id, Is_Known_Valid (T)); Set_RM_Size (Id, RM_Size (T)); when Float_Kind => @@ -3410,12 +3413,14 @@ package body Sem_Ch3 is Set_Ekind (Id, E_Signed_Integer_Subtype); Set_Scalar_Range (Id, Scalar_Range (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Set_Is_Known_Valid (Id, Is_Known_Valid (T)); Set_RM_Size (Id, RM_Size (T)); when Modular_Integer_Kind => Set_Ekind (Id, E_Modular_Integer_Subtype); Set_Scalar_Range (Id, Scalar_Range (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Set_Is_Known_Valid (Id, Is_Known_Valid (T)); Set_RM_Size (Id, RM_Size (T)); when Class_Wide_Kind => @@ -5205,6 +5210,7 @@ package body Sem_Ch3 is Set_Size_Info (Implicit_Base, Parent_Base); Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base)); Set_Parent (Implicit_Base, Parent (Derived_Type)); + Set_Is_Known_Valid (Implicit_Base, Is_Known_Valid (Parent_Base)); -- Set RM Size for discrete type or decimal fixed-point type -- Ordinary fixed-point is excluded, why??? @@ -5258,6 +5264,8 @@ package body Sem_Ch3 is if Has_Infinities (Parent_Type) then Set_Includes_Infinities (Scalar_Range (Derived_Type)); end if; + + Set_Is_Known_Valid (Derived_Type, Is_Known_Valid (Parent_Type)); end if; Set_Is_Descendent_Of_Address (Derived_Type, @@ -5273,6 +5281,9 @@ package body Sem_Ch3 is Set_Non_Binary_Modulus (Implicit_Base, Non_Binary_Modulus (Parent_Base)); + Set_Is_Known_Valid + (Implicit_Base, Is_Known_Valid (Parent_Base)); + elsif Is_Floating_Point_Type (Parent_Type) then -- Digits of base type is always copied from the digits value of @@ -14881,6 +14892,12 @@ package body Sem_Ch3 is else Init_Esize (T, System_Max_Binary_Modulus_Power); end if; + + if not Non_Binary_Modulus (T) + and then Esize (T) = RM_Size (T) + then + Set_Is_Known_Valid (T); + end if; end Set_Modular_Size; -- Start of processing for Modular_Type_Declaration |