From: Bob Duff <d...@adacore.com>
Make Small_Integer_Type_For call Integer_Type_For,
so they share most of the code.
Remove Standard_Long_Integer from consideration,
because that's different on different machines (32- or 64-bit).
Standard_Integer or Standard_Long_Long_Integer will be
chosen.
gcc/ada/
* exp_util.adb (Integer_Type_For): Assertion and comment.
(Small_Integer_Type_For): Remove some code and call
Integer_Type_For instead.
* sem_util.ads (Rep_To_Pos_Flag): Improve comments. "Standard_..."
seems overly pedantic here.
* exp_attr.adb (Succ, Pred): Clean up: make the code as similar as
possible.
* exp_ch4.adb: Minor: named notation.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_attr.adb | 25 +++++++++++--------------
gcc/ada/exp_ch4.adb | 4 ++--
gcc/ada/exp_util.adb | 37 +++++++------------------------------
gcc/ada/sem_util.ads | 18 +++++++++---------
4 files changed, 29 insertions(+), 55 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b7554e05f77..50cb307a152 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5638,9 +5638,7 @@ package body Exp_Attr is
Make_Integer_Literal (Loc, 1))));
else
- -- Add Boolean parameter True, to request program error if
- -- we have a bad representation on our hands. If checks are
- -- suppressed, then add False instead
+ -- Add Boolean parameter depending on check suppression
Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
Rewrite (N,
@@ -5650,13 +5648,13 @@ package body Exp_Attr is
(Enum_Pos_To_Rep (Etyp), Loc),
Expressions => New_List (
Make_Op_Subtract (Loc,
- Left_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (TSS (Etyp, TSS_Rep_To_Pos), Loc),
- Parameter_Associations => Exprs),
- Right_Opnd => Make_Integer_Literal (Loc, 1)))));
+ Left_Opnd =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of
+ (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+ Parameter_Associations => Exprs),
+ Right_Opnd => Make_Integer_Literal (Loc, 1)))));
end if;
-- Suppress checks since they have all been done above
@@ -6771,9 +6769,7 @@ package body Exp_Attr is
Make_Integer_Literal (Loc, 1))));
else
- -- Add Boolean parameter True, to request program error if
- -- we have a bad representation on our hands. Add False if
- -- checks are suppressed.
+ -- Add Boolean parameter depending on check suppression
Append_To (Exprs, Rep_To_Pos_Flag (Ptyp, Loc));
Rewrite (N,
@@ -6797,7 +6793,8 @@ package body Exp_Attr is
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)
+ -- floating-point attribute function in Fat_xxx (xxx is root type).
+ -- Note that this function takes care of the overflow case.
elsif Is_Floating_Point_Type (Ptyp) then
Expand_Fpt_Attribute_R (N);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a8980a63d46..148b160b792 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -11836,7 +11836,7 @@ package body Exp_Ch4 is
if Is_Fixed_Point_Type (Etype (Expr)) then
Ityp := Small_Integer_Type_For
- (Esize (Base_Type (Etype (Expr))), False);
+ (Esize (Base_Type (Etype (Expr))), Uns => False);
-- Generate a temporary with the integer type to facilitate in the
-- C backend the code generation for the unchecked conversion.
@@ -12206,7 +12206,7 @@ package body Exp_Ch4 is
declare
Expr_Id : constant Entity_Id := Make_Temporary (Loc, 'T', Conv);
Int_Typ : constant Entity_Id :=
- Small_Integer_Type_For (RM_Size (Btyp), False);
+ Small_Integer_Type_For (RM_Size (Btyp), Uns => False);
begin
-- Generate a temporary with the integer value. Required in the
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 84b0c0e2941..5ab0d3039ca 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8122,6 +8122,10 @@ package body Exp_Util is
function Integer_Type_For (S : Uint; Uns : Boolean) return Entity_Id is
begin
+ pragma Assert
+ (Standard_Long_Integer_Size in
+ Standard_Integer_Size | Standard_Long_Long_Integer_Size);
+ -- So we don't need to check for Standard_Long_Integer_Size below
pragma Assert (S <= System_Max_Integer_Size);
-- This is the canonical 32-bit type
@@ -14023,7 +14027,8 @@ package body Exp_Util is
function Small_Integer_Type_For (S : Uint; Uns : Boolean) return Entity_Id
is
begin
- pragma Assert (S <= System_Max_Integer_Size);
+ -- The only difference between this and Integer_Type_For is that this
+ -- can return small (8- or 16-bit) types.
if S <= Standard_Short_Short_Integer_Size then
if Uns then
@@ -14039,36 +14044,8 @@ package body Exp_Util is
return Standard_Short_Integer;
end if;
- elsif S <= Standard_Integer_Size then
- if Uns then
- return Standard_Unsigned;
- else
- return Standard_Integer;
- end if;
-
- elsif S <= Standard_Long_Integer_Size then
- if Uns then
- return Standard_Long_Unsigned;
- else
- return Standard_Long_Integer;
- end if;
-
- elsif S <= Standard_Long_Long_Integer_Size then
- if Uns then
- return Standard_Long_Long_Unsigned;
- else
- return Standard_Long_Long_Integer;
- end if;
-
- elsif S <= Standard_Long_Long_Long_Integer_Size then
- if Uns then
- return Standard_Long_Long_Long_Unsigned;
- else
- return Standard_Long_Long_Long_Integer;
- end if;
-
else
- raise Program_Error;
+ return Integer_Type_For (S, Uns);
end if;
end Small_Integer_Type_For;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b647e68ff7f..b61695ea729 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2976,16 +2976,16 @@ package Sem_Util is
function Rep_To_Pos_Flag (E : Entity_Id; Loc : Source_Ptr) return Node_Id;
-- This is used to construct the second argument in a call to Rep_To_Pos
- -- which is Standard_True if range checks are enabled (E is an entity to
- -- which the Range_Checks_Suppressed test is applied), and Standard_False
- -- if range checks are suppressed. Loc is the location for the node that
- -- is returned (which is a New_Occurrence of the appropriate entity).
+ -- which is True if range checks are enabled (E is an entity to which the
+ -- Range_Checks_Suppressed test is applied), and False if range checks are
+ -- suppressed. Loc is the location for the node that is returned (which is
+ -- a New_Occurrence of the appropriate entity).
--
- -- Note: one might think that it would be fine to always use True and
- -- to ignore the suppress in this case, but it is generally better to
- -- believe a request to suppress exceptions if possible, and further
- -- more there is at least one case in the generated code (the code for
- -- array assignment in a loop) that depends on this suppression.
+ -- Note: one might think that it would be fine to always use True and to
+ -- ignore the suppress in this case, but there is at least one case in the
+ -- generated code (the code for array assignment in a loop) that depends on
+ -- this suppression. Anyway, it is generally better to believe a request to
+ -- suppress exceptions if possible.
procedure Require_Entity (N : Node_Id);
-- N is a node which should have an entity value if it is an entity name.
--
2.34.1
