[Ada] Improve 'Val implementation for some enumeration types

2020-06-03  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* einfo.ads (Enum_Pos_To_Rep): Adjust description.
	* exp_attr.adb (Expand_N_Attribute_Reference) <Pred>:
	Reimplement in the case of an enumeration type with non-standard
	but contiguous representation.
	<Succ>: Likewise.
	<Val>: Likewise.
	* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Count the
	literals in the first loop.  If the representation is
	contiguous, just build the index type of the array type and set
	Enum_Pos_To_Rep to it.

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 32a938a6d3a0779648da99f06215433668e04202..810a112ca280791d8a78a58fb021787e6b993209 100644 (file)
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1217,14 +1217,16 @@ package Einfo is
 --       for the same literal.
 
 --    Enum_Pos_To_Rep (Node23)
---       Defined in enumeration types (but not enumeration subtypes). Set to
---       Empty unless the enumeration type has a non-standard representation
---       (i.e. at least one literal has a representation value different from
---       its pos value). In this case, Enum_Pos_To_Rep is the entity for an
---       array constructed when the type is frozen that maps Pos values to
---       corresponding Rep values. The index type of this array is Natural,
---       and the component type is a suitable integer type that holds the
---       full range of representation values.
+--       Defined in enumeration types, but not enumeration subtypes. Set to
+--       Empty unless the enumeration type has a non-standard representation,
+--       i.e. at least one literal has a representation value different from
+--       its position value. In this case, the alternative is the following:
+--       if the representation is not contiguous, then Enum_Pos_To_Rep is the
+--       entity for an array constant built when the type is frozen that maps
+--       Pos values to corresponding Rep values, whose index type is Natural
+--       and whose component type is the enumeration type itself; or else, if
+--       the representation is contiguous, then Enum_Pos_To_Rep is the entity
+--       of the index type defined above.
 
 --    Equivalent_Type (Node18)
 --       Defined in class wide types and subtypes, access to protected

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 939183c56359e02a4999c06261104f6f9da5a213..8ca5eb15158419bd90b12d2422104b83f08c787e 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5246,46 +5246,48 @@ package body Exp_Attr is
 
       when Attribute_Pred => Pred : declare
          Etyp : constant Entity_Id := Base_Type (Ptyp);
+         Ityp : Entity_Id;
 
       begin
-
          --  For enumeration types with non-standard representations, we
-         --  expand typ'Pred (x) into
+         --  expand typ'Pred (x) into:
 
          --    Pos_To_Rep (Rep_To_Pos (x) - 1)
 
-         --    If the representation is contiguous, we compute instead
-         --    Lit1 + Rep_to_Pos (x -1), to catch invalid representations.
-         --    The conversion function Enum_Pos_To_Rep is defined on the
-         --    base type, not the subtype, so we have to use the base type
-         --    explicitly for this and other enumeration attributes.
+         --  if the representation is non-contiguous, and just x - 1 if it is
+         --  after having dealt with constraint checking.
 
-         if Is_Enumeration_Type (Ptyp)
+         if Is_Enumeration_Type (Etyp)
            and then Present (Enum_Pos_To_Rep (Etyp))
          then
             if Has_Contiguous_Rep (Etyp) then
