* [Ada] Get rid of more references to Universal_Integer in expanded code
@ 2020-06-02 8:59 Pierre-Marie de Rodat
0 siblings, 0 replies; 5+ messages in thread
From: Pierre-Marie de Rodat @ 2020-06-02 8:59 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 1170 bytes --]
This further tweaks the expanded code generated by the front-end, so as
to avoid having references to Universal_Integer reaching the code
generator, either directly or indirectly through attributes returning
Universal_Integer.
The reason is that Universal_Integer must be a type as large as the
largest supported integer type and, therefore, can be much larger than
what is really needed here.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-02 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_aggr.adb (Others_Check): In the positional case, use the
general expression for the comparison only when needed.
* exp_attr.adb (Expand_Fpt_Attribute;): Use a simple conversion
to the target type instead of an unchecked conversion to the
base type to do the range check, as in the other cases.
(Expand_N_Attribute_Reference) <Attribute_Storage_Size>: Do the
Max operation in the type of the storage size variable, and use
Convert_To as in the other cases.
* tbuild.adb (Convert_To): Do not get rid of an intermediate
conversion to Universal_Integer here...
* sem_res.adb (Simplify_Type_Conversion): ...but here instead.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 7964 bytes --]
--- gcc/ada/exp_aggr.adb
+++ gcc/ada/exp_aggr.adb
@@ -5853,26 +5853,51 @@ package body Exp_Aggr is
-- raise Constraint_Error;
-- end if;
+ -- in the general case, but the following simpler test:
+
+ -- [constraint_error when
+ -- Aggr_Lo + (Nb_Elements - 1) > Aggr_Hi];
+
+ -- instead if the index type is a signed integer.
+
elsif Nb_Elements > Uint_0 then
- Cond :=
- Make_Op_Gt (Loc,
- Left_Opnd =>
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ind_Typ, Loc),
- Attribute_Name => Name_Pos,
- Expressions =>
- New_List
- (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
- Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
+ if Nb_Elements = Uint_1 then
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo),
+ Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi));
+
+ elsif Is_Signed_Integer_Type (Ind_Typ) then
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd =>
+ Make_Op_Add (Loc,
+ Left_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Lo),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Nb_Elements - 1)),
+ Right_Opnd => Duplicate_Subexpr_Move_Checks (Aggr_Hi));
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ind_Typ, Loc),
- Attribute_Name => Name_Pos,
- Expressions => New_List (
- Duplicate_Subexpr_Move_Checks (Aggr_Hi))));
+ else
+ Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd =>
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ind_Typ, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions =>
+ New_List
+ (Duplicate_Subexpr_Move_Checks (Aggr_Lo))),
+ Right_Opnd => Make_Integer_Literal (Loc, Nb_Elements - 1)),
+
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ind_Typ, Loc),
+ Attribute_Name => Name_Pos,
+ Expressions => New_List (
+ Duplicate_Subexpr_Move_Checks (Aggr_Hi))));
+ end if;
-- If we are dealing with an aggregate containing an others choice
-- and discrete choices we generate the following test:
--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -1096,12 +1096,10 @@ package body Exp_Attr is
Selector_Name => Make_Identifier (Loc, Nam));
-- The generated call is given the provided set of parameters, and then
- -- wrapped in a conversion which converts the result to the target type
- -- We use the base type as the target because a range check may be
- -- required.
+ -- wrapped in a conversion which converts the result to the target type.
Rewrite (N,
- Unchecked_Convert_To (Base_Type (Etype (N)),
+ Convert_To (Typ,
Make_Function_Call (Loc,
Name => Fnm,
Parameter_Associations => Args)));
@@ -6011,12 +6009,13 @@ package body Exp_Attr is
if Is_Access_Type (Ptyp) then
if Present (Storage_Size_Variable (Root_Type (Ptyp))) then
Rewrite (N,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Typ, Loc),
- Attribute_Name => Name_Max,
- Expressions => New_List (
- Make_Integer_Literal (Loc, 0),
- Convert_To (Typ,
+ Convert_To (Typ,
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of
+ (Etype (Storage_Size_Variable (Root_Type (Ptyp))), Loc),
+ Attribute_Name => Name_Max,
+ Expressions => New_List (
+ Make_Integer_Literal (Loc, 0),
New_Occurrence_Of
(Storage_Size_Variable (Root_Type (Ptyp)), Loc)))));
@@ -6069,7 +6068,7 @@ package body Exp_Attr is
else
Rewrite (N,
- OK_Convert_To (Typ,
+ Convert_To (Typ,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (Alloc_Op, Loc),
--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -265,9 +265,7 @@ package body Sem_Res is
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
- -- have been applied. Currently simplifies a combination of floating-point
- -- to integer conversion and Rounding or Truncation attribute, and also the
- -- conversion of an integer literal to a dynamic integer type.
+ -- have been applied. This rewrites the conversion into a simpler form.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
@@ -12630,7 +12628,7 @@ package body Sem_Res is
-- Special processing for the conversion of an integer literal to
-- a dynamic type: we first convert the literal to the root type
-- and then convert the result to the target type, the goal being
- -- to avoid doing range checks in Universal_Integer type.
+ -- to avoid doing range checks in universal integer.
elsif Is_Integer_Type (Target_Typ)
and then not Is_Generic_Type (Root_Type (Target_Typ))
@@ -12639,6 +12637,17 @@ package body Sem_Res is
then
Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
Analyze_And_Resolve (Operand);
+
+ -- If the expression is a conversion to universal integer of an
+ -- an expression with an integer type, then we can eliminate the
+ -- intermediate conversion to universal integer.
+
+ elsif Nkind (Operand) = N_Type_Conversion
+ and then Entity (Subtype_Mark (Operand)) = Universal_Integer
+ and then Is_Integer_Type (Etype (Expression (Operand)))
+ then
+ Rewrite (Operand, Relocate_Node (Expression (Operand)));
+ Analyze_And_Resolve (Operand);
end if;
end;
end if;
--- gcc/ada/tbuild.adb
+++ gcc/ada/tbuild.adb
@@ -119,16 +119,6 @@ package body Tbuild is
if Present (Etype (Expr)) and then Etype (Expr) = Typ then
return Relocate_Node (Expr);
- -- Case where the expression is a conversion to universal integer of
- -- an expression with an integer type, and we can thus eliminate the
- -- intermediate conversion to universal integer.
-
- elsif Nkind (Expr) = N_Type_Conversion
- and then Entity (Subtype_Mark (Expr)) = Universal_Integer
- and then Is_Integer_Type (Etype (Expression (Expr)))
- then
- return Convert_To (Typ, Expression (Expr));
-
else
Result :=
Make_Type_Conversion (Sloc (Expr),
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Ada] Get rid of more references to Universal_Integer in expanded code
@ 2020-06-03 10:03 Pierre-Marie de Rodat
0 siblings, 0 replies; 5+ messages in thread
From: Pierre-Marie de Rodat @ 2020-06-03 10:03 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 478 bytes --]
This fixes a couple of places to using the standard idiom for choosing
an appropriately-sized integer type. No practical change since the old
and the new type are effectively identical.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-03 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_attr.adb (Attribute_Valid): Use Standard_Long_Long_Integer
in lieu of Universal_Integer as large integer type.
* exp_ch3.adb (Expand_Freeze_Enumeration_Type): Likewise.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 737 bytes --]
--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -6924,7 +6924,7 @@ package body Exp_Attr is
if Esize (Ptyp) <= Esize (Standard_Integer) then
PBtyp := Standard_Integer;
else
- PBtyp := Universal_Integer;
+ PBtyp := Standard_Long_Long_Integer;
end if;
Rewrite (N, Make_Range_Test);
--- gcc/ada/exp_ch3.adb
+++ gcc/ada/exp_ch3.adb
@@ -4806,7 +4806,7 @@ package body Exp_Ch3 is
if Esize (Typ) <= Standard_Integer_Size then
Ityp := Standard_Integer;
else
- Ityp := Universal_Integer;
+ Ityp := Standard_Long_Long_Integer;
end if;
-- Representations are unsigned
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Ada] Get rid of more references to Universal_Integer in expanded code
@ 2020-06-03 10:03 Pierre-Marie de Rodat
0 siblings, 0 replies; 5+ messages in thread
From: Pierre-Marie de Rodat @ 2020-06-03 10:03 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 610 bytes --]
This changes a few places in the System.Atomic_Operations packages to
using static expressions, which guarantees that contant folding is done
in the front-end instead of the code generator.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-03 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* libgnat/s-atopar.adb (Atomic_Fetch_And_Add): Make use of an
equivalent static expression.
(Atomic_Fetch_And_Subtract): Likewise.
(Is_Lock_Free): Likewise.
* libgnat/s-atopex.adb (Atomic_Exchange): Likewise.
(Atomic_Compare_And_Exchange): Likewise.
(Is_Lock_Free): Likewise.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 2467 bytes --]
--- gcc/ada/libgnat/s-atopar.adb
+++ gcc/ada/libgnat/s-atopar.adb
@@ -88,7 +88,7 @@ package body System.Atomic_Operations.Arithmetic is
pragma Warnings (On);
begin
- case Item'Size is
+ case Atomic_Type'Size is
when 8 => return Atomic_Fetch_Add_1 (Item'Address, Value);
when 16 => return Atomic_Fetch_Add_2 (Item'Address, Value);
when 32 => return Atomic_Fetch_Add_4 (Item'Address, Value);
@@ -125,7 +125,7 @@ package body System.Atomic_Operations.Arithmetic is
pragma Warnings (On);
begin
- case Item'Size is
+ case Atomic_Type'Size is
when 8 => return Atomic_Fetch_Sub_1 (Item'Address, Value);
when 16 => return Atomic_Fetch_Sub_2 (Item'Address, Value);
when 32 => return Atomic_Fetch_Sub_4 (Item'Address, Value);
@@ -139,9 +139,10 @@ package body System.Atomic_Operations.Arithmetic is
------------------
function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
+ pragma Unreferenced (Item);
use type Interfaces.C.size_t;
begin
- return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
+ return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Size / 8));
end Is_Lock_Free;
end System.Atomic_Operations.Arithmetic;
--- gcc/ada/libgnat/s-atopex.adb
+++ gcc/ada/libgnat/s-atopex.adb
@@ -66,7 +66,7 @@ package body System.Atomic_Operations.Exchange is
pragma Warnings (On);
begin
- case Item'Size is
+ case Atomic_Type'Size is
when 8 => return Atomic_Exchange_1 (Item'Address, Value);
when 16 => return Atomic_Exchange_2 (Item'Address, Value);
when 32 => return Atomic_Exchange_4 (Item'Address, Value);
@@ -124,7 +124,7 @@ package body System.Atomic_Operations.Exchange is
pragma Warnings (On);
begin
- case Item'Size is
+ case Atomic_Type'Size is
when 8 =>
return Boolean
(Atomic_Compare_Exchange_1
@@ -151,9 +151,10 @@ package body System.Atomic_Operations.Exchange is
------------------
function Is_Lock_Free (Item : aliased Atomic_Type) return Boolean is
+ pragma Unreferenced (Item);
use type Interfaces.C.size_t;
begin
- return Boolean (Atomic_Always_Lock_Free (Item'Size / 8));
+ return Boolean (Atomic_Always_Lock_Free (Atomic_Type'Size / 8));
end Is_Lock_Free;
end System.Atomic_Operations.Exchange;
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Ada] Get rid of more references to Universal_Integer in expanded code
@ 2020-06-03 10:03 Pierre-Marie de Rodat
0 siblings, 0 replies; 5+ messages in thread
From: Pierre-Marie de Rodat @ 2020-06-03 10:03 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 1137 bytes --]
This further tweaks the expanded code generated by the front-end
for attributes returning Universal_Integer, in particular removes
hardcoded references to it and fixes a couple of type mismatches
in the process.
The only observable change is that 'Val is now expanded by the
front-end for integer types, for the sake of consistency with 'Pos.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-03 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_attr.adb (Expand_N_Attribute_Reference) <Enum_Rep>:
In the case of an enumeration type, do an intermediate
conversion to a small integer type. Remove useless stuff.
<Finalization_Size>: Do not hardcode Universal_Integer and
fix a type mismatch in the assignment to the variable.
<Max_Size_In_Storage_Elements>: Likewise.
<From_Any>: Do not redefine the Ptyp local variable.
<To_Any>: Likewise.
<TypeCode>: Likewise.
<Pos>: Small tweaks.
<Val>: For an enumeration type with standard representation,
apply the range check to the expression of a convertion to
Universal_Integer, if any. For an integer type, expand to
a mere conversion.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 14535 bytes --]
--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -2817,7 +2817,7 @@ package body Exp_Attr is
-- If the prefix is an access to object, the attribute applies to
-- the designated object, so rewrite with an explicit dereference.
- elsif Is_Access_Type (Etype (Pref))
+ elsif Is_Access_Type (Ptyp)
and then
(not Is_Entity_Name (Pref) or else Is_Object (Entity (Pref)))
then
@@ -3133,6 +3133,8 @@ 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
@@ -3180,11 +3182,34 @@ package body Exp_Attr is
-- make sure that the analyzer does not complain about what otherwise
-- might be an illegal conversion.
+ -- However the target type is universal integer in most cases, which
+ -- is a very large type, so in the case of an enumeration type, we
+ -- first convert to a small signed integer type in order not to lose
+ -- the size information.
+
+ elsif 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));
+ Convert_To_And_Rewrite (Typ, N);
+
else
- Rewrite (N, OK_Convert_To (Typ, Relocate_Node (Expr)));
+ Rewrite (N, OK_Convert_To (Typ, Expr));
end if;
- Set_Etype (N, Typ);
Analyze_And_Resolve (N, Typ);
end Enum_Rep;
@@ -3275,11 +3300,10 @@ package body Exp_Attr is
function Calculate_Header_Size return Node_Id is
begin
-- Generate:
- -- Universal_Integer
- -- (Header_Size_With_Padding (Pref'Alignment))
+ -- Typ (Header_Size_With_Padding (Pref'Alignment))
return
- Convert_To (Universal_Integer,
+ Convert_To (Typ,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Header_Size_With_Padding), Loc),
@@ -3307,9 +3331,7 @@ package body Exp_Attr is
-- Size : Integer := 0;
--
-- if Needs_Finalization (Pref'Tag) then
- -- Size :=
- -- Universal_Integer
- -- (Header_Size_With_Padding (Pref'Alignment));
+ -- Size := Integer (Header_Size_With_Padding (Pref'Alignment));
-- end if;
--
-- and the attribute reference is replaced with a reference to Size.
@@ -3331,8 +3353,7 @@ package body Exp_Attr is
-- Generate:
-- if Needs_Finalization (Pref'Tag) then
-- Size :=
- -- Universal_Integer
- -- (Header_Size_With_Padding (Pref'Alignment));
+ -- Integer (Header_Size_With_Padding (Pref'Alignment));
-- end if;
Make_If_Statement (Loc,
@@ -3349,7 +3370,9 @@ package body Exp_Attr is
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Size, Loc),
- Expression => Calculate_Header_Size)))));
+ Expression =>
+ Convert_To
+ (Standard_Integer, Calculate_Header_Size))))));
Rewrite (N, New_Occurrence_Of (Size, Loc));
@@ -3556,16 +3579,15 @@ package body Exp_Attr is
--------------
when Attribute_From_Any => From_Any : declare
- P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
Rewrite (N,
- Build_From_Any_Call (P_Type,
+ Build_From_Any_Call (Ptyp,
Relocate_Node (First (Exprs)),
Decls));
Insert_Actions (N, Decls);
- Analyze_And_Resolve (N, P_Type);
+ Analyze_And_Resolve (N, Ptyp);
end From_Any;
----------------------
@@ -4417,6 +4439,7 @@ package body Exp_Attr is
when Attribute_Max_Size_In_Storage_Elements => declare
Typ : constant Entity_Id := Etype (N);
Attr : Node_Id;
+ Atyp : Entity_Id;
Conversion_Added : Boolean := False;
-- A flag which tracks whether the original attribute has been
@@ -4457,16 +4480,17 @@ package body Exp_Attr is
then
Set_Header_Size_Added (Attr);
+ Atyp := Etype (Attr);
+
-- Generate:
-- P'Max_Size_In_Storage_Elements +
- -- Universal_Integer
- -- (Header_Size_With_Padding (Ptyp'Alignment))
+ -- Atyp (Header_Size_With_Padding (Ptyp'Alignment))
Rewrite (Attr,
Make_Op_Add (Loc,
Left_Opnd => Relocate_Node (Attr),
Right_Opnd =>
- Convert_To (Universal_Integer,
+ Convert_To (Atyp,
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
@@ -4478,16 +4502,14 @@ package body Exp_Attr is
New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_Alignment))))));
+ Analyze_And_Resolve (Attr, Atyp);
+
-- Add a conversion to the target type
if not Conversion_Added then
- Rewrite (Attr,
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Typ, Loc),
- Expression => Relocate_Node (Attr)));
+ Convert_To_And_Rewrite (Typ, Attr);
end if;
- Analyze (Attr);
return;
end if;
end;
@@ -5097,12 +5119,12 @@ 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 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
+ -- The call has the form:
-- _rep_to_pos (expr, flag)
@@ -5110,11 +5132,11 @@ 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 integer types, Pos is equivalent to a simple integer
- -- conversion and we rewrite it as such
+ -- For integer types, Pos is equivalent to a simple integer conversion
+ -- and we rewrite it as such.
when Attribute_Pos => Pos : declare
- Etyp : Entity_Id := Base_Type (Entity (Pref));
+ Etyp : Entity_Id := Base_Type (Ptyp);
begin
-- Deal with zero/non-zero boolean values
@@ -6420,13 +6442,12 @@ package body Exp_Attr is
------------
when Attribute_To_Any => To_Any : declare
- P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
Rewrite (N,
Build_To_Any_Call
(Loc,
- Convert_To (P_Type,
+ Convert_To (Ptyp,
Relocate_Node (First (Exprs))), Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, RTE (RE_Any));
@@ -6450,10 +6471,9 @@ package body Exp_Attr is
--------------
when Attribute_TypeCode => TypeCode : declare
- P_Type : constant Entity_Id := Etype (Pref);
Decls : constant List_Id := New_List;
begin
- Rewrite (N, Build_TypeCode_Call (Loc, P_Type, Decls));
+ Rewrite (N, Build_TypeCode_Call (Loc, Ptyp, Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, RTE (RE_TypeCode));
end TypeCode;
@@ -6489,63 +6509,91 @@ package body Exp_Attr is
-- Val --
---------
- -- For enumeration types with a standard representation, and for all
- -- other types, 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.
+ -- 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 integer types, Val is equivalent to a simple integer conversion
+ -- and we rewrite it as such.
when Attribute_Val => Val : declare
- Etyp : constant Entity_Id := Base_Type (Entity (Pref));
+ Etyp : constant Entity_Id := Base_Type (Ptyp);
+ Expr : constant Node_Id := First (Exprs);
begin
- if Is_Enumeration_Type (Etyp)
- and then 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,
- Relocate_Node (First (Exprs))))));
+ -- Case of enumeration type
- begin
+ if Is_Enumeration_Type (Etyp) then
+
+ -- 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)));
+
+ 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;
+
+ else
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;
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
+ Expressions => New_List (
+ Convert_To (Standard_Integer, Expr))));
+ end if;
- else
- Rewrite (N,
- Make_Indexed_Component (Loc,
- Prefix => New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
- Expressions => New_List (
- Convert_To (Standard_Integer,
- Relocate_Node (First (Exprs))))));
- end if;
+ Analyze_And_Resolve (N, Typ);
- Analyze_And_Resolve (N, Typ);
+ -- Standard enumeration type
+
+ -- If the argument is marked as requiring a range check then
+ -- generate it here, after looking through a conversion to
+ -- universal integer, if any.
+
+ 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);
- -- If the argument is marked as requiring a range check then generate
- -- it here.
+ else
+ Generate_Range_Check (Expr, Etyp, CE_Range_Check_Failed);
+ end if;
+ end if;
- elsif Do_Range_Check (First (Exprs)) then
- Generate_Range_Check (First (Exprs), Etyp, CE_Range_Check_Failed);
+ -- Deal with integer types
+
+ elsif Is_Integer_Type (Etyp) then
+ Rewrite (N, Convert_To (Typ, Expr));
+ Analyze_And_Resolve (N, Typ);
end if;
end Val;
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Ada] Get rid of more references to Universal_Integer in expanded code
@ 2020-06-02 8:59 Pierre-Marie de Rodat
0 siblings, 0 replies; 5+ messages in thread
From: Pierre-Marie de Rodat @ 2020-06-02 8:59 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 1480 bytes --]
This further tweaks the expanded code generated by the front-end, so as
to avoid having references to Universal_Integer reaching the code
generator, either directly or indirectly through attributes returning
Universal_Integer. There is also a minor tweak to the a-sequio.adb unit
of the runtime to the same effect.
The reason is that Universal_Integer must be a type as large as the
largest supported integer type and, therefore, can be much larger than
what is really needed here.
No functional changes.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-02 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_aggr.adb (Build_Array_Aggr_Code): Set the type of the PAT
on the zero used to clear the array.
* exp_attr.adb (Expand_N_Attribute_Reference)
<Attribute_Alignment>: In the CW case, directly convert from the
alignment's type to the target type if the parent is an
unchecked conversion.
* sem_res.adb (Set_String_Literal_Subtype): In the dynamic case,
use the general expression for the upper bound only when needed.
Set the base type of the index as the type of the low bound.
(Simplify_Type_Conversion): Do an intermediate conversion to the
root type of the target type if the operand is an integer
literal.
* tbuild.adb (Convert_To): Get rid of an intermediate conversion
to Universal_Integer if the inner expression has integer tyoe.
* libgnat/a-sequio.adb (Byte_Swap): Make use of an equivalent
static expression in the case statement.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 9630 bytes --]
--- gcc/ada/exp_aggr.adb
+++ gcc/ada/exp_aggr.adb
@@ -2043,12 +2043,15 @@ package body Exp_Aggr is
and then Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Impl_Type (Typ))
then
- Append_To (New_Code,
- Make_Assignment_Statement (Loc,
- Name => New_Copy_Tree (Into),
- Expression =>
- Unchecked_Convert_To (Typ,
- Make_Integer_Literal (Loc, Uint_0))));
+ declare
+ Zero : constant Node_Id := Make_Integer_Literal (Loc, Uint_0);
+ begin
+ Analyze_And_Resolve (Zero, Packed_Array_Impl_Type (Typ));
+ Append_To (New_Code,
+ Make_Assignment_Statement (Loc,
+ Name => New_Copy_Tree (Into),
+ Expression => Unchecked_Convert_To (Typ, Zero)));
+ end;
end if;
-- If the component type contains tasks, we need to build a Master
--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -2459,12 +2459,20 @@ package body Exp_Attr is
New_Node := Build_Get_Alignment (Loc, New_Node);
+ -- Case where the context is an unchecked conversion to a specific
+ -- integer type. We directly convert from the alignment's type.
+
+ if Nkind (Parent (N)) = N_Unchecked_Type_Conversion then
+ Rewrite (N, New_Node);
+ Analyze_And_Resolve (N);
+ return;
+
-- Case where the context is a specific integer type with which
-- the original attribute was compatible. But the alignment has a
-- specific type in a-tags.ads (Standard.Natural) so, in order to
-- preserve type compatibility, we must convert explicitly.
- if Typ /= Standard_Natural then
+ elsif Typ /= Standard_Natural then
New_Node := Convert_To (Typ, New_Node);
end if;
--- gcc/ada/libgnat/a-sequio.adb
+++ gcc/ada/libgnat/a-sequio.adb
@@ -73,7 +73,7 @@ package body Ada.Sequential_IO is
procedure Byte_Swap (Siz : in out size_t) is
use System.Byte_Swapping;
begin
- case Siz'Size is
+ case size_t'Size is
when 32 => Siz := size_t (Bswap_32 (U32 (Siz)));
when 64 => Siz := size_t (Bswap_64 (U64 (Siz)));
when others => raise Program_Error;
--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -266,7 +266,8 @@ package body Sem_Res is
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. Currently simplifies a combination of floating-point
- -- to integer conversion and Rounding or Truncation attribute.
+ -- to integer conversion and Rounding or Truncation attribute, and also the
+ -- conversion of an integer literal to a dynamic integer type.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
@@ -12477,37 +12478,51 @@ package body Sem_Res is
-- If the lower bound is not static we create a range for the string
-- literal, using the index type and the known length of the literal.
- -- The index type is not necessarily Positive, so the upper bound is
- -- computed as T'Val (T'Pos (Low_Bound) + L - 1).
+ -- If the length is 1, then the upper bound is set to a mere copy of
+ -- the lower bound; or else, if the index type is a signed integer,
+ -- then the upper bound is computed as Low_Bound + L - 1; otherwise,
+ -- the upper bound is computed as T'Val (T'Pos (Low_Bound) + L - 1).
else
declare
- Index_List : constant List_Id := New_List;
- Index_Type : constant Entity_Id := Etype (First_Index (Typ));
- High_Bound : constant Node_Id :=
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Val,
- Prefix =>
- New_Occurrence_Of (Index_Type, Loc),
- Expressions => New_List (
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Pos,
- Prefix =>
- New_Occurrence_Of (Index_Type, Loc),
- Expressions =>
- New_List (New_Copy_Tree (Low_Bound))),
- Right_Opnd =>
- Make_Integer_Literal (Loc,
- String_Length (Strval (N)) - 1))));
-
+ Length : constant Nat := String_Length (Strval (N));
+ Index_List : constant List_Id := New_List;
+ Index_Type : constant Entity_Id := Etype (First_Index (Typ));
Array_Subtype : Entity_Id;
Drange : Node_Id;
+ High_Bound : Node_Id;
Index : Node_Id;
Index_Subtype : Entity_Id;
begin
+ if Length = 1 then
+ High_Bound := New_Copy_Tree (Low_Bound);
+
+ elsif Is_Signed_Integer_Type (Index_Type) then
+ High_Bound :=
+ Make_Op_Add (Loc,
+ Left_Opnd => New_Copy_Tree (Low_Bound),
+ Right_Opnd => Make_Integer_Literal (Loc, Length - 1));
+
+ else
+ High_Bound :=
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Val,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions => New_List (
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Pos,
+ Prefix =>
+ New_Occurrence_Of (Index_Type, Loc),
+ Expressions =>
+ New_List (New_Copy_Tree (Low_Bound))),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, Length - 1))));
+ end if;
+
if Is_Integer_Type (Index_Type) then
Set_String_Literal_Low_Bound
(Subtype_Id, Make_Integer_Literal (Loc, 1));
@@ -12522,10 +12537,10 @@ package body Sem_Res is
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (Base_Type (Index_Type), Loc)));
- Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
end if;
- Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
+ Analyze_And_Resolve
+ (String_Literal_Low_Bound (Subtype_Id), Base_Type (Index_Type));
-- Build bona fide subtype for the string, and wrap it in an
-- unchecked conversion, because the back end expects the
@@ -12611,6 +12626,19 @@ package body Sem_Res is
Relocate_Node (First (Expressions (Operand))));
Set_Float_Truncate (N, Truncate);
end;
+
+ -- Special processing for the conversion of an integer literal to
+ -- a dynamic type: we first convert the literal to the root type
+ -- and then convert the result to the target type, the goal being
+ -- to avoid doing range checks in Universal_Integer type.
+
+ elsif Is_Integer_Type (Target_Typ)
+ and then not Is_Generic_Type (Root_Type (Target_Typ))
+ and then Nkind (Operand) = N_Integer_Literal
+ and then Opnd_Typ = Universal_Integer
+ then
+ Convert_To_And_Rewrite (Root_Type (Target_Typ), Operand);
+ Analyze_And_Resolve (Operand);
end if;
end;
end if;
--- gcc/ada/tbuild.adb
+++ gcc/ada/tbuild.adb
@@ -116,10 +116,19 @@ package body Tbuild is
Result : Node_Id;
begin
- if Present (Etype (Expr))
- and then (Etype (Expr)) = Typ
- then
+ if Present (Etype (Expr)) and then Etype (Expr) = Typ then
return Relocate_Node (Expr);
+
+ -- Case where the expression is a conversion to universal integer of
+ -- an expression with an integer type, and we can thus eliminate the
+ -- intermediate conversion to universal integer.
+
+ elsif Nkind (Expr) = N_Type_Conversion
+ and then Entity (Subtype_Mark (Expr)) = Universal_Integer
+ and then Is_Integer_Type (Etype (Expression (Expr)))
+ then
+ return Convert_To (Typ, Expression (Expr));
+
else
Result :=
Make_Type_Conversion (Sloc (Expr),
@@ -853,8 +862,8 @@ package body Tbuild is
then
return Relocate_Node (Expr);
- -- Cases where the inner expression is itself an unchecked conversion
- -- to the same type, and we can thus eliminate the outer conversion.
+ -- Case where the expression is itself an unchecked conversion to
+ -- the same type, and we can thus eliminate the outer conversion.
elsif Nkind (Expr) = N_Unchecked_Type_Conversion
and then Entity (Subtype_Mark (Expr)) = Typ
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2020-06-03 10:03 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-02 8:59 [Ada] Get rid of more references to Universal_Integer in expanded code Pierre-Marie de Rodat
-- strict thread matches above, loose matches on Subject: below --
2020-06-03 10:03 Pierre-Marie de Rodat
2020-06-03 10:03 Pierre-Marie de Rodat
2020-06-03 10:03 Pierre-Marie de Rodat
2020-06-02 8:59 Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).