From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id AD7B93858D1E; Tue, 3 Jan 2023 09:33:43 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AD7B93858D1E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1672738423; bh=lIgrn26U5IlgMA1gTr7Rlnu6caeOxQ87+TzvPpLVH9k=; h=From:To:Subject:Date:From; b=NPXesbxML4+7OxCgGDEOgUNxIArVVWagvrCuve+d3x9oE6XbuaXSrrPDIbkfcBlH1 7OTa/bXKdpqWm/rYNVw6yNfH7FmT0+zhTkOCGQsWVg2V3zNUuEY4ylwGkBMrr4pzRt +c4HYIH4o4+bYdKBARTCuuaprhK5rT+re7LG61XE= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-4960] ada: Simplify [Small_]Integer_Type_For X-Act-Checkin: gcc X-Git-Author: Bob Duff X-Git-Refname: refs/heads/master X-Git-Oldrev: 930b81af5b0207585819ea9988a0f50d009940a7 X-Git-Newrev: 7512dcc94236d247ceef8cef6d36392a86e271a0 Message-Id: <20230103093343.AD7B93858D1E@sourceware.org> Date: Tue, 3 Jan 2023 09:33:43 +0000 (GMT) List-Id: https://gcc.gnu.org/g:7512dcc94236d247ceef8cef6d36392a86e271a0 commit r13-4960-g7512dcc94236d247ceef8cef6d36392a86e271a0 Author: Bob Duff Date: Tue Dec 6 11:37:27 2022 -0500 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. Diff: --- 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.