-               Rewrite (N,
-                  Unchecked_Convert_To (Ptyp,
-                     Make_Op_Add (Loc,
-                        Left_Opnd  =>
-                         Make_Integer_Literal (Loc,
-                           Enumeration_Rep (First_Literal (Ptyp))),
-                        Right_Opnd =>
-                          Make_Function_Call (Loc,
-                            Name =>
-                              New_Occurrence_Of
-                               (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+               if not Range_Checks_Suppressed (Ptyp) then
+                  Set_Do_Range_Check (First (Exprs), False);
+                  Expand_Pred_Succ_Attribute (N);
+               end if;
+
+               if Is_Unsigned_Type (Etyp) then
+                  if Esize (Typ) <= Standard_Integer_Size then
+                     Ityp := RTE (RE_Unsigned);
+                  else
+                     Ityp := RTE (RE_Long_Long_Unsigned);
+                  end if;
 
-                            Parameter_Associations =>
-                              New_List (
-                                Unchecked_Convert_To (Ptyp,
-                                  Make_Op_Subtract (Loc,
-                                    Left_Opnd =>
-                                     Unchecked_Convert_To (Standard_Integer,
-                                       Relocate_Node (First (Exprs))),
-                                    Right_Opnd =>
-                                      Make_Integer_Literal (Loc, 1))),
-                                Rep_To_Pos_Flag (Ptyp, Loc))))));
+               else
+                  if Esize (Etyp) <= Standard_Integer_Size then
+                     Ityp := Standard_Integer;
+                  else
+                     Ityp := Standard_Long_Long_Integer;
+                  end if;
+               end if;
+
+               Rewrite (N,
+                 Unchecked_Convert_To (Etyp,
+                    Make_Op_Subtract (Loc,
+                       Left_Opnd  =>
+                         Unchecked_Convert_To (Ityp, First (Exprs)),
+                       Right_Opnd =>
+                         Make_Integer_Literal (Loc, 1))));
 
             else
                --  Add Boolean parameter True, to request program error if
@@ -5309,7 +5311,9 @@ package body Exp_Attr is
                     Right_Opnd => Make_Integer_Literal (Loc, 1)))));
             end if;
 
-            Analyze_And_Resolve (N, Typ);
+            --  Suppress checks since they have all been done above
+
+            Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
 
          --  For floating-point, we transform 'Pred into a call to the Pred
          --  floating-point attribute function in Fat_xxx (xxx is root type).
@@ -6222,42 +6226,49 @@ package body Exp_Attr is
 
       when Attribute_Succ => Succ : declare
          Etyp : constant Entity_Id := Base_Type (Ptyp);
+         Ityp : Entity_Id;
 
       begin
          --  For enumeration types with non-standard representations, we
-         --  expand typ'Succ (x) into
+         --  expand typ'Pred (x) into:
 
          --    Pos_To_Rep (Rep_To_Pos (x) + 1)
 
-         --    If the representation is contiguous, we compute instead
-         --    Lit1 + Rep_to_Pos (x+1), to catch invalid representations.
+         --  if the representation is non-contiguous, and just x + 1 if it is
+         --  after having dealt with constraint checking.
 
-         if Is_Enumeration_Type (Ptyp)
+         if Is_Enumeration_Type (Etyp)
            and then Present (Enum_Pos_To_Rep (Etyp))
          then
             if Has_Contiguous_Rep (Etyp) then
+               if not Range_Checks_Suppressed (Ptyp) then
+                  Set_Do_Range_Check (First (Exprs), False);
+                  Expand_Pred_Succ_Attribute (N);
+               end if;
+
+               if Is_Unsigned_Type (Etyp) then
+                  if Esize (Typ) <= Standard_Integer_Size then
+                     Ityp := RTE (RE_Unsigned);
+                  else
+                     Ityp := RTE (RE_Long_Long_Unsigned);
+                  end if;
+
+               else
+                  if Esize (Etyp) <= Standard_Integer_Size then
+                     Ityp := Standard_Integer;
+                  else
+                     Ityp := Standard_Long_Long_Integer;
+                  end if;
+               end if;
+
                Rewrite (N,
-                  Unchecked_Convert_To (Ptyp,
-                     Make_Op_Add (Loc,
-                        Left_Opnd  =>
-                         Make_Integer_Literal (Loc,
-                           Enumeration_Rep (First_Literal (Ptyp))),
-                        Right_Opnd =>
-                          Make_Function_Call (Loc,
-                            Name =>
-                              New_Occurrence_Of
-                               (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+                 Unchecked_Convert_To (Etyp,
+                    Make_Op_Add (Loc,
+                       Left_Opnd  =>
+                         Unchecked_Convert_To (Ityp, First (Exprs)),
+                       Right_Opnd =>
+                         Make_Integer_Literal (Loc, 1))));
 
-                            Parameter_Associations =>
-                              New_List (
-                                Unchecked_Convert_To (Ptyp,
-                                  Make_Op_Add (Loc,
-                                  Left_Opnd =>
-                                    Unchecked_Convert_To (Standard_Integer,
-                                      Relocate_Node (First (Exprs))),
-                                  Right_Opnd =>
-                                    Make_Integer_Literal (Loc, 1))),
-                                Rep_To_Pos_Flag (Ptyp, Loc))))));
             else
                --  Add Boolean parameter True, to request program error if
                --  we have a bad representation on our hands. Add False if
