From patchwork Fri Sep 15 14:20:50 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 140457 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:612c:172:b0:3f2:4152:657d with SMTP id h50csp1083893vqi; Fri, 15 Sep 2023 07:22:11 -0700 (PDT) X-Google-Smtp-Source: AGHT+IFDCnlrEqEGjAvKp4xsuLsEO2rH3ujy+F6oW88oRMSb1y1H54Izc5DHU79mI8Pfo+sGygKE X-Received: by 2002:a2e:740c:0:b0:2bc:db5a:9540 with SMTP id p12-20020a2e740c000000b002bcdb5a9540mr1798969ljc.42.1694787731683; Fri, 15 Sep 2023 07:22:11 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1694787731; cv=none; d=google.com; s=arc-20160816; b=kuINeNVEfnRocN03TfiJLu4gWgEVbsg1gaffteM0dnMViWxQz2DTgOmZ2ONupMYFmu v0BO7eBcj8GJVGpdrvpuDmKopqMJMVi8UTG45/kg9reBNigWw3eQbUsNWhMOTXbGl3Tt UY6uFLbeG9S8xUGxfLAbNtYf53WgGvmbRc07eAjK/k75wx7UqU1qqX4HmsHBwbiBYK1h JN7VnqnkUfaFa+Hz6Sh5I5JoIpzN+xi3x8DNvSS+QK6Qb9S1a3RUGHtLjuHEnxkLZVRS VNdkIQ8Mx83d9NzlRYDwNKVszJHzn6xNWmpoXPzhumPo33PbRMcJaJDEcGpln6QBhxvi y7BA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence :content-transfer-encoding:mime-version:message-id:date:subject:cc :to:dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=kB//ySV18WaUkdTDJj25hfpUbb3rKBKhAhSbnsiSTXI=; fh=1MZseOrapRDLyqU8GW8OlI99Qn5MqSJECbwBiiq9RBM=; b=L9b02dlWGk3FcIccF69/orZ4B6b+zuy82T5ZYEpRZgiucogKTqPCKs/iTAToNSHwPh /3mRoHW4gkOMAkPDe6YGAG+zc6sxXSzp/SdnRIQpTGIFRRAwX6ahvOnTBTqOLShpVZMY gHN16U6uD9KeRfc6xKSH1HybWAGkVGZma/peVwltyHGkiqG76TZM1qvCVsb6dYTe9XH5 koDU3W4b84Psg0dycBxA1QT/VbwBLay0ONkb+klr79KKMDIkrPwQxMRLq+Rwd/DOGBBL SCPP4CfIYOnav7lTN4eAsvTqRlXBWxlRgOoby2DYPrPsWCCOJDO4i82AjVZFNMTQHk9X sIOQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b="DBqbqLr/"; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id dx11-20020a170906a84b00b0098e422d6759si3385397ejb.554.2023.09.15.07.22.11 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 15 Sep 2023 07:22:11 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b="DBqbqLr/"; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id B760D385CC94 for ; Fri, 15 Sep 2023 14:21:45 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B760D385CC94 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1694787705; bh=kB//ySV18WaUkdTDJj25hfpUbb3rKBKhAhSbnsiSTXI=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=DBqbqLr/sTDDVy+/sier867oGHcXUNjBXG/tsldUmKVlc5E5b9X91oP6F8wfytNoX Itn2N8L0rfm0Tyr7jeN8Ynn1SEDaUy/I+brvl5jrjn2XsNDK43pfcsZ4d06D5PP/+w 255fkESE41hqGMsGkKIb8eH3V2ml/bygEPNT4cUg= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x335.google.com (mail-wm1-x335.google.com [IPv6:2a00:1450:4864:20::335]) by sourceware.org (Postfix) with ESMTPS id 5DC013858C52 for ; Fri, 15 Sep 2023 14:20:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 5DC013858C52 Received: by mail-wm1-x335.google.com with SMTP id 5b1f17b1804b1-40479f8325fso10344795e9.1 for ; Fri, 15 Sep 2023 07:20:53 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1694787652; x=1695392452; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=kB//ySV18WaUkdTDJj25hfpUbb3rKBKhAhSbnsiSTXI=; b=JeuFrN9Q266TE06BnSSyXjCGI1rTwTVD2gJfKdge3Amzuc0KfaxZrAvD5K0pBRJgsV vkSpjEMaLFBLaRs5lizZXEoM8P2M8iEWBdiZnrGOa7SImgvOJnscdAzZfY0XRNxU3b/o h92WPIwV+Z2cgIHqnIFP8usUoMTwTLFAGR9yhDBeLbA9K9tVuh/TSyEp+aCfG4i153IZ B1gEXNbTBSBirpgIsLgkjXT45avuLWdmGkj0cvHPbIYMkfSYr96KQ86rjsand0MpTF7f lILAZKdoi8gN6/RysoBVOfgquP9bl0NfovuNE5z7jfzj0Ok43OhKwoqTgHn6gCLnmqcA /KUw== X-Gm-Message-State: AOJu0YzcbHg8QGqMFHM414SfsbWvzra/8ikTdYTxXBEBRkDInclkdPF3 uUSYC3t40btqAQ7BzQW1w5WWtqA1y17vxqyr3IelnQ== X-Received: by 2002:a05:600c:364f:b0:401:b6f6:d90c with SMTP id y15-20020a05600c364f00b00401b6f6d90cmr1715536wmq.35.1694787651964; Fri, 15 Sep 2023 07:20:51 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:a63c:a2c3:ab34:f429]) by smtp.gmail.com with ESMTPSA id n12-20020a05600c294c00b003fee777fd84sm4742073wmd.41.2023.09.15.07.20.51 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 15 Sep 2023 07:20:51 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Bob Duff , Ronan Desplanques Subject: [COMMITTED] ada: Clean up scope depth and related code (tech debt) Date: Fri, 15 Sep 2023 16:20:50 +0200 Message-Id: <20230915142050.2100712-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 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 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1777113740714301331 X-GMAIL-MSGID: 1777113740714301331 From: Bob Duff The main point of this patch is to remove the special case for Atree.F_Scope_Depth_Value in the Assert that Field_Present in Get_Field_Value. Pulling on that thread leads to lots of related cleanup. gcc/ada/ChangeLog: * atree.adb (Node_Kind_Table): Specify parameter explicitly in GNAT.Table instantiations. Use fully qualified references instead of relying on use clauses. (Get_Field_Value): Remove special case for F_Scope_Depth_Value. That is, enable the Field_Present check in that case. (It was already enabled for all other fields.) Violations of this check were already fixed. (Print_Node_Statistics): Sort the output in decreasing order of frequencies. (Print_Field_Statistics): Likewise (sort). * accessibility.adb (Accessibility_Level): Pass Allow_Alt_Model in recursive calls. Apparently, an oversight. (Innermost_Master_Scope_Depth): Need to special-case the 'Old attribute and allocators. * einfo-utils.ads (Scope_Depth): Use Scope_Kind_Id to get predicate checks. (Scope_Depth_Set): Likewise. (Scope_Depth_Default_0): Likewise. * einfo-utils.adb: As for spec. * frontend.adb (Frontend): Remove unnecessary "return;". * gen_il-types.ads (Scope_Kind): New union type. * gen_il-gen-gen_entities.adb (Scope_Kind): New union type. * sem.ads: Move "with Einfo.Entities;" from body to spec. (Scope_Stack_Entry): Declare Entity to be of Scope_Kind_Id to get predicate checks. We had previously been putting non-scopes on the scope stack; this prevents such anomalies. * sem.adb: Move "with Einfo.Entities;" from body to spec. * sem_ch8.ads: Move "with Einfo.Entities;" from body to spec. Add "with Types;". (Push_Scope): Use Scope_Kind_Id to get predicate checks. * sem_ch8.adb: Move "with Einfo.Entities;" from body to spec. Add "with Types;". (Push_Scope): Use Scope_Kind_Id to get predicate checks. (Pop_Scope): Use Scope_Kind_Id on popped entity to get predicate checks. This prevents anomalies where a scope pushed onto the stack is later mutated to a nonscope before being popped. * sem_util.ads (Find_Enclosing_Scope): Add postcondition to ensure that the enclosing scope of a node N is not the same node N. Clearly, N does not enclose itself. * sem_util.adb (Find_Enclosing_Scope): There were several bugs where Find_Enclosing_Scope(N) = N. For example, if N is an entity, then we would typically go up to its declaration, and then back down to the Defining_Entity of the declaration, which is N itself. There were other cases where Find_Enclosing_Scope of an entity disagreed with Scope. Clearly, Find_Enclosing_Scope and Scope should agree (when both are defined). Such bugs caused latent bugs in accessibility.adb related to 'Old, and fixing bugs here caused such bugs to be revealed. These are fixed by calling Scope when N is an entity. Co-authored-by: Ronan Desplanques Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 38 +++-- gcc/ada/atree.adb | 210 +++++++++++++++++++++------- gcc/ada/einfo-utils.adb | 6 +- gcc/ada/einfo-utils.ads | 6 +- gcc/ada/frontend.adb | 2 - gcc/ada/gen_il-gen-gen_entities.adb | 27 ++++ gcc/ada/gen_il-types.ads | 1 + gcc/ada/sem.adb | 1 - gcc/ada/sem.ads | 3 +- gcc/ada/sem_ch8.adb | 5 +- gcc/ada/sem_ch8.ads | 5 +- gcc/ada/sem_util.adb | 8 +- gcc/ada/sem_util.ads | 3 +- 13 files changed, 231 insertions(+), 84 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index bc897d1ef18..bc217bef703 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -119,8 +119,9 @@ package body Accessibility is is Loc : constant Source_Ptr := Sloc (Expr); - function Accessibility_Level (Expr : Node_Id) return Node_Id - is (Accessibility_Level (Expr, Level, In_Return_Context)); + function Accessibility_Level (Expr : Node_Id) return Node_Id is + (Accessibility_Level + (Expr, Level, In_Return_Context, Allow_Alt_Model)); -- Renaming of the enclosing function to facilitate recursive calls function Make_Level_Literal (Level : Uint) return Node_Id; @@ -164,7 +165,19 @@ package body Accessibility is Ent := Defining_Entity_Or_Empty (Node_Par); if Present (Ent) then - Encl_Scop := Find_Enclosing_Scope (Ent); + -- X'Old is nested within the current subprogram, so we do not + -- want Find_Enclosing_Scope of that subprogram. If this is an + -- allocator, then we're looking for the innermost master of + -- the call, so again we do not want Find_Enclosing_Scope. + + if (Nkind (N) = N_Attribute_Reference + and then Attribute_Name (N) = Name_Old) + or else Nkind (N) = N_Allocator + then + Encl_Scop := Ent; + else + Encl_Scop := Find_Enclosing_Scope (Ent); + end if; -- Ignore transient scopes made during expansion while also -- taking into account certain expansions - like iterators @@ -177,17 +190,13 @@ package body Accessibility is then -- Note that in some rare cases the scope depth may not be -- set, for example, when we are in the middle of analyzing - -- a type and the enclosing scope is said type. So, instead, - -- continue to move up the parent chain since the scope - -- depth of the type's parent is the same as that of the - -- type. - - if not Scope_Depth_Set (Encl_Scop) then - pragma Assert (Nkind (Parent (Encl_Scop)) - = N_Full_Type_Declaration); + -- a type and the enclosing scope is said type. In that case + -- simply return zero for the outermost scope. + + if Scope_Depth_Set (Encl_Scop) then + return Scope_Depth (Encl_Scop) + Master_Lvl_Modifier; else - return - Scope_Depth (Encl_Scop) + Master_Lvl_Modifier; + return Uint_0; end if; end if; @@ -424,7 +433,7 @@ package body Accessibility is when N_Aggregate => return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr)); - -- The accessibility level is that of the access type, except for an + -- The accessibility level is that of the access type, except for -- anonymous allocators which have special rules defined in RM 3.10.2 -- (14/3). @@ -472,6 +481,7 @@ package body Accessibility is and then Present (Get_Dynamic_Accessibility (Entity (Pre))) and then Level = Dynamic_Level then + pragma Assert (Is_Anonymous_Access_Type (Etype (Pre))); return New_Occurrence_Of (Get_Dynamic_Accessibility (Entity (Pre)), Loc); diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 5597d166cdb..8e4c4437636 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -33,6 +33,8 @@ with Output; use Output; with Sinfo.Utils; use Sinfo.Utils; with System.Storage_Elements; +with GNAT.Table; + package body Atree is --------------- @@ -900,10 +902,7 @@ package body Atree is function Get_Field_Value (N : Node_Id; Field : Node_Or_Entity_Field) return Field_Size_32_Bit is - pragma Assert - (if Field /= F_Scope_Depth_Value then -- ???Temporarily disable check - Field_Checking.Field_Present (N, Field)); - -- Assert partially disabled because it fails in rare cases + pragma Assert (Field_Checking.Field_Present (N, Field)); Desc : Field_Descriptor renames Field_Descriptors (Field); NN : constant Node_Or_Entity_Id := Node_To_Fetch_From (N, Field); @@ -2889,6 +2888,34 @@ package body Atree is Node_Counts : array (Node_Kind) of Count := (others => 0); Entity_Counts : array (Entity_Kind) of Count := (others => 0); + -- We put the Node_Kinds and Entity_Kinds into a table just because + -- GNAT.Table has a handy sort procedure. We're sorting in decreasing + -- order of Node_Counts, for printing. + + package Node_Kind_Table is new GNAT.Table + (Table_Component_Type => Node_Kind, + Table_Index_Type => Pos, + Table_Low_Bound => Pos'First, + Table_Initial => 8, + Table_Increment => 100 + ); + function Higher_Count (X, Y : Node_Kind) return Boolean is + (Node_Counts (X) > Node_Counts (Y)); + procedure Sort_Node_Kind_Table is new + Node_Kind_Table.Sort_Table (Lt => Higher_Count); + + package Entity_Kind_Table is new GNAT.Table + (Table_Component_Type => Entity_Kind, + Table_Index_Type => Pos, + Table_Low_Bound => Pos'First, + Table_Initial => 8, + Table_Increment => 100 + ); + function Higher_Count (X, Y : Entity_Kind) return Boolean is + (Entity_Counts (X) > Entity_Counts (Y)); + procedure Sort_Entity_Kind_Table is new + Entity_Kind_Table.Sort_Table (Lt => Higher_Count); + All_Node_Offsets : Node_Offsets.Table_Type renames Node_Offsets.Table (Node_Offsets.First .. Node_Offsets.Last); begin @@ -2897,6 +2924,8 @@ package body Atree is Write_Int (Int (Slots.Last)); Write_Line (" non-header slots"); + -- Count up the number of each kind of node and entity + for N in All_Node_Offsets'Range loop declare K : constant Node_Kind := Nkind (N); @@ -2910,44 +2939,95 @@ package body Atree is end; end loop; + -- Copy kinds to tables, and sort: + for K in Node_Kind loop - declare - Count : constant Nat_64 := Node_Counts (K); - begin - Write_Int_64 (Count); - Write_Ratio (Count, Int_64 (Node_Offsets.Last)); - Write_Str (" "); - Write_Str (Node_Kind'Image (K)); - Write_Str (" "); - Write_Int (Int (Sinfo.Nodes.Size (K))); - Write_Str (" slots"); - Write_Eol; - end; + Node_Kind_Table.Append (K); end loop; + Sort_Node_Kind_Table; for K in Entity_Kind loop - declare - Count : constant Nat_64 := Entity_Counts (K); - begin - Write_Int_64 (Count); - Write_Ratio (Count, Int_64 (Node_Offsets.Last)); - Write_Str (" "); - Write_Str (Entity_Kind'Image (K)); - Write_Str (" "); - Write_Int (Int (Einfo.Entities.Size (K))); - Write_Str (" slots"); - Write_Eol; - end; + Entity_Kind_Table.Append (K); end loop; + Sort_Entity_Kind_Table; + + -- Print out the counts for each kind in decreasing order. Exit the loop + -- if we see a zero count, because all the rest must be zero, and the + -- zero ones are boring. + + declare + use Node_Kind_Table; + -- Note: the full qualification of First below is needed for + -- bootstrap builds. + Table : Table_Type renames Node_Kind_Table.Table + (Node_Kind_Table.First .. Last); + begin + for J in Table'Range loop + declare + K : constant Node_Kind := Table (J); + Count : constant Nat_64 := Node_Counts (K); + begin + exit when Count = 0; -- skip the rest + + Write_Int_64 (Count); + Write_Ratio (Count, Int_64 (Node_Offsets.Last)); + Write_Str (" "); + Write_Str (Node_Kind'Image (K)); + Write_Str (" "); + Write_Int (Int (Sinfo.Nodes.Size (K))); + Write_Str (" slots"); + Write_Eol; + end; + end loop; + end; + + declare + use Entity_Kind_Table; + -- Note: the full qualification of First below is needed for + -- bootstrap builds. + Table : Table_Type renames Entity_Kind_Table.Table + (Entity_Kind_Table.First .. Last); + begin + for J in Table'Range loop + declare + K : constant Entity_Kind := Table (J); + Count : constant Nat_64 := Entity_Counts (K); + begin + exit when Count = 0; -- skip the rest + + Write_Int_64 (Count); + Write_Ratio (Count, Int_64 (Node_Offsets.Last)); + Write_Str (" "); + Write_Str (Entity_Kind'Image (K)); + Write_Str (" "); + Write_Int (Int (Einfo.Entities.Size (K))); + Write_Str (" slots"); + Write_Eol; + end; + end loop; + end; end Print_Node_Statistics; procedure Print_Field_Statistics is Total, G_Total, S_Total : Call_Count := 0; + + -- Use a table for sorting, as done in Print_Node_Statistics. + + package Field_Table is new GNAT.Table + (Table_Component_Type => Node_Or_Entity_Field, + Table_Index_Type => Pos, + Table_Low_Bound => Pos'First, + Table_Initial => 8, + Table_Increment => 100 + ); + function Higher_Count (X, Y : Node_Or_Entity_Field) return Boolean is + (Get_Count (X) + Set_Count (X) > Get_Count (Y) + Set_Count (Y)); + procedure Sort_Field_Table is new + Field_Table.Sort_Table (Lt => Higher_Count); begin Write_Int_64 (Get_Original_Node_Count); Write_Str (" + "); Write_Int_64 (Set_Original_Node_Count); - Write_Eol; Write_Line (" Original_Node_Count getter and setter calls"); Write_Eol; @@ -2970,32 +3050,55 @@ package body Atree is Write_Int_64 (S_Total); Write_Line (" total getter and setter calls"); - for Field in Node_Or_Entity_Field loop - declare - G : constant Call_Count := Get_Count (Field); - S : constant Call_Count := Set_Count (Field); - GS : constant Call_Count := G + S; - - Desc : Field_Descriptor renames Field_Descriptors (Field); - Slot : constant Field_Offset := - (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size; + -- Copy fields to the table, and sort: - begin - Write_Int_64 (GS); - Write_Ratio (GS, Total); - Write_Str (" = "); - Write_Int_64 (G); - Write_Str (" + "); - Write_Int_64 (S); - Write_Str (" "); - Write_Str (Node_Or_Entity_Field'Image (Field)); - Write_Str (" in slot "); - Write_Int (Int (Slot)); - Write_Str (" size "); - Write_Int (Int (Field_Size (Desc.Kind))); - Write_Eol; - end; + for F in Node_Or_Entity_Field loop + Field_Table.Append (F); end loop; + Sort_Field_Table; + + -- Print out the counts for each field in decreasing order of + -- getter+setter sum. As in Print_Node_Statistics, exit the loop + -- if we see a zero sum. + + declare + use Field_Table; + -- Note: the full qualification of First below is needed for + -- bootstrap builds. + Table : Table_Type renames + Field_Table.Table (Field_Table.First .. Last); + begin + for J in Table'Range loop + declare + Field : constant Node_Or_Entity_Field := Table (J); + + G : constant Call_Count := Get_Count (Field); + S : constant Call_Count := Set_Count (Field); + GS : constant Call_Count := G + S; + + Desc : Field_Descriptor renames Field_Descriptors (Field); + Slot : constant Field_Offset := + (Field_Size (Desc.Kind) * Desc.Offset) / Slot_Size; + + begin + exit when GS = 0; -- skip the rest + + Write_Int_64 (GS); + Write_Ratio (GS, Total); + Write_Str (" = "); + Write_Int_64 (G); + Write_Str (" + "); + Write_Int_64 (S); + Write_Str (" "); + Write_Str (Node_Or_Entity_Field'Image (Field)); + Write_Str (" in slot "); + Write_Int (Int (Slot)); + Write_Str (" size "); + Write_Int (Int (Field_Size (Desc.Kind))); + Write_Eol; + end; + end loop; + end; end Print_Field_Statistics; procedure Print_Statistics is @@ -3003,6 +3106,7 @@ package body Atree is Write_Eol; Write_Eol; Print_Node_Statistics; + Write_Eol; Print_Field_Statistics; end Print_Statistics; diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index cb9a00dc4bb..9bee1f4fb2c 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2589,7 +2589,7 @@ package body Einfo.Utils is -- Scope_Depth -- ----------------- - function Scope_Depth (Id : E) return Uint is + function Scope_Depth (Id : Scope_Kind_Id) return Uint is Scop : Entity_Id; begin @@ -2601,7 +2601,7 @@ package body Einfo.Utils is return Scope_Depth_Value (Scop); end Scope_Depth; - function Scope_Depth_Default_0 (Id : E) return U is + function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U is begin if Scope_Depth_Set (Id) then return Scope_Depth (Id); @@ -2615,7 +2615,7 @@ package body Einfo.Utils is -- Scope_Depth_Set -- --------------------- - function Scope_Depth_Set (Id : E) return B is + function Scope_Depth_Set (Id : Scope_Kind_Id) return B is begin return not Is_Record_Type (Id) and then not Field_Is_Initial_Zero (Id, F_Scope_Depth_Value); diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads index 20ca470d7ac..21a8891e4ab 100644 --- a/gcc/ada/einfo-utils.ads +++ b/gcc/ada/einfo-utils.ads @@ -242,10 +242,10 @@ package Einfo.Utils is function Type_Low_Bound (Id : E) return N with Inline; function Underlying_Type (Id : E) return Entity_Id; - function Scope_Depth (Id : E) return U with Inline; - function Scope_Depth_Set (Id : E) return B with Inline; + function Scope_Depth (Id : Scope_Kind_Id) return U with Inline; + function Scope_Depth_Set (Id : Scope_Kind_Id) return B with Inline; - function Scope_Depth_Default_0 (Id : E) return U; + function Scope_Depth_Default_0 (Id : Scope_Kind_Id) return U; -- In rare cases, the Scope_Depth_Value (queried by Scope_Depth) is -- not correctly set before querying it; this may be used instead of -- Scope_Depth in such cases. It returns Uint_0 if the Scope_Depth_Value diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index f2faa0960c6..eb9378d8936 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -565,6 +565,4 @@ begin if Mapping_File_Name /= null then Fmap.Update_Mapping_File (Mapping_File_Name.all); end if; - - return; end Frontend; diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index f980ba2f1b3..3e6ed9633bd 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -1423,4 +1423,31 @@ begin -- Gen_IL.Gen.Gen_Entities E_Subprogram_Body, E_Subprogram_Type)); + -- Entities that represent scopes. These can be on the scope stack, + -- and Scope_Depth can be queried. These are the kinds that have + -- the Scope_Depth_Value attribute, plus Record_Kind, which has + -- a synthesized Scope_Depth. + + Union (Scope_Kind, + Children => + (E_Void, + E_Private_Type, + E_Private_Subtype, + E_Limited_Private_Type, + E_Limited_Private_Subtype, + Concurrent_Kind, + Subprogram_Kind, + E_Entry, + E_Entry_Family, + E_Block, + Generic_Unit_Kind, + E_Loop, + E_Return_Statement, + E_Package, + E_Package_Body, + E_Subprogram_Body, + Record_Kind, + E_Incomplete_Type, + E_Subprogram_Type)); + end Gen_IL.Gen.Gen_Entities; diff --git a/gcc/ada/gen_il-types.ads b/gcc/ada/gen_il-types.ads index be6ba52634f..be389ebc35a 100644 --- a/gcc/ada/gen_il-types.ads +++ b/gcc/ada/gen_il-types.ads @@ -177,6 +177,7 @@ package Gen_IL.Types is Record_Kind, Record_Field_Kind, Scalar_Kind, + Scope_Kind, Signed_Integer_Kind, Subprogram_Type_Or_Kind, Subprogram_Kind, diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 3bff8d26a0d..0356ffcf859 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -27,7 +27,6 @@ with Atree; use Atree; with Debug; use Debug; with Debug_A; use Debug_A; with Einfo; use Einfo; -with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Exp_SPARK; use Exp_SPARK; diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 19abbf16d19..10d4bd2e964 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -201,6 +201,7 @@ -- called Preanalyze_And_Resolve and is in Sem_Res. with Alloc; +with Einfo.Entities; use Einfo.Entities; with Opt; use Opt; with Table; with Types; use Types; @@ -485,7 +486,7 @@ package Sem is -- configuration file. type Scope_Stack_Entry is record - Entity : Entity_Id; + Entity : Scope_Kind_Id; -- Entity representing the scope Last_Subprogram_Name : String_Ptr; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 6e0db366db8..3c55cb61fb4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -26,7 +26,6 @@ with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; -with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; @@ -9301,7 +9300,7 @@ package body Sem_Ch8 is procedure Pop_Scope is SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last); - S : constant Entity_Id := SST.Entity; + S : constant Scope_Kind_Id := SST.Entity; begin if Debug_Flag_E then @@ -9363,7 +9362,7 @@ package body Sem_Ch8 is -- Push_Scope -- ---------------- - procedure Push_Scope (S : Entity_Id) is + procedure Push_Scope (S : Scope_Kind_Id) is E : constant Entity_Id := Scope (S); function Component_Alignment_Default return Component_Alignment_Kind; diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads index 87323e08f04..246ab87f11f 100644 --- a/gcc/ada/sem_ch8.ads +++ b/gcc/ada/sem_ch8.ads @@ -23,7 +23,8 @@ -- -- ------------------------------------------------------------------------------ -with Types; use Types; +with Einfo.Entities; use Einfo.Entities; +with Types; use Types; package Sem_Ch8 is ----------------------------------- @@ -148,7 +149,7 @@ package Sem_Ch8 is -- Mark a given entity or node Id's relevant use clauses as effective, -- including redundant ones and ones outside of the current scope. - procedure Push_Scope (S : Entity_Id); + procedure Push_Scope (S : Scope_Kind_Id); -- Make new scope stack entry, pushing S, the entity for a scope onto the -- top of the scope table. The current setting of the scope suppress flags -- is saved for restoration on exit. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cc9dcb30b18..e778bab95d1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8938,10 +8938,16 @@ package body Sem_Util is -- Find_Enclosing_Scope -- -------------------------- - function Find_Enclosing_Scope (N : Node_Id) return Entity_Id is + function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id is Par : Node_Id; begin + -- If N is an entity, simply return its Scope + + if Nkind (N) in N_Entity then + return Scope (N); + end if; + -- Examine the parent chain looking for a construct which defines a -- scope. diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b56a235c022..92016bc0eef 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -889,7 +889,8 @@ package Sem_Util is -- such a loop exists, return the entity of its identifier (E_Loop scope), -- otherwise return Empty. - function Find_Enclosing_Scope (N : Node_Id) return Entity_Id; + function Find_Enclosing_Scope (N : Node_Id) return Scope_Kind_Id with + Post => Find_Enclosing_Scope'Result /= N; -- Find the nearest scope which encloses arbitrary node N function Find_Loop_In_Conditional_Block (N : Node_Id) return Node_Id;