From f193b29e42bcca7b92752d98d3a38dc9df884bef Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 9 Apr 2020 11:42:22 +0200 Subject: [PATCH] [Ada] Expand 'Pos and 'Val for enumeration types with standard representation 2020-06-16 Eric Botcazou 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) : Call it. : For an enumeration type with a standard representation, expand to a conversion with Conversion_OK. : Likewise. * exp_ch4.adb (Expand_N_Type_Conversion): Do not expand when the target is an enumeration type and Conversion_OK is set. --- 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 08bea2b5..d31f61d 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 3d706bf..aeb41c9 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 41847d8..401b38d 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 -- 2.7.4