@@ -6280,7 +6291,9 @@ package body Exp_Attr is
                        Right_Opnd => Make_Integer_Literal (Loc, 1)))));
             end if;
 
-            Analyze_And_Resolve (N, Typ);
+            --  Suppress checks since they have all been done above
+
+            Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
 
          --  For floating-point, we transform 'Succ into a call to the Succ
          --  floating-point attribute function in Fat_xxx (xxx is root type)
@@ -6536,70 +6549,86 @@ package body Exp_Attr is
       when Attribute_Val => Val : declare
          Etyp : constant Entity_Id := Base_Type (Ptyp);
          Expr : constant Node_Id := First (Exprs);
+         Ityp : Entity_Id;
+         Rtyp : Entity_Id;
 
       begin
          --  Case of enumeration type
 
          if Is_Enumeration_Type (Etyp) then
 
-            --  Non-standard enumeration type
+            --  Non-contiguous non-standard enumeration type
 
-            if Present (Enum_Pos_To_Rep (Etyp)) then
-               if Has_Contiguous_Rep (Etyp) then
-                  declare
-                     Rep_Node : constant Node_Id :=
-                       Unchecked_Convert_To (Etyp,
-                          Make_Op_Add (Loc,
-                            Left_Opnd =>
-                              Make_Integer_Literal (Loc,
-                                Enumeration_Rep (First_Literal (Etyp))),
-                            Right_Opnd =>
-                               Convert_To (Standard_Integer, Expr)));
+            if Present (Enum_Pos_To_Rep (Etyp))
+              and then not Has_Contiguous_Rep (Etyp)
+            then
+               Rewrite (N,
+                 Make_Indexed_Component (Loc,
+                   Prefix =>
+                     New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
+                   Expressions => New_List (
+                     Convert_To (Standard_Integer, Expr))));
 
-                  begin
-                     Rewrite (N,
-                        Unchecked_Convert_To (Etyp,
-                            Make_Op_Add (Loc,
-                              Left_Opnd =>
-                                Make_Integer_Literal (Loc,
-                                  Enumeration_Rep (First_Literal (Etyp))),
-                              Right_Opnd =>
-                                Make_Function_Call (Loc,
-                                  Name =>
-                                    New_Occurrence_Of
-                                      (TSS (Etyp, TSS_Rep_To_Pos), Loc),
-                                  Parameter_Associations => New_List (
-                                    Rep_Node,
-                                    Rep_To_Pos_Flag (Etyp, Loc))))));
-                  end;
+               Analyze_And_Resolve (N, Typ);
 
-               else
-                  Rewrite (N,
-                    Make_Indexed_Component (Loc,
-                      Prefix =>
-                        New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
-                      Expressions => New_List (
-                        Convert_To (Standard_Integer, Expr))));
-               end if;
+            --  Standard or contiguous non-standard enumeration type
 
-               Analyze_And_Resolve (N, Typ);
+            else
+               --  If the argument is marked as requiring a range check then
+               --  generate it here, after looking through a conversion to
+               --  universal integer, if any.
+
+               if Do_Range_Check (Expr) then
+                  if Present (Enum_Pos_To_Rep (Etyp)) then
+                     Rtyp := Enum_Pos_To_Rep (Etyp);
+                  else
+                     Rtyp := Etyp;
+                  end if;
 
