From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-ej1-x62c.google.com (mail-ej1-x62c.google.com [IPv6:2a00:1450:4864:20::62c]) by sourceware.org (Postfix) with ESMTPS id 708523954C4A for ; Thu, 2 Jun 2022 09:09:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 708523954C4A Received: by mail-ej1-x62c.google.com with SMTP id f9so8801703ejc.0 for ; Thu, 02 Jun 2022 02:09:00 -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=6SYmdyaViuIh9rYFwRiQrukr5zCcGq9tHEy9xEYcPHI=; b=0FdjSJ4Ty9C54XI7kITFT3ngxl6iUM/KyFdgweVn5u9MVsHU1kZ1gUEvKGCRKmJsaH zsS4SrBDefLtoPvNTrBawv++jsv8ba5sm/OYao+rFZALf1qIq/XHPVtcaiENoYOg2dvN jYNzUZ8U4wwslkEqSGLqZTz0yI0Oq4NS4r3sK1ifwUiQaAgBCQyIo8HZp6MTgSTxaJDm sJAj/QN4utuboKVg83ezeK5KSWqUlox/1uzs44AkZ9HaMtuxB4G1jZ3W+cNcWW7YXYDf P8KOniuxbpx5PRdpAhwffVjixF/FJ92g5DS4MNxKXxyG0sjqVcmmWiysSJWjHA/09c0e bRUw== X-Gm-Message-State: AOAM531gInOcEmxtTCmHqLbJFSb5xO2d9xfvUOCwse+CHJDenvVgOwZz mS7yre/JErpK2K3jI9CaMy18+cPjjPAEmQ== X-Google-Smtp-Source: ABdhPJwPR4LlA+3LMLcc0I47Pqgm6MMc2Qwv8m2vwthyeRcSxDWC6bRyiB8nJJJV9w/R6OrkF0eDRw== X-Received: by 2002:a17:906:7315:b0:6fe:a656:d898 with SMTP id di21-20020a170906731500b006fea656d898mr3245798ejc.578.1654160940044; Thu, 02 Jun 2022 02:09:00 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id p6-20020a05640210c600b0042ab87ea713sm2155022edu.22.2022.06.02.02.08.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 02 Jun 2022 02:08:59 -0700 (PDT) Date: Thu, 2 Jun 2022 09:08:58 +0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Build static dispatch tables always at the end of declarative part Message-ID: <20220602090858.GA1010710@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="fdj2RfSjLxBAspz7" 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-List-Received-Date: Thu, 02 Jun 2022 09:09:02 -0000 --fdj2RfSjLxBAspz7 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline The static dispatch tables of library-level tagged types are either built on the first object declaration or at the end of the declarative part of the package spec or body. There is no real need for the former case, and the tables are not built for other constructs that freeze (tagged) types. Therefore this change removes the former case, thus causing the tables to be always built at the end of the declarative part; that's orthogonal to freezing and the tagged types are still frozen at the appropriate place. Moreover, it wraps the code in the Actions list of a freeze node (like for the nonstatic case) so that it is considered elaboration code by the processing done in Sem_Elab and does not disturb it. No functional changes. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_ch3.adb (Expand_Freeze_Record_Type): Adjust comment. (Expand_N_Object_Declaration): Do not build static dispatch tables. * exp_disp.adb (Make_And_Insert_Dispatch_Table): New procedure. (Build_Static_Dispatch_Tables): Call it to build the dispatch tables and wrap them in the Actions list of a freeze node. --fdj2RfSjLxBAspz7 Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" 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 @@ -5763,7 +5763,7 @@ package body Exp_Ch3 is -- Generate dispatch table of locally defined tagged type. -- Dispatch tables of library level tagged types are built - -- later (see Analyze_Declarations). + -- later (see Build_Static_Dispatch_Tables). if not Building_Static_DT (Typ) then Append_Freeze_Actions (Typ, Make_DT (Typ)); @@ -6907,37 +6907,6 @@ package body Exp_Ch3 is return; end if; - -- First we do special processing for objects of a tagged type where - -- this is the point at which the type is frozen. The creation of the - -- dispatch table and the initialization procedure have to be deferred - -- to this point, since we reference previously declared primitive - -- subprograms. - - -- Force construction of dispatch tables of library level tagged types - - if Tagged_Type_Expansion - and then Building_Static_Dispatch_Tables - and then Is_Library_Level_Entity (Def_Id) - and then Is_Library_Level_Tagged_Type (Base_Typ) - and then Ekind (Base_Typ) in E_Record_Type - | E_Protected_Type - | E_Task_Type - and then not Has_Dispatch_Table (Base_Typ) - then - declare - New_Nodes : List_Id := No_List; - - begin - if Is_Concurrent_Type (Base_Typ) then - New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ)); - else - New_Nodes := Make_DT (Base_Typ); - end if; - - Insert_List_Before (N, New_Nodes); - end; - end if; - -- Make shared memory routines for shared passive variable if Is_Shared_Passive (Def_Id) then diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -358,6 +358,12 @@ package body Exp_Disp is procedure Build_Package_Dispatch_Tables (N : Node_Id); -- Build static dispatch tables associated with package declaration N + procedure Make_And_Insert_Dispatch_Table (Typ : Entity_Id); + -- Build the dispatch table of the tagged type Typ and insert it at the + -- end of Target_List after wrapping it in the Actions list of a freeze + -- node, so that it is skipped by Sem_Elab (Expand_Freeze_Record_Type + -- does the same for nonstatic dispatch tables). + --------------------------- -- Build_Dispatch_Tables -- --------------------------- @@ -410,8 +416,7 @@ package body Exp_Disp is then null; else - Insert_List_After_And_Analyze (Last (Target_List), - Make_DT (Defining_Entity (D))); + Make_And_Insert_Dispatch_Table (Defining_Entity (D)); end if; -- Handle private types of library level tagged types. We must @@ -434,8 +439,7 @@ package body Exp_Disp is and then not Is_Concurrent_Type (E2) then Exchange_Declarations (E1); - Insert_List_After_And_Analyze (Last (Target_List), - Make_DT (E1)); + Make_And_Insert_Dispatch_Table (E1); Exchange_Declarations (E2); end if; end; @@ -469,6 +473,25 @@ package body Exp_Disp is Pop_Scope; end Build_Package_Dispatch_Tables; + ------------------------------------ + -- Make_And_Insert_Dispatch_Table -- + ------------------------------------ + + procedure Make_And_Insert_Dispatch_Table (Typ : Entity_Id) is + F_Typ : constant Entity_Id := Create_Itype (E_Class_Wide_Type, Typ); + -- The code generator discards freeze nodes of CW types after + -- evaluating their side effects, so create an artificial one. + + F_Nod : constant Node_Id := Make_Freeze_Entity (Sloc (Typ)); + + begin + Set_Is_Frozen (F_Typ); + Set_Entity (F_Nod, F_Typ); + Set_Actions (F_Nod, Make_DT (Typ)); + + Insert_After_And_Analyze (Last (Target_List), F_Nod); + end Make_And_Insert_Dispatch_Table; + -- Start of processing for Build_Static_Dispatch_Tables begin --fdj2RfSjLxBAspz7--