From patchwork Mon Jul 4 07:50:23 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1651831 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=C56eLJAS; dkim-atps=neutral Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4Lbyjv6t6hz9s5V for ; Mon, 4 Jul 2022 17:53:55 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 944A53852771 for ; Mon, 4 Jul 2022 07:53:53 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 944A53852771 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1656921233; bh=YbGmfKfN1RBbu9MDhlYgabGmL+Iq+La0WKVUCLfeXec=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=C56eLJASc6+8LXjZFonIfRERj/BbTndjPJRD6pbp36xgT0McHkUqfFTZxAmZoJoiQ SQESSt8ohKEJV4WDdYuZsm4QQjvmSRSXYWpnpzCzvxOfm5KGaNv/JiThjxbnXMUQEk ODVvwyd4uRV39UJdk8pjQAEJZJk/ujJjGfTsVYU4= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ej1-x633.google.com (mail-ej1-x633.google.com [IPv6:2a00:1450:4864:20::633]) by sourceware.org (Postfix) with ESMTPS id BA8783851A97 for ; Mon, 4 Jul 2022 07:50:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org BA8783851A97 Received: by mail-ej1-x633.google.com with SMTP id h23so15182826ejj.12 for ; Mon, 04 Jul 2022 00:50:24 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=YbGmfKfN1RBbu9MDhlYgabGmL+Iq+La0WKVUCLfeXec=; b=JP47F/1eoZtUJg7O8Bf8do+88Suohafb0JBk6/Mg5dvEG4Y4elbN2o4oVbRHsni5BH eAGqWQDBUglSXoytSdpH7D+Sn6K11/49jQZuImhKzIPhOj2sdVwIkmCEsYmgSLBR6pJZ lI5p+ssjfVIZhuW+mju4DQ2sQlpN3d2eY1Iy+CFl44J+kx3Yl8W/nJSDM63VIVEsuX8M taylB2bU5H1qkq1iJC0/XPUxc/64JAj8UbwkpGFr3RRJPMiVQtvcauio0c74Unfuisjg Rk2yiL/1vEP7xCjB1GnMrkcxSCsnShTxBVsmPmqtE8kLHjL6MblgP4T3uwUQura2FKLa I3uw== X-Gm-Message-State: AJIora8BgoS6zheo9QGMHFBH8MTqtOBz8iwRhK7moyz5RcOgikg1JXBN bqbQZuIg9/BRjfqgFFdCplvnpx8BIuJNTg== X-Google-Smtp-Source: AGRyM1tIe1fpflYcxPMbBU92gLf4Lpf0qLyFSsIMbEKflfoqGsG0kCzWGLcl0H9gs3ETMmx7pAkkjg== X-Received: by 2002:a17:907:168f:b0:726:327e:2418 with SMTP id hc15-20020a170907168f00b00726327e2418mr26368650ejc.542.1656921024313; Mon, 04 Jul 2022 00:50:24 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id fi18-20020a056402551200b0043a43fcde13sm2012043edb.13.2022.07.04.00.50.23 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 04 Jul 2022 00:50:23 -0700 (PDT) Date: Mon, 4 Jul 2022 07:50:23 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Use static stack allocation for small dynamic string concatenations Message-ID: <20220704075023.GA99290@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Eric Botcazou Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This changes the expanded code generated for dynamic concatenations to use a static array subtype for the temporary created on the stack if a small upper bound can be computed for the length of the result. Static stack allocation is preferred over dynamic allocation for code generation purposes. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Expand_N_Object_Declaration.Rewrite_As_Renaming): Be prepared for slices. * exp_ch4.adb (Get_First_Index_Bounds): New procedure. (Expand_Array_Comparison.Length_Less_Than_4): Call it. (Expand_Concatenate): Try to compute a maximum length for operands with variable length and a maximum total length at the end. If the concatenation is dynamic, but a sensible maximum total length has been computed, use this length to create a static array subtype for the temporary and return a slice of it. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6806,6 +6806,21 @@ package body Exp_Ch3 is ------------------------- function Rewrite_As_Renaming return Boolean is + + function OK_To_Rename_Entity_Name (N : Node_Id) return Boolean; + -- Return True if N denotes an entity with OK_To_Rename set + + ------------------------------ + -- OK_To_Rename_Entity_Name -- + ------------------------------ + + function OK_To_Rename_Entity_Name (N : Node_Id) return Boolean is + begin + return Is_Entity_Name (N) + and then Ekind (Entity (N)) = E_Variable + and then OK_To_Rename (Entity (N)); + end OK_To_Rename_Entity_Name; + Result : constant Boolean := -- If the object declaration appears in the form @@ -6844,10 +6859,11 @@ package body Exp_Ch3 is or else (not Aliased_Present (N) - and then Is_Entity_Name (Expr_Q) - and then Ekind (Entity (Expr_Q)) = E_Variable - and then OK_To_Rename (Entity (Expr_Q)) - and then Is_Entity_Name (Obj_Def)); + and then (OK_To_Rename_Entity_Name (Expr_Q) + or else + (Nkind (Expr_Q) = N_Slice + and then + OK_To_Rename_Entity_Name (Prefix (Expr_Q))))); begin -- ??? Return False if there are any aspect specifications, because -- otherwise we duplicate that corresponding implicit attribute diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -174,6 +174,10 @@ package body Exp_Ch4 is -- routine is to find the real type by looking up the tree. We also -- determine if the operation must be rounded. + procedure Get_First_Index_Bounds (T : Entity_Id; Lo, Hi : out Uint); + -- T is an array whose index bounds are all known at compile time. Return + -- the value of the low and high bounds of the first index of T. + function Get_Size_For_Range (Lo, Hi : Uint) return Uint; -- Return the size of a small signed integer type covering Lo .. Hi, the -- main goal being to return a size lower than that of standard types. @@ -1328,29 +1332,17 @@ package body Exp_Ch4 is if Ekind (Otyp) = E_String_Literal_Subtype then return String_Literal_Length (Otyp) < 4; - else + elsif Compile_Time_Known_Bounds (Otyp) then declare - Ityp : constant Entity_Id := Etype (First_Index (Otyp)); - Lo : constant Node_Id := Type_Low_Bound (Ityp); - Hi : constant Node_Id := Type_High_Bound (Ityp); - Lov : Uint; - Hiv : Uint; + Lo, Hi : Uint; begin - if Compile_Time_Known_Value (Lo) then - Lov := Expr_Value (Lo); - else - return False; - end if; - - if Compile_Time_Known_Value (Hi) then - Hiv := Expr_Value (Hi); - else - return False; - end if; - - return Hiv < Lov + 3; + Get_First_Index_Bounds (Otyp, Lo, Hi); + return Hi < Lo + 3; end; + + else + return False; end if; end Length_Less_Than_4; @@ -2701,6 +2693,9 @@ package body Exp_Ch4 is -- this loop is complete, always contains the last operand (which is not -- the same as Operands (NN), since null operands are skipped). + Too_Large_Max_Length : constant Unat := UI_From_Int (256); + -- Threshold from which the computation of maximum lengths is useless + -- Arrays describing the operands, only the first NN entries of each -- array are set (NN < N when we exclude known null operands). @@ -2711,10 +2706,15 @@ package body Exp_Ch4 is -- Set to the corresponding entry in the Opnds list (but note that null -- operands are excluded, so not all entries in the list are stored). - Fixed_Length : array (1 .. N) of Uint; + Fixed_Length : array (1 .. N) of Unat; -- Set to length of operand. Entries in this array are set only if the -- corresponding entry in Is_Fixed_Length is True. + Max_Length : array (1 .. N) of Unat; + -- Set to the maximum length of operand, or Too_Large_Max_Length if it + -- is not known. Entries in this array are set only if the corresponding + -- entry in Is_Fixed_Length is False; + Opnd_Low_Bound : array (1 .. N) of Node_Id; -- Set to lower bound of operand. Either an integer literal in the case -- where the bound is known at compile time, else actual lower bound. @@ -2727,17 +2727,24 @@ package body Exp_Ch4 is -- is False. The entity is of type Artyp. Aggr_Length : array (0 .. N) of Node_Id; - -- The J'th entry in an expression node that represents the total length + -- The J'th entry is an expression node that represents the total length -- of operands 1 through J. It is either an integer literal node, or a -- reference to a constant entity with the right value, so it is fine -- to just do a Copy_Node to get an appropriate copy. The extra zeroth -- entry always is set to zero. The length is of type Artyp. + Max_Aggr_Length : Unat := Too_Large_Max_Length; + -- Set to the maximum total length, or at least Too_Large_Max_Length if + -- it is not known. + Low_Bound : Node_Id := Empty; -- A tree node representing the low bound of the result (of type Ityp). -- This is either an integer literal node, or an identifier reference to -- a constant entity initialized to the appropriate value. + High_Bound : Node_Id := Empty; + -- A tree node representing the high bound of the result (of type Ityp) + Last_Opnd_Low_Bound : Node_Id := Empty; -- A tree node representing the low bound of the last operand. This -- need only be set if the result could be null. It is used for the @@ -2750,9 +2757,6 @@ package body Exp_Ch4 is -- special case of setting the right high bound for a null result. -- This is of type Ityp. - High_Bound : Node_Id := Empty; - -- A tree node representing the high bound of the result (of type Ityp) - Result : Node_Id := Empty; -- Result of the concatenation (of type Ityp) @@ -2767,7 +2771,7 @@ package body Exp_Ch4 is -- Return True if the concatenation is within the expression of the -- declaration of a library-level object. - function Make_Artyp_Literal (Val : Nat) return Node_Id; + function Make_Artyp_Literal (Val : Uint) return Node_Id; -- This function makes an N_Integer_Literal node that is returned in -- analyzed form with the type set to Artyp. Importantly this literal -- is not flagged as static, so that if we do computations with it that @@ -2810,7 +2814,7 @@ package body Exp_Ch4 is -- Make_Artyp_Literal -- ------------------------ - function Make_Artyp_Literal (Val : Nat) return Node_Id is + function Make_Artyp_Literal (Val : Uint) return Node_Id is Result : constant Node_Id := Make_Integer_Literal (Loc, Val); begin Set_Etype (Result, Artyp); @@ -2867,9 +2871,10 @@ package body Exp_Ch4 is -- Local Declarations Opnd_Typ : Entity_Id; + Slice_Rng : Entity_Id; Subtyp_Ind : Entity_Id; Ent : Entity_Id; - Len : Uint; + Len : Unat; J : Nat; Clen : Node_Id; Set : Boolean; @@ -2925,7 +2930,7 @@ package body Exp_Ch4 is -- Supply dummy entry at start of length array - Aggr_Length (0) := Make_Artyp_Literal (0); + Aggr_Length (0) := Make_Artyp_Literal (Uint_0); -- Go through operands setting up the above arrays @@ -2969,7 +2974,7 @@ package body Exp_Ch4 is elsif Nkind (Opnd) = N_String_Literal then Len := String_Literal_Length (Opnd_Typ); - if Len /= 0 then + if Len > 0 then Result_May_Be_Null := False; end if; @@ -3010,61 +3015,47 @@ package body Exp_Ch4 is else -- Check constrained case with known bounds - if Is_Constrained (Opnd_Typ) then + if Is_Constrained (Opnd_Typ) + and then Compile_Time_Known_Bounds (Opnd_Typ) + then declare - Index : constant Node_Id := First_Index (Opnd_Typ); - Indx_Typ : constant Entity_Id := Etype (Index); - Lo : constant Node_Id := Type_Low_Bound (Indx_Typ); - Hi : constant Node_Id := Type_High_Bound (Indx_Typ); + Lo, Hi : Uint; begin -- Fixed length constrained array type with known at compile -- time bounds is last case of fixed length operand. - if Compile_Time_Known_Value (Lo) - and then - Compile_Time_Known_Value (Hi) - then - declare - Loval : constant Uint := Expr_Value (Lo); - Hival : constant Uint := Expr_Value (Hi); - Len : constant Uint := - UI_Max (Hival - Loval + 1, Uint_0); + Get_First_Index_Bounds (Opnd_Typ, Lo, Hi); + Len := UI_Max (Hi - Lo + 1, Uint_0); - begin - if Len > 0 then - Result_May_Be_Null := False; - end if; + if Len > 0 then + Result_May_Be_Null := False; + end if; - -- Capture last operand bounds if result could be null + -- Capture last operand bounds if result could be null - if J = N and then Result_May_Be_Null then - Last_Opnd_Low_Bound := - Convert_To (Ityp, - Make_Integer_Literal (Loc, Expr_Value (Lo))); + if J = N and then Result_May_Be_Null then + Last_Opnd_Low_Bound := + To_Ityp (Make_Integer_Literal (Loc, Lo)); - Last_Opnd_High_Bound := - Convert_To (Ityp, - Make_Integer_Literal (Loc, Expr_Value (Hi))); - end if; + Last_Opnd_High_Bound := + To_Ityp (Make_Integer_Literal (Loc, Hi)); + end if; - -- Exclude null length case unless last operand + -- Exclude null length case unless last operand - if J < N and then Len = 0 then - goto Continue; - end if; + if J < N and then Len = 0 then + goto Continue; + end if; - NN := NN + 1; - Operands (NN) := Opnd; - Is_Fixed_Length (NN) := True; - Fixed_Length (NN) := Len; + NN := NN + 1; + Operands (NN) := Opnd; + Is_Fixed_Length (NN) := True; + Fixed_Length (NN) := Len; - Opnd_Low_Bound (NN) := - To_Ityp - (Make_Integer_Literal (Loc, Expr_Value (Lo))); - Set := True; - end; - end if; + Opnd_Low_Bound (NN) := + To_Ityp (Make_Integer_Literal (Loc, Lo)); + Set := True; end; end if; @@ -3108,6 +3099,25 @@ package body Exp_Ch4 is Var_Length (NN) := Make_Temporary (Loc, 'L'); + -- If the operand is a slice, try to compute an upper bound for + -- its length. + + if Nkind (Opnd) = N_Slice + and then Is_Constrained (Etype (Prefix (Opnd))) + and then Compile_Time_Known_Bounds (Etype (Prefix (Opnd))) + then + declare + Lo, Hi : Uint; + + begin + Get_First_Index_Bounds (Etype (Prefix (Opnd)), Lo, Hi); + Max_Length (NN) := UI_Max (Hi - Lo + 1, Uint_0); + end; + + else + Max_Length (NN) := Too_Large_Max_Length; + end if; + Append_To (Actions, Make_Object_Declaration (Loc, Defining_Identifier => Var_Length (NN), @@ -3129,8 +3139,10 @@ package body Exp_Ch4 is if NN = 1 then if Is_Fixed_Length (1) then Aggr_Length (1) := Make_Integer_Literal (Loc, Fixed_Length (1)); + Max_Aggr_Length := Fixed_Length (1); else Aggr_Length (1) := New_Occurrence_Of (Var_Length (1), Loc); + Max_Aggr_Length := Max_Length (1); end if; -- If entry is fixed length and only fixed lengths so far, make @@ -3142,6 +3154,7 @@ package body Exp_Ch4 is Aggr_Length (NN) := Make_Integer_Literal (Loc, Intval => Fixed_Length (NN) + Intval (Aggr_Length (NN - 1))); + Max_Aggr_Length := Intval (Aggr_Length (NN)); -- All other cases, construct an addition node for the length and -- create an entity initialized to this length. @@ -3151,8 +3164,11 @@ package body Exp_Ch4 is if Is_Fixed_Length (NN) then Clen := Make_Integer_Literal (Loc, Fixed_Length (NN)); + Max_Aggr_Length := Max_Aggr_Length + Fixed_Length (NN); + else Clen := New_Occurrence_Of (Var_Length (NN), Loc); + Max_Aggr_Length := Max_Aggr_Length + Max_Length (NN); end if; Append_To (Actions, @@ -3277,29 +3293,38 @@ package body Exp_Ch4 is pragma Assert (Present (Low_Bound)); - -- Now we can safely compute the upper bound, normally - -- Low_Bound + Length - 1. - - High_Bound := - To_Ityp - (Make_Op_Add (Loc, - Left_Opnd => To_Artyp (New_Copy_Tree (Low_Bound)), - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => New_Copy_Tree (Aggr_Length (NN)), - Right_Opnd => Make_Artyp_Literal (1)))); - - -- Note that calculation of the high bound may cause overflow in some - -- very weird cases, so in the general case we need an overflow check on - -- the high bound. We can avoid this for the common case of string types - -- and other types whose index is Positive, since we chose a wider range - -- for the arithmetic type. If checks are suppressed we do not set the - -- flag, and possibly superfluous warnings will be omitted. + -- Now we can compute the high bound as Low_Bound + Length - 1 - if Istyp /= Standard_Positive - and then not Overflow_Checks_Suppressed (Istyp) + if Compile_Time_Known_Value (Low_Bound) + and then Nkind (Aggr_Length (NN)) = N_Integer_Literal then - Activate_Overflow_Check (High_Bound); + High_Bound := + To_Ityp + (Make_Artyp_Literal + (Expr_Value (Low_Bound) + Intval (Aggr_Length (NN)) - 1)); + + else + High_Bound := + To_Ityp + (Make_Op_Add (Loc, + Left_Opnd => To_Artyp (New_Copy_Tree (Low_Bound)), + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => New_Copy_Tree (Aggr_Length (NN)), + Right_Opnd => Make_Artyp_Literal (Uint_1)))); + + -- Note that calculation of the high bound may cause overflow in some + -- very weird cases, so in the general case we need an overflow check + -- on the high bound. We can avoid this for the common case of string + -- types and other types whose index is Positive, since we chose a + -- wider range for the arithmetic type. If checks are suppressed, we + -- do not set the flag so superfluous warnings may be omitted. + + if Istyp /= Standard_Positive + and then not Overflow_Checks_Suppressed (Istyp) + then + Activate_Overflow_Check (High_Bound); + end if; end if; -- Handle the exceptional case where the result is null, in which case @@ -3312,7 +3337,7 @@ package body Exp_Ch4 is Expressions => New_List ( Make_Op_Eq (Loc, Left_Opnd => New_Copy_Tree (Aggr_Length (NN)), - Right_Opnd => Make_Artyp_Literal (0)), + Right_Opnd => Make_Artyp_Literal (Uint_0)), Last_Opnd_Low_Bound, Low_Bound)); @@ -3321,7 +3346,7 @@ package body Exp_Ch4 is Expressions => New_List ( Make_Op_Eq (Loc, Left_Opnd => New_Copy_Tree (Aggr_Length (NN)), - Right_Opnd => Make_Artyp_Literal (0)), + Right_Opnd => Make_Artyp_Literal (Uint_0)), Last_Opnd_High_Bound, High_Bound)); end if; @@ -3330,6 +3355,35 @@ package body Exp_Ch4 is Insert_Actions (Cnode, Actions, Suppress => All_Checks); + -- If the low bound is known at compile time and not the high bound, but + -- we have computed a sensible upper bound for the length, then adjust + -- the high bound for the subtype of the array. This will change it into + -- a static subtype and thus help the code generator. + + if Compile_Time_Known_Value (Low_Bound) + and then not Compile_Time_Known_Value (High_Bound) + and then Max_Aggr_Length < Too_Large_Max_Length + then + declare + Known_High_Bound : constant Node_Id := + To_Ityp + (Make_Artyp_Literal + (Expr_Value (Low_Bound) + Max_Aggr_Length - 1)); + + begin + if not Is_Out_Of_Range (Known_High_Bound, Ityp) then + Slice_Rng := Make_Range (Loc, Low_Bound, High_Bound); + High_Bound := Known_High_Bound; + + else + Slice_Rng := Empty; + end if; + end; + + else + Slice_Rng := Empty; + end if; + -- Now we construct an array object with appropriate bounds. We mark -- the target as internal to prevent useless initialization when -- Initialize_Scalars is enabled. Also since this is the actual result @@ -3443,16 +3497,26 @@ package body Exp_Ch4 is -- Catch the static out of range case now - if Raises_Constraint_Error (High_Bound) then + if Raises_Constraint_Error (High_Bound) + or else Is_Out_Of_Range (High_Bound, Ityp) + then -- Kill warning generated for the declaration of the static out of -- range high bound, and instead generate a Constraint_Error with -- an appropriate specific message. - Kill_Dead_Code (Declaration_Node (Entity (High_Bound))); + if Nkind (High_Bound) = N_Integer_Literal then + Kill_Dead_Code (High_Bound); + Rewrite (High_Bound, New_Copy_Tree (Low_Bound)); + + else + Kill_Dead_Code (Declaration_Node (Entity (High_Bound))); + end if; + Apply_Compile_Time_Constraint_Error (N => Cnode, Msg => "concatenation result upper bound out of range??", Reason => CE_Range_Check_Failed); + return; end if; @@ -3529,8 +3593,9 @@ package body Exp_Ch4 is Name => New_Occurrence_Of (RTE (RR (NN)), Loc), Parameter_Associations => Opnds)); - Result := New_Occurrence_Of (Ent, Loc); - goto Done; + -- No assignments left to do below + + NN := 0; end; end if; end; @@ -3553,7 +3618,7 @@ package body Exp_Ch4 is Right_Opnd => Make_Op_Subtract (Loc, Left_Opnd => Aggr_Length (J), - Right_Opnd => Make_Artyp_Literal (1))); + Right_Opnd => Make_Artyp_Literal (Uint_1))); begin -- Singleton case, simple assignment @@ -3614,10 +3679,15 @@ package body Exp_Ch4 is end; end loop; - -- Finally we build the result, which is a reference to the array object + -- Finally we build the result, which is either a direct reference to + -- the array object or a slice of it. Result := New_Occurrence_Of (Ent, Loc); + if Present (Slice_Rng) then + Result := Make_Slice (Loc, Result, Slice_Rng); + end if; + <> pragma Assert (Present (Result)); Rewrite (Cnode, Result); @@ -13318,6 +13388,24 @@ package body Exp_Ch4 is end if; end Fixup_Universal_Fixed_Operation; + ---------------------------- + -- Get_First_Index_Bounds -- + ---------------------------- + + procedure Get_First_Index_Bounds (T : Entity_Id; Lo, Hi : out Uint) is + Typ : Entity_Id; + + begin + pragma Assert (Is_Array_Type (T)); + + -- This follows Sem_Eval.Compile_Time_Known_Bounds + + Typ := Underlying_Type (Etype (First_Index (T))); + + Lo := Expr_Value (Type_Low_Bound (Typ)); + Hi := Expr_Value (Type_High_Bound (Typ)); + end Get_First_Index_Bounds; + ------------------------ -- Get_Size_For_Range -- ------------------------