From patchwork Mon May 15 09:43:58 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: 94057 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp6795029vqo; Mon, 15 May 2023 02:55:53 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ5tlV5pF4LFFnNJDig7fqpP39IsJbZT5pXUJbR8Uj680K7WpYRs5C6g1NPfHUBIMHa1xlFp X-Received: by 2002:a17:907:6d11:b0:969:93f2:2593 with SMTP id sa17-20020a1709076d1100b0096993f22593mr20518069ejc.27.1684144552842; Mon, 15 May 2023 02:55:52 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684144552; cv=none; d=google.com; s=arc-20160816; b=ohh86FpDHZz2WoYUZPWo+JcGR8oAyW/JxXy3r9n/7lwQEKIADOvBXEJVW06LjFvKjW TV59s4FrQLkkgKR8C/CL4hDXDab8FOmkyT44pTaaUPHpSRjng0PynwmbxLD1cdKx9NRK /gEeTnseuc9KkUcE6LQf28ZTKkbXmz+lGnzLXFTC/XS3y9GzPSS6/b5w75QAp/lm9HFJ k3iaai0U3xMHNN32YEugrmxY8fRw/hm9BtgrjIeorPCFveYl6FzlH5FoXU0wMFQOOngE ch4Vbu/+V8PHRbSYwlb/R5KkcTHj7pB0crX2hkQgfA43ke/QhR9UQD/BWO6n8inDsPpF IReg== 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=l17PWpq6m0gmOuE5o2Grxg2QTxIwoF2ChqEqAgX1NUI=; b=NDnJ+ZqXzdylb86osCzm50vKrWjpMqiqRIBHQeasoNR5CUzJGp1YkL7OJmBKzVddiZ u6W2xZvsXcp+6690iR/liEi9BzCO9GoTRuurB4pQzFeiwqj0W0JvWBmVt8rjzD9y6lTy 1WryhtYY5jrk1u72Jmv0MqOobiGNx89eUqWnzPywZoN4A8EIxvCB/Nu4Nr+U+tsthasJ Fzjwsi/sPiUDQXsrUgz5aIXwdsqsClf+kzhImllvO63scXagMTQNPiYtobfLzwlPnZlG x7cGI8WKI2ews1fk11+HNUqnyy2xNn37jvNhS8LA8uAMf1K6eNsmFeeTuSQyC76ZHp9m ApSQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=ydHyrIYV; 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 sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id mv12-20020a170907838c00b00965fac6722esi10564284ejc.171.2023.05.15.02.55.52 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 May 2023 02:55:52 -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=ydHyrIYV; 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 1EAFD3888C65 for ; Mon, 15 May 2023 09:49:30 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1EAFD3888C65 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684144170; bh=l17PWpq6m0gmOuE5o2Grxg2QTxIwoF2ChqEqAgX1NUI=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=ydHyrIYVEcFEkVEv54q3EZI+lICzk3OvQqzBkXXhO7ILZmKubkLcAxdx+dBGek+fe Dhdw6rQOLXVqoJV1DpI1FzgelFEcjJxvIG/b20InXgEmpGTng0Sq3El+sDTtX376oA 7JYq+5II7/iQzYri7LX54CpnTDNsN9w5B3seRL0A= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42a.google.com (mail-wr1-x42a.google.com [IPv6:2a00:1450:4864:20::42a]) by sourceware.org (Postfix) with ESMTPS id 3D7B33870900 for ; Mon, 15 May 2023 09:44:02 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3D7B33870900 Received: by mail-wr1-x42a.google.com with SMTP id ffacd0b85a97d-3063891d61aso11930645f8f.0 for ; Mon, 15 May 2023 02:44:02 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684143841; x=1686735841; 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=l17PWpq6m0gmOuE5o2Grxg2QTxIwoF2ChqEqAgX1NUI=; b=iychz+8l7rurZ9nszezFEfmVNl5cHE9IweD9ge+QwPuLLcIsI5nr5qejdpCJp6OCR7 c2N6z6c90y+B9bQHg87bpnN5M8BIyfM6AHK1ayEkIZ32Lfqv0TClzRvPoFOO1EC4RM2K nuT416y2x0WecEVboXArVkj/jrT0ttQAyzqH73Njk4Y+cWwjIfMM+18eDOvTPqabrGv2 BGyu1+ujfhEoe6j2nS9bZ2T+CSHJZjLGx1I3DSb6EoL7qB4Dm+SvZ7eNPTHvOWqqqu6s 0ZStXYaHCizo+722FLXuyYcBmWI3PmT2z4cGceoe8Nwlbs6RVezR2XPMkb6v/XbtUz1i IXQg== X-Gm-Message-State: AC+VfDyFPguR12BVCztyesbrILZw5xZQO0exYQTeU2FqEkENOjHvxjjI 8bWfDSzPFRKO6RQoRL/kOb94tg3np+CC7O2EIr5ToA== X-Received: by 2002:a5d:4ec3:0:b0:307:8694:44e0 with SMTP id s3-20020a5d4ec3000000b00307869444e0mr22067006wrv.55.1684143840758; Mon, 15 May 2023 02:44:00 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id k9-20020adfe8c9000000b0030642f5da27sm31790796wrn.37.2023.05.15.02.43.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 15 May 2023 02:44:00 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [COMMITTED] ada: Clean up vanishing entity fields Date: Mon, 15 May 2023 11:43:58 +0200 Message-Id: <20230515094358.1408551-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, 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: =?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: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1765953558283566362?= X-GMAIL-MSGID: =?utf-8?q?1765953558283566362?= From: Bob Duff Fix all the failures caused by enabling Check_Vanishing_Fields on entities in all cases except the case of converting to or from E_Void. But leave Check_Vanishing_Fields disabled by default (controlled by -gnatd_v flag), because it might be too slow even for assertions-on mode, and we should deal with the E_Void cases eventually. The failures are fixed either by adding calls to Reinit_Field_To_Zero, or by changing which entities have which fields. Note that in a series of Reinit_Field_To_Zero calls, the optional Old_Ekind parameter is only useful on the first such call. gcc/ada/ * atree.adb (Check_Vanishing_Fields): Disable the check for "root/base type only" fields. This is a bug fix -- if we're checking some subtype S, we don't want to reach over to the root or base type and Reinit_Field_To_Zero of that, thus modifying the field for lots of subtypes other than S. Disable in the to/from E_Void cases. Misc cleanup. * gen_il-gen-gen_entities.adb: Define First_Entity, Last_Entity, and Stored_Constraint for all type entities, because there are too many cases where Reinit_Field_To_Zero would otherwise be needed. In any case, it seems cleaner to have First_Entity and Last_Entity defined in the same entity kinds. * einfo.ads: (First_Entity, Last_Entity, Stored_Constraint): Update comments to reflect gen_il-gen-gen_entities.adb changes. (Lit_Hash): Add missing "[root type only]" comment. * exp_ch5.adb: Add Reinit_Field_To_Zero calls for vanishing fields. * sem_ch10.adb: Likewise. * sem_ch6.adb: Likewise. * sem_ch7.adb: Likewise. * sem_ch8.adb: Likewise. * sem_ch3.adb: Likewise. Also remove now-unnecessary Reinit_Field_To_Zero calls. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/atree.adb | 79 ++++++++++++++++++++++------- gcc/ada/einfo.ads | 27 ++++------ gcc/ada/exp_ch5.adb | 12 +++++ gcc/ada/gen_il-gen-gen_entities.adb | 45 +++++----------- gcc/ada/sem_ch10.adb | 4 ++ gcc/ada/sem_ch3.adb | 29 +++-------- gcc/ada/sem_ch6.adb | 20 +++++--- gcc/ada/sem_ch7.adb | 3 ++ gcc/ada/sem_ch8.adb | 8 ++- 9 files changed, 131 insertions(+), 96 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 669b1bf225d..1c5b93727cd 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -948,11 +948,10 @@ package body Atree is procedure Check_Vanishing_Fields (Old_N : Node_Id; New_Kind : Node_Kind) is - Old_Kind : constant Node_Kind := Nkind (Old_N); - - -- If this fails, it means you need to call Reinit_Field_To_Zero before - -- calling Mutate_Nkind. + -- If this fails, see comments in the spec of Mutate_Nkind and in + -- Check_Vanishing_Fields for entities below. + Old_Kind : constant Node_Kind := Nkind (Old_N); begin for J in Node_Field_Table (Old_Kind)'Range loop declare @@ -976,45 +975,90 @@ package body Atree is end loop; end Check_Vanishing_Fields; + Check_Vanishing_Fields_Failed : Boolean := False; + procedure Check_Vanishing_Fields (Old_N : Entity_Id; New_Kind : Entity_Kind) is + -- If this fails, it means Mutate_Ekind is changing the Ekind from + -- Old_Kind to New_Kind, such that some field F exists in Old_Kind but + -- not in New_Kind, and F contains non-default information. The usual + -- solution is to call Reinit_Field_To_Zero before calling Mutate_Ekind. + -- Another solution is to change Gen_IL so that the new field DOES exist + -- in New_Kind. See also comments in the spec of Mutate_Ekind. + Old_Kind : constant Entity_Kind := Ekind (Old_N); - -- If this fails, it means you need to call Reinit_Field_To_Zero before - -- calling Mutate_Ekind. But we have many cases where vanishing fields - -- are expected to reappear after converting to/from E_Void. Other cases - -- are more problematic; set a breakpoint on "(non-E_Void case)" below. + function Same_Node_To_Fetch_From + (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) + return Boolean; + -- True if the field should be fetched from N. For most fields, this is + -- true. However, if the field is a "root type only" field, then this is + -- true only if N is the root type. If this is false, then we should not + -- do Reinit_Field_To_Zero, and we should not fail below, because the + -- field is not vanishing from the root type. Similar comments apply to + -- "base type only" and "implementation base type only" fields. + -- + -- We need to ignore exceptions here, because in some cases, + -- Node_To_Fetch_From is being called before the relevant (root, base) + -- type has been set, so we fail some assertions. + + function Same_Node_To_Fetch_From + (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field) + return Boolean is + begin + return N = Node_To_Fetch_From (N, Field); + exception + when others => return False; -- ignore the exception + end Same_Node_To_Fetch_From; begin + -- Disable these checks in the case of converting to or from E_Void, + -- because we have many cases where we convert something to E_Void and + -- then back (or then to something else), and Reinit_Field_To_Zero + -- wouldn't work because we expect the fields to retain their values. + + if New_Kind = E_Void or else Old_Kind = E_Void then + return; + end if; + for J in Entity_Field_Table (Old_Kind)'Range loop declare F : constant Entity_Field := Entity_Field_Table (Old_Kind) (J); begin - if not Field_Checking.Field_Present (New_Kind, F) then + if not Same_Node_To_Fetch_From (Old_N, F) then + null; -- no check in this case + elsif not Field_Checking.Field_Present (New_Kind, F) then if not Field_Is_Initial_Zero (Old_N, F) then + Check_Vanishing_Fields_Failed := True; + Write_Str ("# "); Write_Str (Old_Kind'Img); Write_Str (" --> "); Write_Str (New_Kind'Img); Write_Str (" Nonzero field "); Write_Str (F'Img); - Write_Str (" is vanishing for node "); - Write_Int (Nat (Old_N)); - Write_Eol; + Write_Str (" is vanishing "); if New_Kind = E_Void or else Old_Kind = E_Void then - Write_Line (" (E_Void case)"); + Write_Line ("(E_Void case)"); else - Write_Line (" (non-E_Void case)"); + Write_Line ("(non-E_Void case)"); end if; + + Write_Str (" ...mutating node "); + Write_Int (Nat (Old_N)); + Write_Line (""); end if; end if; end; end loop; + + if Check_Vanishing_Fields_Failed then + raise Program_Error; + end if; end Check_Vanishing_Fields; - Nkind_Offset : constant Field_Offset := - Field_Descriptors (F_Nkind).Offset; + Nkind_Offset : constant Field_Offset := Field_Descriptors (F_Nkind).Offset; procedure Set_Node_Kind_Type is new Set_8_Bit_Field (Node_Kind) with Inline; @@ -1082,8 +1126,7 @@ package body Atree is Mutate_Nkind (N, Val, Old_Size => Size_In_Slots_Dynamic (N)); end Mutate_Nkind; - Ekind_Offset : constant Field_Offset := - Field_Descriptors (F_Ekind).Offset; + Ekind_Offset : constant Field_Offset := Field_Descriptors (F_Ekind).Offset; procedure Set_Entity_Kind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index a200d6334bf..878737c7cc1 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1346,12 +1346,13 @@ package Einfo is -- find the first discriminant if discriminants are present. -- First_Entity --- Defined in all entities which act as scopes to which a list of --- associated entities is attached (blocks, class subtypes and types, --- entries, functions, loops, packages, procedures, protected objects, --- record types and subtypes, private types, task types and subtypes). +-- Defined in all entities that act as scopes to which a list of +-- associated entities is attached. This is defined in all [sub]types, +-- including things like scalars that cannot have nested entities, +-- which makes it more convenient to Mutate_Entity between type kinds. -- Points to a list of associated entities using the Next_Entity field -- as a chain pointer with Empty marking the end of the list. +-- See also Last_Entity. -- First_Exit_Statement -- Defined in E_Loop entity. The exit statements for a loop are chained @@ -3510,12 +3511,8 @@ package Einfo is -- statements whose value is not used. -- Last_Entity --- Defined in all entities which act as scopes to which a list of --- associated entities is attached (blocks, class subtypes and types, --- entries, functions, loops, packages, procedures, protected objects, --- record types and subtypes, private types, task types and subtypes). --- Points to the last entry in the list of associated entities chained --- through the Next_Entity field. Empty if no entities are chained. +-- Defined for the same entity kinds as First_Entity. Last_Entity +-- is the last entry in the list. Empty if no entities are chained. -- Last_Formal (synthesized) -- Applies to subprograms and subprogram types, and also in entries @@ -3538,7 +3535,7 @@ package Einfo is -- field may be set as a result of a linker section pragma applied to the -- type of the object. --- Lit_Hash +-- Lit_Hash [root type only] -- Defined in enumeration types and subtypes. Non-empty only for the -- case of an enumeration root type, where it contains the entity for -- the generated hash function. See unit Exp_Imgv for full details of @@ -4535,11 +4532,9 @@ package Einfo is -- share the same storage pool). -- Stored_Constraint --- Defined in entities that can have discriminants (concurrent types --- subtypes, record types and subtypes, private types and subtypes, --- limited private types and subtypes and incomplete types). Points --- to an element list containing the expressions for each of the --- stored discriminants for the record (sub)type. +-- Defined in type entities. Points to an element list containing the +-- expressions for each of the stored discriminants, if any, for the +-- (sub)type. -- Stores_Attribute_Old_Prefix -- Defined in constants, variables, and types which are created during diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 265e1a74b93..0dbf2d55192 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -4324,6 +4324,12 @@ package body Exp_Ch5 is Analyze (Init_Decl); Init_Name := Defining_Identifier (Init_Decl); + Reinit_Field_To_Zero (Init_Name, F_Has_Initial_Value, + Old_Ekind => (E_Variable => True, others => False)); + Reinit_Field_To_Zero (Init_Name, F_Is_Elaboration_Checks_OK_Id); + Reinit_Field_To_Zero (Init_Name, F_Is_Elaboration_Warnings_OK_Id); + Reinit_Field_To_Zero (Init_Name, F_SPARK_Pragma); + Reinit_Field_To_Zero (Init_Name, F_SPARK_Pragma_Inherited); Mutate_Ekind (Init_Name, E_Loop_Parameter); -- The cursor was marked as a loop parameter to prevent user assignments @@ -5526,6 +5532,12 @@ package body Exp_Ch5 is Set_Assignment_OK (Cursor_Decl); Insert_Action (N, Cursor_Decl); + Reinit_Field_To_Zero (Cursor, F_Has_Initial_Value, + Old_Ekind => (E_Variable => True, others => False)); + Reinit_Field_To_Zero (Cursor, F_Is_Elaboration_Checks_OK_Id); + Reinit_Field_To_Zero (Cursor, F_Is_Elaboration_Warnings_OK_Id); + Reinit_Field_To_Zero (Cursor, F_SPARK_Pragma); + Reinit_Field_To_Zero (Cursor, F_SPARK_Pragma_Inherited); Mutate_Ekind (Cursor, Id_Kind); end; diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 51d33d36932..9f71b7d2b4e 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -249,6 +249,8 @@ begin -- Gen_IL.Gen.Gen_Entities -- resolution on calls). (Sm (Alignment, Unat), Sm (Contract, Node_Id), + Sm (First_Entity, Node_Id), + Sm (Last_Entity, Node_Id), Sm (Is_Elaboration_Warnings_OK_Id, Flag), Sm (Original_Record_Component, Node_Id), Sm (Scope_Depth_Value, Unat), @@ -284,14 +286,12 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Esize, Uint), Sm (RM_Size, Uint), Sm (Extra_Formal, Node_Id), - Sm (First_Entity, Node_Id), Sm (Generic_Homonym, Node_Id), Sm (Generic_Renamings, Elist_Id), Sm (Handler_Records, List_Id), Sm (Has_Static_Discriminants, Flag), Sm (Inner_Instances, Elist_Id), Sm (Interface_Name, Node_Id), - Sm (Last_Entity, Node_Id), Sm (Next_Inlined_Subprogram, Node_Id), Sm (Renamed_Or_Alias, Node_Id), -- See Einfo.Utils Sm (Return_Applies_To, Node_Id), @@ -467,6 +467,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Predicates_Ignored, Flag), Sm (Esize, Uint), Sm (Finalize_Storage_Only, Flag, Base_Type_Only), + Sm (First_Entity, Node_Id), + Sm (Last_Entity, Node_Id), Sm (Full_View, Node_Id), Sm (Has_Completion_In_Body, Flag), Sm (Has_Constrained_Partial_View, Flag, Base_Type_Only), @@ -525,7 +527,8 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Subprograms_For_Type, Elist_Id), Sm (Suppress_Initialization, Flag), Sm (Universal_Aliasing, Flag, Impl_Base_Type_Only), - Sm (Renamed_Or_Alias, Node_Id))); + Sm (Renamed_Or_Alias, Node_Id), + Sm (Stored_Constraint, Elist_Id))); Ab (Elementary_Kind, Type_Kind); @@ -550,8 +553,7 @@ begin -- Gen_IL.Gen.Gen_Entities Cc (E_Enumeration_Type, Enumeration_Kind, -- Enumeration types, created by an enumeration type declaration - (Sm (Enum_Pos_To_Rep, Node_Id), - Sm (First_Entity, Node_Id))); + (Sm (Enum_Pos_To_Rep, Node_Id))); Cc (E_Enumeration_Subtype, Enumeration_Kind); -- Enumeration subtypes, created by an explicit or implicit subtype @@ -560,8 +562,7 @@ begin -- Gen_IL.Gen.Gen_Entities Ab (Integer_Kind, Discrete_Kind, (Sm (Has_Shift_Operator, Flag, Base_Type_Only))); - Ab (Signed_Integer_Kind, Integer_Kind, - (Sm (First_Entity, Node_Id))); + Ab (Signed_Integer_Kind, Integer_Kind); Cc (E_Signed_Integer_Type, Signed_Integer_Kind); -- Signed integer type, used for the anonymous base type of the @@ -669,10 +670,9 @@ begin -- Gen_IL.Gen.Gen_Entities -- context does not provide one, the backend will see Allocator_Type -- itself (which will already have been frozen). - Cc (E_General_Access_Type, Access_Kind, + Cc (E_General_Access_Type, Access_Kind); -- An access type created by an access type declaration with the all -- keyword present. - (Sm (First_Entity, Node_Id))); Ab (Access_Subprogram_Kind, Access_Kind); @@ -728,14 +728,12 @@ begin -- Gen_IL.Gen.Gen_Entities Cc (E_Array_Type, Array_Kind, -- An array type created by an array type declaration. Includes all -- cases of arrays, except for string types. - (Sm (First_Entity, Node_Id), - Sm (Static_Real_Or_String_Predicate, Node_Id))); + (Sm (Static_Real_Or_String_Predicate, Node_Id))); Cc (E_Array_Subtype, Array_Kind, -- An array subtype, created by an explicit array subtype declaration, -- or the use of an anonymous array subtype. (Sm (Predicated_Parent, Node_Id), - Sm (First_Entity, Node_Id), Sm (Static_Real_Or_String_Predicate, Node_Id))); Cc (E_String_Literal_Subtype, Array_Kind, @@ -747,16 +745,13 @@ begin -- Gen_IL.Gen.Gen_Entities Ab (Class_Wide_Kind, Aggregate_Kind, (Sm (C_Pass_By_Copy, Flag, Impl_Base_Type_Only), Sm (Equivalent_Type, Node_Id), - Sm (First_Entity, Node_Id), Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), Sm (Interfaces, Elist_Id), - Sm (Last_Entity, Node_Id), Sm (No_Reordering, Flag, Impl_Base_Type_Only), Sm (Non_Limited_View, Node_Id), Sm (Parent_Subtype, Node_Id, Base_Type_Only), - Sm (Reverse_Bit_Order, Flag, Base_Type_Only), - Sm (Stored_Constraint, Elist_Id))); + Sm (Reverse_Bit_Order, Flag, Base_Type_Only))); Cc (E_Class_Wide_Type, Class_Wide_Kind, -- A class wide type, created by any tagged type declaration (i.e. if @@ -778,15 +773,12 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Corresponding_Concurrent_Type, Node_Id), Sm (Corresponding_Remote_Type, Node_Id), Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only), - Sm (First_Entity, Node_Id), Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), Sm (Interfaces, Elist_Id), - Sm (Last_Entity, Node_Id), Sm (No_Reordering, Flag, Impl_Base_Type_Only), Sm (Parent_Subtype, Node_Id, Base_Type_Only), Sm (Reverse_Bit_Order, Flag, Base_Type_Only), - Sm (Stored_Constraint, Elist_Id), Sm (Underlying_Record_View, Node_Id))); Cc (E_Record_Subtype, Aggregate_Kind, @@ -798,22 +790,16 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Corresponding_Remote_Type, Node_Id), Sm (Predicated_Parent, Node_Id), Sm (Dispatch_Table_Wrappers, Elist_Id, Impl_Base_Type_Only), - Sm (First_Entity, Node_Id), Sm (Has_Complex_Representation, Flag, Impl_Base_Type_Only), Sm (Has_Record_Rep_Clause, Flag, Impl_Base_Type_Only), Sm (Interfaces, Elist_Id), - Sm (Last_Entity, Node_Id), Sm (No_Reordering, Flag, Impl_Base_Type_Only), Sm (Parent_Subtype, Node_Id, Base_Type_Only), Sm (Reverse_Bit_Order, Flag, Base_Type_Only), - Sm (Stored_Constraint, Elist_Id), Sm (Underlying_Record_View, Node_Id))); Ab (Incomplete_Or_Private_Kind, Composite_Kind, - (Sm (First_Entity, Node_Id), - Sm (Last_Entity, Node_Id), - Sm (Private_Dependents, Elist_Id), - Sm (Stored_Constraint, Elist_Id))); + (Sm (Private_Dependents, Elist_Id))); Ab (Private_Kind, Incomplete_Or_Private_Kind, (Sm (Underlying_Full_View, Node_Id))); @@ -893,11 +879,8 @@ begin -- Gen_IL.Gen.Gen_Entities Ab (Concurrent_Kind, Composite_Kind, (Sm (Corresponding_Record_Type, Node_Id), - Sm (First_Entity, Node_Id), Sm (First_Private_Entity, Node_Id), - Sm (Last_Entity, Node_Id), - Sm (Scope_Depth_Value, Unat), - Sm (Stored_Constraint, Elist_Id))); + Sm (Scope_Depth_Value, Unat))); Ab (Task_Kind, Concurrent_Kind, (Sm (Has_Storage_Size_Clause, Flag, Impl_Base_Type_Only), @@ -951,8 +934,6 @@ begin -- Gen_IL.Gen.Gen_Entities (Sm (Access_Subprogram_Wrapper, Node_Id), Sm (Extra_Accessibility_Of_Result, Node_Id), Sm (Extra_Formals, Node_Id), - Sm (First_Entity, Node_Id), - Sm (Last_Entity, Node_Id), Sm (Needs_No_Actuals, Flag))); Ab (Overloadable_Kind, Entity_Kind, diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 1c4d575d33a..f7f02a2c2ee 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4194,6 +4194,10 @@ package body Sem_Ch10 is Set_Subtype_Indication (Decl, New_Occurrence_Of (Non_Lim_View, Sloc (Def_Id))); Set_Etype (Def_Id, Non_Lim_View); + Reinit_Field_To_Zero (Def_Id, F_Non_Limited_View, + Old_Ekind => (E_Incomplete_Subtype => True, + others => False)); + Reinit_Field_To_Zero (Def_Id, F_Private_Dependents); Mutate_Ekind (Def_Id, Subtype_Kind (Ekind (Non_Lim_View))); Set_Analyzed (Decl, False); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 299ea6e989f..66013ca0134 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6462,13 +6462,6 @@ package body Sem_Ch3 is end if; if Nkind (Def) = N_Constrained_Array_Definition then - - if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, F_Stored_Constraint); - else - pragma Assert (Ekind (T) = E_Void); - end if; - -- Establish Implicit_Base as unconstrained base type Implicit_Base := Create_Itype (E_Array_Type, P, Related_Id, 'B'); @@ -6509,13 +6502,6 @@ package body Sem_Ch3 is -- Unconstrained array case else pragma Assert (Nkind (Def) = N_Unconstrained_Array_Definition); - - if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, F_Stored_Constraint); - else - pragma Assert (Ekind (T) = E_Void); - end if; - Mutate_Ekind (T, E_Array_Type); Reinit_Size_Align (T); Set_Etype (T, T); @@ -10030,9 +10016,9 @@ package body Sem_Ch3 is -- Set common attributes if Ekind (Derived_Type) in Incomplete_Or_Private_Kind - and then Ekind (Parent_Base) in Modular_Integer_Kind | Array_Kind + and then Ekind (Parent_Base) in Elementary_Kind then - Reinit_Field_To_Zero (Derived_Type, F_Stored_Constraint); + Reinit_Field_To_Zero (Derived_Type, F_Discriminant_Constraint); end if; Set_Scope (Derived_Type, Current_Scope); @@ -17367,8 +17353,8 @@ package body Sem_Ch3 is Error_Msg_N ("type cannot be used in its own definition", Indic); end if; - Mutate_Ekind (T, Ekind (Parent_Type)); - Set_Etype (T, Any_Type); + Mutate_Ekind (T, Ekind (Parent_Type)); + Set_Etype (T, Any_Type); Set_Scalar_Range (T, Scalar_Range (Any_Type)); -- Initialize the list of primitive operations to an empty list, @@ -19726,6 +19712,9 @@ package body Sem_Ch3 is if Ekind (CW_Type) in E_Task_Type | E_Protected_Type then Reinit_Field_To_Zero (CW_Type, F_SPARK_Aux_Pragma_Inherited); end if; + + elsif Ekind (CW_Type) = E_Record_Type then + Reinit_Field_To_Zero (CW_Type, F_Corresponding_Concurrent_Type); end if; Mutate_Ekind (CW_Type, E_Class_Wide_Type); @@ -20112,10 +20101,6 @@ package body Sem_Ch3 is Analyze_And_Resolve (Mod_Expr, Any_Integer); - if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, F_Stored_Constraint); - end if; - Set_Etype (T, T); Mutate_Ekind (T, E_Modular_Integer_Type); Reinit_Alignment (T); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d4701aed0f7..8c1fb8c4f32 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1225,6 +1225,10 @@ package body Sem_Ch6 is (E_Function | E_Procedure | E_Generic_Function | E_Generic_Procedure => True, others => False)); + Reinit_Field_To_Zero (Body_Id, F_Needs_No_Actuals); + if Ekind (Body_Id) in E_Function | E_Procedure then + Reinit_Field_To_Zero (Body_Id, F_Is_Inlined_Always); + end if; Mutate_Ekind (Body_Id, E_Subprogram_Body); Set_Convention (Body_Id, Convention (Gen_Id)); Set_Is_Obsolescent (Body_Id, Is_Obsolescent (Gen_Id)); @@ -4002,13 +4006,17 @@ package body Sem_Ch6 is Reference_Body_Formals (Spec_Id, Body_Id); end if; - Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter); - Reinit_Field_To_Zero (Body_Id, F_Needs_No_Actuals, - Old_Ekind => (E_Function | E_Procedure => True, others => False)); - Reinit_Field_To_Zero (Body_Id, F_Is_Predicate_Function, - Old_Ekind => (E_Function | E_Procedure => True, others => False)); - Reinit_Field_To_Zero (Body_Id, F_Protected_Subprogram, + Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter, Old_Ekind => (E_Function | E_Procedure => True, others => False)); + Reinit_Field_To_Zero (Body_Id, F_Needs_No_Actuals); + Reinit_Field_To_Zero (Body_Id, F_Is_Predicate_Function); + Reinit_Field_To_Zero (Body_Id, F_Protected_Subprogram); + Reinit_Field_To_Zero (Body_Id, F_Is_Inlined_Always); + Reinit_Field_To_Zero (Body_Id, F_Is_Generic_Actual_Subprogram); + Reinit_Field_To_Zero (Body_Id, F_Is_Primitive_Wrapper); + Reinit_Field_To_Zero (Body_Id, F_Is_Private_Primitive); + Reinit_Field_To_Zero (Body_Id, F_Original_Protected_Subprogram); + Reinit_Field_To_Zero (Body_Id, F_Wrapped_Entity); if Ekind (Body_Id) = E_Procedure then Reinit_Field_To_Zero (Body_Id, F_Receiving_Entry); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 1f1fbd3c703..e8eb652c0ea 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -897,6 +897,9 @@ package body Sem_Ch7 is -- current node otherwise. Note that N was rewritten above, so we must -- be sure to get the latest Body_Id value. + if Ekind (Body_Id) = E_Package then + Reinit_Field_To_Zero (Body_Id, F_Body_Needed_For_Inlining); + end if; Mutate_Ekind (Body_Id, E_Package_Body); Set_Body_Entity (Spec_Id, Body_Id); Set_Spec_Entity (Body_Id, Spec_Id); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index e4b3519bbaa..730d236b8dd 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3485,9 +3485,13 @@ package body Sem_Ch8 is -- constructed later at the freeze point, so indicate that the -- completion has not been seen yet. - Reinit_Field_To_Zero (New_S, F_Has_Out_Or_In_Out_Parameter); - Reinit_Field_To_Zero (New_S, F_Needs_No_Actuals, + Reinit_Field_To_Zero (New_S, F_Has_Out_Or_In_Out_Parameter, Old_Ekind => (E_Function | E_Procedure => True, others => False)); + Reinit_Field_To_Zero (New_S, F_Needs_No_Actuals); + Reinit_Field_To_Zero (New_S, F_Is_Predicate_Function); + Reinit_Field_To_Zero (New_S, F_Protected_Subprogram); + Reinit_Field_To_Zero (New_S, F_Is_Inlined_Always); + Reinit_Field_To_Zero (New_S, F_Is_Generic_Actual_Subprogram); Mutate_Ekind (New_S, E_Subprogram_Body); New_S := Rename_Spec; Set_Has_Completion (Rename_Spec, False);