-            --  Standard enumeration type
+                  if Nkind (Expr) = N_Type_Conversion
+                     and then Entity (Subtype_Mark (Expr)) = Universal_Integer
+                  then
+                     Generate_Range_Check
+                       (Expression (Expr), Rtyp, CE_Range_Check_Failed);
 
-            --  If the argument is marked as requiring a range check then
-            --  generate it here, after looking through a conversion to
-            --  universal integer, if any.
+                  else
+                     Generate_Range_Check (Expr, Rtyp, CE_Range_Check_Failed);
+                  end if;
 
-            elsif Do_Range_Check (Expr) then
-               if Nkind (Expr) = N_Type_Conversion
-                  and then Entity (Subtype_Mark (Expr)) = Universal_Integer
-               then
-                  Generate_Range_Check
-                    (Expression (Expr), Etyp, CE_Range_Check_Failed);
                   Set_Do_Range_Check (Expr, False);
+               end if;
 
-               else
-                  Generate_Range_Check (Expr, Etyp, CE_Range_Check_Failed);
+               --  Contiguous non-standard enumeration type
+
+               if Present (Enum_Pos_To_Rep (Etyp)) then
+                  if Is_Unsigned_Type (Etyp) then
+                     if Esize (Typ) <= Standard_Integer_Size then
+                        Ityp := RTE (RE_Unsigned);
+                     else
+                        Ityp := RTE (RE_Long_Long_Unsigned);
+                     end if;
+
+                  else
+                     if Esize (Etyp) <= Standard_Integer_Size then
+                        Ityp := Standard_Integer;
+                     else
+                        Ityp := Standard_Long_Long_Integer;
+                     end if;
+                  end if;
+
+                  Rewrite (N,
+                    Unchecked_Convert_To (Etyp,
+                      Make_Op_Add (Loc,
+                        Left_Opnd =>
+                          Make_Integer_Literal (Loc,
+                            Enumeration_Rep (First_Literal (Etyp))),
+                        Right_Opnd =>
+                          Convert_To (Ityp, Expr))));
+
+                  --  Suppress checks since the range check was done above
+                  --  and it guarantees that the addition cannot overflow.
+
+                  Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
                end if;
             end if;
 

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 0a18d0dd1317d85b18ec7625ecda7529b5bbc6e8..0d0944959f6f7aced81930279c25682989c32522 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -4670,6 +4670,7 @@ package body Exp_Ch3 is
       Ent           : Entity_Id;
       Fent          : Entity_Id;
       Is_Contiguous : Boolean;
+      Index_Typ     : Entity_Id;
       Ityp          : Entity_Id;
       Last_Repval   : Uint;
       Lst           : List_Id;
@@ -4686,81 +4687,99 @@ package body Exp_Ch3 is
 
       Ent := First_Literal (Typ);
       Last_Repval := Enumeration_Rep (Ent);
-
+      Num := 1;
       Next_Literal (Ent);
+
       while Present (Ent) loop
          if Enumeration_Rep (Ent) - Last_Repval /= 1 then
             Is_Contiguous := False;
-            exit;
          else
             Last_Repval := Enumeration_Rep (Ent);
          end if;
 
+         Num := Num + 1;
          Next_Literal (Ent);
       end loop;
 
       if Is_Contiguous then
          Set_Has_Contiguous_Rep (Typ);
-         Ent := First_Literal (Typ);
-         Num := 1;
-         Lst := New_List (New_Occurrence_Of (Ent, Sloc (Ent)));
+
+         --  Now build a subtype declaration
+
+         --    subtype typI is new Natural range 0 .. num - 1
+
+         Index_Typ :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Chars (Typ), 'I'));
+
+         Append_Freeze_Action (Typ,
+           Make_Subtype_Declaration (Loc,
+             Defining_Identifier => Index_Typ,
+             Subtype_Indication =>
+               Make_Subtype_Indication (Loc,
+                 Subtype_Mark =>
+                   New_Occurrence_Of (Standard_Natural,  Loc),
+                 Constraint  =>
+                   Make_Range_Constraint (Loc,
+                     Range_Expression =>
+                       Make_Range (Loc,
+                         Low_Bound  =>
+                           Make_Integer_Literal (Loc, 0),
+                         High_Bound =>
+                           Make_Integer_Literal (Loc, Num - 1))))));
+
+         Set_Enum_Pos_To_Rep (Typ, Index_Typ);
 
       else
          --  Build list of literal references
 
          Lst := New_List;
