From: Eric Botcazou Date: Thu, 9 Jan 2020 15:25:39 +0000 (+0100) Subject: [Ada] Improve 'Val implementation for some enumeration types X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=79e267f9fb23da4e9553a97dc45ea757545cf521;p=gcc.git [Ada] Improve 'Val implementation for some enumeration types 2020-06-03 Eric Botcazou gcc/ada/ * einfo.ads (Enum_Pos_To_Rep): Adjust description. * exp_attr.adb (Expand_N_Attribute_Reference) : Reimplement in the case of an enumeration type with non-standard but contiguous representation. : Likewise. : 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 32a938a6d3a..810a112ca28 100644 --- 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 939183c5635..8ca5eb15158 100644 --- 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 0a18d0dd131..0d0944959f6 100644 --- 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: