[gcc(refs/users/giulianob/heads/autopar_rebase2)] [Ada] Expand 'Pos and 'Val for enumeration types with standard representation
Giuliano Belinassi
giulianob@gcc.gnu.org
Mon Aug 17 23:49:03 GMT 2020
https://gcc.gnu.org/g:08b2a594c8345e44e4d9b1c8b95c6e1d5e2c7b81
commit 08b2a594c8345e44e4d9b1c8b95c6e1d5e2c7b81
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu Apr 9 11:42:22 2020 +0200
[Ada] Expand 'Pos and 'Val for enumeration types with standard representation
2020-06-16 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* sinfo.ads (Conversion_OK): Document use for 'Pos and 'Val.
* exp_attr.adb (Get_Integer_Type): New function returning a
small integer type appropriate for an enumeration type.
(Expand_N_Attribute_Reference) <Attribute_Enum_Rep>: Call it.
<Attribute_Pos>: For an enumeration type with a standard
representation, expand to a conversion with Conversion_OK.
<Attribute_Val>: Likewise.
* exp_ch4.adb (Expand_N_Type_Conversion): Do not expand when
the target is an enumeration type and Conversion_OK is set.
Diff:
---
gcc/ada/exp_attr.adb | 96 ++++++++++++++++++++++++++++++++++------------------
gcc/ada/exp_ch4.adb | 6 ++--
gcc/ada/sinfo.ads | 4 +--
3 files changed, 69 insertions(+), 37 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 08bea2b531a..d31f61dcb8c 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1737,11 +1737,41 @@ package body Exp_Attr is
Pref : constant Node_Id := Prefix (N);
Exprs : constant List_Id := Expressions (N);
+ function Get_Integer_Type (Typ : Entity_Id) return Entity_Id;
+ -- Return a small integer type appropriate for the enumeration type
+
procedure Rewrite_Attribute_Proc_Call (Pname : Entity_Id);
-- Rewrites an attribute for Read, Write, Output, or Put_Image with a
-- call to the appropriate TSS procedure. Pname is the entity for the
-- procedure to call.
+ ----------------------
+ -- Get_Integer_Type --
+ ----------------------
+
+ function Get_Integer_Type (Typ : Entity_Id) return Entity_Id is
+ Siz : constant Uint := RM_Size (Base_Type (Typ));
+ Int_Typ : Entity_Id;
+
+ begin
+ -- We need to accommodate unsigned values
+
+ if Siz < 8 then
+ Int_Typ := Standard_Integer_8;
+
+ elsif Siz < 16 then
+ Int_Typ := Standard_Integer_16;
+
+ elsif Siz < 32 then
+ Int_Typ := Standard_Integer_32;
+
+ else
+ Int_Typ := Standard_Integer_64;
+ end if;
+
+ return Int_Typ;
+ end Get_Integer_Type;
+
---------------------------------
-- Rewrite_Attribute_Proc_Call --
---------------------------------
@@ -3146,8 +3176,6 @@ package body Exp_Attr is
when Attribute_Enum_Rep => Enum_Rep : declare
Expr : Node_Id;
- Ityp : Entity_Id;
- Psiz : Uint;
begin
-- Get the expression, which is X for Enum_Type'Enum_Rep (X) or
@@ -3177,22 +3205,7 @@ package body Exp_Attr is
-- the size information.
if Is_Enumeration_Type (Ptyp) then
- Psiz := RM_Size (Base_Type (Ptyp));
-
- if Psiz < 8 then
- Ityp := Standard_Integer_8;
-
- elsif Psiz < 16 then
- Ityp := Standard_Integer_16;
-
- elsif Psiz < 32 then
- Ityp := Standard_Integer_32;
-
- else
- Ityp := Standard_Integer_64;
- end if;
-
- Rewrite (N, OK_Convert_To (Ityp, Expr));
+ Rewrite (N, OK_Convert_To (Get_Integer_Type (Ptyp), Expr));
Convert_To_And_Rewrite (Typ, N);
else
@@ -5159,9 +5172,6 @@ package body Exp_Attr is
-- Pos --
---------
- -- For enumeration types with a standard representation, Pos is handled
- -- by the back end.
-
-- For enumeration types, with a non-standard representation we generate
-- a call to the _Rep_To_Pos function created when the type was frozen.
-- The call has the form:
@@ -5172,17 +5182,21 @@ package body Exp_Attr is
-- Program_Error to be raised if the expression has an invalid
-- representation, and False if range checks are suppressed.
+ -- For enumeration types with a standard representation, Pos can be
+ -- rewritten as a simple conversion with Conversion_OK set.
+
-- For integer types, Pos is equivalent to a simple integer conversion
-- and we rewrite it as such.
when Attribute_Pos => Pos : declare
+ Expr : constant Node_Id := First (Exprs);
Etyp : Entity_Id := Base_Type (Ptyp);
begin
-- Deal with zero/non-zero boolean values
if Is_Boolean_Type (Etyp) then
- Adjust_Condition (First (Exprs));
+ Adjust_Condition (Expr);
Etyp := Standard_Boolean;
Set_Prefix (N, New_Occurrence_Of (Standard_Boolean, Loc));
end if;
@@ -5202,21 +5216,32 @@ package body Exp_Attr is
New_Occurrence_Of (TSS (Etyp, TSS_Rep_To_Pos), Loc),
Parameter_Associations => Exprs)));
- Analyze_And_Resolve (N, Typ);
+ -- Standard enumeration type (replace by conversion)
+
+ -- This is simply a direct conversion from the enumeration type to
+ -- the target integer type, which is treated by the back end as a
+ -- normal integer conversion, treating the enumeration type as an
+ -- integer, which is exactly what we want. We set Conversion_OK to
+ -- make sure that the analyzer does not complain about what might
+ -- be an illegal conversion.
- -- Standard enumeration type (do universal integer check)
+ -- However the target type is universal integer in most cases,
+ -- which is a very large type, so we first convert to a small
+ -- signed integer type in order not to lose the size information.
else
- Apply_Universal_Integer_Attribute_Checks (N);
+ Rewrite (N, OK_Convert_To (Get_Integer_Type (Ptyp), Expr));
+ Convert_To_And_Rewrite (Typ, N);
+
end if;
-- Deal with integer types (replace by conversion)
elsif Is_Integer_Type (Etyp) then
- Rewrite (N, Convert_To (Typ, First (Exprs)));
- Analyze_And_Resolve (N, Typ);
+ Rewrite (N, Convert_To (Typ, Expr));
end if;
+ Analyze_And_Resolve (N, Typ);
end Pos;
--------------
@@ -6660,13 +6685,13 @@ package body Exp_Attr is
-- Val --
---------
- -- For enumeration types with a standard representation, Val is handled
- -- by the back end.
-
-- For enumeration types with a non-standard representation we use the
-- _Pos_To_Rep array that was created when the type was frozen, unless
-- the representation is contiguous in which case we use an addition.
+ -- For enumeration types with a standard representation, Val can be
+ -- rewritten as a simple conversion with Conversion_OK set.
+
-- For integer types, Val is equivalent to a simple integer conversion
-- and we rewrite it as such.
@@ -6749,11 +6774,16 @@ package body Exp_Attr is
Right_Opnd =>
Convert_To (Ityp, Expr))));
- -- Suppress checks since the range check was done above
- -- and it guarantees that the addition cannot overflow.
+ -- Standard enumeration type
- Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
+ else
+ Rewrite (N, OK_Convert_To (Typ, Expr));
end if;
+
+ -- 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;
-- Deal with integer types
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 3d706bf9507..aeb41c97fe6 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -12280,9 +12280,11 @@ package body Exp_Ch4 is
-- Special processing is required if there is a change of
-- representation (from enumeration representation clauses).
- if not Same_Representation (Target_Type, Operand_Type) then
+ if not Same_Representation (Target_Type, Operand_Type)
+ and then not Conversion_OK (N)
+ then
- -- Convert: x(y) to x'val (ytyp'val (y))
+ -- Convert: x(y) to x'val (ytyp'pos (y))
Rewrite (N,
Make_Attribute_Reference (Loc,
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 41847d8eb24..401b38dccab 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1017,8 +1017,8 @@ package Sinfo is
-- A flag set on type conversion nodes to indicate that the conversion
-- is to be considered as being valid, even though it is the case that
-- the conversion is not valid Ada. This is used for attributes Enum_Rep,
- -- Fixed_Value and Integer_Value, for internal conversions done for
- -- fixed-point operations, and for certain conversions for calls to
+ -- Pos, Val, Fixed_Value and Integer_Value, for internal conversions done
+ -- for fixed-point operations, and for certain conversions for calls to
-- initialization procedures. If Conversion_OK is set, then Etype must be
-- set (the analyzer assumes that Etype has been set). For the case of
-- fixed-point operands, it also indicates that the conversion is to be
More information about the Gcc-cvs
mailing list