-         Num := 0;
-
          Ent := First_Literal (Typ);
          while Present (Ent) loop
             Append_To (Lst, New_Occurrence_Of (Ent, Sloc (Ent)));
-            Num := Num + 1;
             Next_Literal (Ent);
          end loop;
-      end if;
-
-      --  Now build an array declaration
 
-      --    typA : array (Natural range 0 .. num - 1) of ctype :=
-      --             (v, v, v, v, v, ....)
+         --  Now build an array declaration
 
-      --  where ctype is the corresponding integer type. If the representation
-      --  is contiguous, we only keep the first literal, which provides the
-      --  offset for Pos_To_Rep computations.
+         --    typA : constant array (Natural range 0 .. num - 1) of typ :=
+         --             (v, v, v, v, v, ....)
 
-      Arr :=
-        Make_Defining_Identifier (Loc,
-          Chars => New_External_Name (Chars (Typ), 'A'));
+         Arr :=
+           Make_Defining_Identifier (Loc,
+             Chars => New_External_Name (Chars (Typ), 'A'));
 
-      Append_Freeze_Action (Typ,
-        Make_Object_Declaration (Loc,
-          Defining_Identifier => Arr,
-          Constant_Present    => True,
-
-          Object_Definition   =>
-            Make_Constrained_Array_Definition (Loc,
-              Discrete_Subtype_Definitions => New_List (
-                Make_Subtype_Indication (Loc,
-                  Subtype_Mark => New_Occurrence_Of (Standard_Natural, Loc),
-                  Constraint   =>
-                    Make_Range_Constraint (Loc,
-                      Range_Expression =>
-                        Make_Range (Loc,
-                          Low_Bound  =>
-                            Make_Integer_Literal (Loc, 0),
-                          High_Bound =>
-                            Make_Integer_Literal (Loc, Num - 1))))),
-
-              Component_Definition =>
-                Make_Component_Definition (Loc,
-                  Aliased_Present => False,
-                  Subtype_Indication => New_Occurrence_Of (Typ, Loc))),
+         Append_Freeze_Action (Typ,
+           Make_Object_Declaration (Loc,
+             Defining_Identifier => Arr,
+             Constant_Present    => True,
+
+             Object_Definition   =>
+               Make_Constrained_Array_Definition (Loc,
+                 Discrete_Subtype_Definitions => New_List (
+                   Make_Subtype_Indication (Loc,
+                     Subtype_Mark =>
+                       New_Occurrence_Of (Standard_Natural, Loc),
+                     Constraint   =>
+                       Make_Range_Constraint (Loc,
+                         Range_Expression =>
+                           Make_Range (Loc,
+                             Low_Bound  =>
+                               Make_Integer_Literal (Loc, 0),
+                             High_Bound =>
+                               Make_Integer_Literal (Loc, Num - 1))))),
+
+                 Component_Definition =>
+                   Make_Component_Definition (Loc,
+                     Aliased_Present => False,
+                     Subtype_Indication => New_Occurrence_Of (Typ, Loc))),
 
-          Expression =>
-            Make_Aggregate (Loc,
-              Expressions => Lst)));
+             Expression =>
+               Make_Aggregate (Loc,
+                 Expressions => Lst)));
 
-      Set_Enum_Pos_To_Rep (Typ, Arr);
+         Set_Enum_Pos_To_Rep (Typ, Arr);
+      end if;
 
       --  Now we build the function that converts representation values to
       --  position values. This function has the form: