Commit 8dc2ddaf by Robert Dewar Committed by Arnaud Charlet

2009-04-09 Robert Dewar <dewar@adacore.com>

        * checks.adb:
        (Insert_Valid_Check): Avoid unnecessary generation of junk declaration
        when no invalid values exist, Avoid duplicate read of atomic variable.

        * cstand.adb (Build_Signed_Integer_Type): Set Is_Known_Valid
        (Standard_Unsigned): Set Is_Known_Valid

        * sem_ch3.adb (Analyze_Subtype_Declaration): Copy Is_Known_Valid on
	subtype declaration if no constraint.
        (Set_Modular_Size): Set Is_Known_Valid if appropriate
        (Build_Derived_Numeric_Type): Copy Is_Known_Valid if no constraint

From-SVN: r145836
parent 47cb314a
...@@ -5125,10 +5125,12 @@ package body Checks is ...@@ -5125,10 +5125,12 @@ package body Checks is
Exp : Node_Id; Exp : Node_Id;
begin 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 if not Validity_Checks_On
or else Range_Or_Validity_Checks_Suppressed (Expr) or else Range_Or_Validity_Checks_Suppressed (Expr)
or else Expr_Known_Valid (Expr)
then then
return; return;
end if; end if;
...@@ -5152,6 +5154,14 @@ package body Checks is ...@@ -5152,6 +5154,14 @@ package body Checks is
begin begin
Set_Do_Range_Check (Exp, False); 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 -- Insert the validity check. Note that we do this with validity
-- checks turned off, to avoid recursion, we do not want validity -- checks turned off, to avoid recursion, we do not want validity
-- checks on the validity checking code itself! -- checks on the validity checking code itself!
......
...@@ -1144,6 +1144,7 @@ package body CStand is ...@@ -1144,6 +1144,7 @@ package body CStand is
Set_Is_Unsigned_Type (Standard_Unsigned); Set_Is_Unsigned_Type (Standard_Unsigned);
Set_Size_Known_At_Compile_Time Set_Size_Known_At_Compile_Time
(Standard_Unsigned); (Standard_Unsigned);
Set_Is_Known_Valid (Standard_Unsigned, True);
R_Node := New_Node (N_Range, Stloc); R_Node := New_Node (N_Range, Stloc);
Set_Low_Bound (R_Node, Make_Integer (Uint_0)); Set_Low_Bound (R_Node, Make_Integer (Uint_0));
...@@ -1311,7 +1312,6 @@ package body CStand is ...@@ -1311,7 +1312,6 @@ package body CStand is
begin begin
Comp := First_Entity (Standard_Exception_Type); Comp := First_Entity (Standard_Exception_Type);
Comp_List := New_List; Comp_List := New_List;
while Present (Comp) loop while Present (Comp) loop
Append ( Append (
Make_Component_Declaration (Stloc, Make_Component_Declaration (Stloc,
...@@ -1487,7 +1487,6 @@ package body CStand is ...@@ -1487,7 +1487,6 @@ package body CStand is
function Identifier_For (S : Standard_Entity_Type) return Node_Id is function Identifier_For (S : Standard_Entity_Type) return Node_Id is
Ident_Node : Node_Id; Ident_Node : Node_Id;
begin begin
Ident_Node := New_Node (N_Identifier, Stloc); Ident_Node := New_Node (N_Identifier, Stloc);
Set_Chars (Ident_Node, Chars (Standard_Entity (S))); Set_Chars (Ident_Node, Chars (Standard_Entity (S)));
......
...@@ -3382,6 +3382,7 @@ package body Sem_Ch3 is ...@@ -3382,6 +3382,7 @@ package body Sem_Ch3 is
Set_Scalar_Range (Id, Scalar_Range (T)); Set_Scalar_Range (Id, Scalar_Range (T));
Set_Machine_Radix_10 (Id, Machine_Radix_10 (T)); Set_Machine_Radix_10 (Id, Machine_Radix_10 (T));
Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T)); Set_RM_Size (Id, RM_Size (T));
when Enumeration_Kind => when Enumeration_Kind =>
...@@ -3390,6 +3391,7 @@ package body Sem_Ch3 is ...@@ -3390,6 +3391,7 @@ package body Sem_Ch3 is
Set_Scalar_Range (Id, Scalar_Range (T)); Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Character_Type (Id, Is_Character_Type (T)); Set_Is_Character_Type (Id, Is_Character_Type (T));
Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T)); Set_RM_Size (Id, RM_Size (T));
when Ordinary_Fixed_Point_Kind => when Ordinary_Fixed_Point_Kind =>
...@@ -3398,6 +3400,7 @@ package body Sem_Ch3 is ...@@ -3398,6 +3400,7 @@ package body Sem_Ch3 is
Set_Small_Value (Id, Small_Value (T)); Set_Small_Value (Id, Small_Value (T));
Set_Delta_Value (Id, Delta_Value (T)); Set_Delta_Value (Id, Delta_Value (T));
Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T)); Set_RM_Size (Id, RM_Size (T));
when Float_Kind => when Float_Kind =>
...@@ -3410,12 +3413,14 @@ package body Sem_Ch3 is ...@@ -3410,12 +3413,14 @@ package body Sem_Ch3 is
Set_Ekind (Id, E_Signed_Integer_Subtype); Set_Ekind (Id, E_Signed_Integer_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T)); Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T)); Set_RM_Size (Id, RM_Size (T));
when Modular_Integer_Kind => when Modular_Integer_Kind =>
Set_Ekind (Id, E_Modular_Integer_Subtype); Set_Ekind (Id, E_Modular_Integer_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T)); Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Constrained (Id, Is_Constrained (T)); Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T)); Set_RM_Size (Id, RM_Size (T));
when Class_Wide_Kind => when Class_Wide_Kind =>
...@@ -5205,6 +5210,7 @@ package body Sem_Ch3 is ...@@ -5205,6 +5210,7 @@ package body Sem_Ch3 is
Set_Size_Info (Implicit_Base, Parent_Base); Set_Size_Info (Implicit_Base, Parent_Base);
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base)); Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base));
Set_Parent (Implicit_Base, Parent (Derived_Type)); 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 -- Set RM Size for discrete type or decimal fixed-point type
-- Ordinary fixed-point is excluded, why??? -- Ordinary fixed-point is excluded, why???
...@@ -5258,6 +5264,8 @@ package body Sem_Ch3 is ...@@ -5258,6 +5264,8 @@ package body Sem_Ch3 is
if Has_Infinities (Parent_Type) then if Has_Infinities (Parent_Type) then
Set_Includes_Infinities (Scalar_Range (Derived_Type)); Set_Includes_Infinities (Scalar_Range (Derived_Type));
end if; end if;
Set_Is_Known_Valid (Derived_Type, Is_Known_Valid (Parent_Type));
end if; end if;
Set_Is_Descendent_Of_Address (Derived_Type, Set_Is_Descendent_Of_Address (Derived_Type,
...@@ -5273,6 +5281,9 @@ package body Sem_Ch3 is ...@@ -5273,6 +5281,9 @@ package body Sem_Ch3 is
Set_Non_Binary_Modulus Set_Non_Binary_Modulus
(Implicit_Base, Non_Binary_Modulus (Parent_Base)); (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 elsif Is_Floating_Point_Type (Parent_Type) then
-- Digits of base type is always copied from the digits value of -- Digits of base type is always copied from the digits value of
...@@ -14881,6 +14892,12 @@ package body Sem_Ch3 is ...@@ -14881,6 +14892,12 @@ package body Sem_Ch3 is
else else
Init_Esize (T, System_Max_Binary_Modulus_Power); Init_Esize (T, System_Max_Binary_Modulus_Power);
end if; 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; end Set_Modular_Size;
-- Start of processing for Modular_Type_Declaration -- Start of processing for Modular_Type_Declaration
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment