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
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!
......
......@@ -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)));
......
......@@ -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
......
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