[gcc(refs/users/marxin/heads/vect_cond_expr-rework-v6)] [Ada] Get rid of more references to Universal_Integer in expanded code
Martin Liska
marxin@gcc.gnu.org
Wed Jun 3 08:06:11 GMT 2020
https://gcc.gnu.org/g:445514c037052ee4ff513a957e7c21bee36ad0d5
commit 445514c037052ee4ff513a957e7c21bee36ad0d5
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri Dec 20 16:57:50 2019 +0100
[Ada] Get rid of more references to Universal_Integer in expanded code
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.
Diff:
---
gcc/ada/exp_aggr.adb | 15 +++++----
gcc/ada/exp_attr.adb | 10 +++++-
gcc/ada/libgnat/a-sequio.adb | 2 +-
gcc/ada/sem_res.adb | 78 ++++++++++++++++++++++++++++++--------------
gcc/ada/tbuild.adb | 19 ++++++++---
5 files changed, 86 insertions(+), 38 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f4b959516d7..05508d821d4 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/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
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 731d223122c..a4957b38f59 100644
--- a/gcc/ada/exp_attr.adb
+++ b/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;
diff --git a/gcc/ada/libgnat/a-sequio.adb b/gcc/ada/libgnat/a-sequio.adb
index 9519a871fa5..95a95a2d372 100644
--- a/gcc/ada/libgnat/a-sequio.adb
+++ b/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;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 21cbe0aa8a5..ee9772cfca8 100644
--- a/gcc/ada/sem_res.adb
+++ b/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;
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index bb5532d9b8f..1302d97ea85 100644
--- a/gcc/ada/tbuild.adb
+++ b/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
More information about the Gcc-cvs
mailing list