aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2022-12-06 11:37:27 -0500
committerMarc Poulhiès <poulhies@adacore.com>2023-01-03 10:29:52 +0100
commit7512dcc94236d247ceef8cef6d36392a86e271a0 (patch)
tree7c7bd8fdd70250907dc78c7bf8b24eb24aa188be /gcc
parent930b81af5b0207585819ea9988a0f50d009940a7 (diff)
downloadgcc-7512dcc94236d247ceef8cef6d36392a86e271a0.zip
gcc-7512dcc94236d247ceef8cef6d36392a86e271a0.tar.gz
gcc-7512dcc94236d247ceef8cef6d36392a86e271a0.tar.bz2
ada: Simplify [Small_]Integer_Type_For
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_attr.adb25
-rw-r--r--gcc/ada/exp_ch4.adb4
-rw-r--r--gcc/ada/exp_util.adb37
-rw-r--r--gcc/ada/sem_util.ads18
4 files changed, 29 insertions, 55 deletions
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b7554e0..50cb307 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 a8980a6..148b160 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 84b0c0e..5ab0d30 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 b647e68..b61695e 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.