From patchwork Wed Jun 16 08:43:55 2021 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: 1492820 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G4f841ZLkz9sXL for ; Wed, 16 Jun 2021 18:52:20 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 50561398980E for ; Wed, 16 Jun 2021 08:52:17 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [IPv6:2620:20:4000:0:a9e:1ff:fe9b:1d1]) by sourceware.org (Postfix) with ESMTPS id 605A5394341C for ; Wed, 16 Jun 2021 08:43:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 605A5394341C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 01C145615C; Wed, 16 Jun 2021 04:43:56 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id zh2OXIRQ-XkU; Wed, 16 Jun 2021 04:43:55 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id DF20256157; Wed, 16 Jun 2021 04:43:55 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id DE228180; Wed, 16 Jun 2021 04:43:55 -0400 (EDT) Date: Wed, 16 Jun 2021 04:43:55 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Wrong reference to System.Tasking in expanded code Message-ID: <20210616084355.GA95682@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: , Cc: Arnaud Charlet Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The expanded code should never reference entities in the tasking runtime (libgnarl) except when expanding tasking constructs directly. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * rtsfind.ads, libgnarl/s-taskin.ads, exp_ch3.adb, exp_ch4.adb, exp_ch6.adb, exp_ch9.adb, sem_ch6.adb: Move master related entities to the expander directly. 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 @@ -1696,8 +1696,7 @@ package body Exp_Ch3 is if Has_Task (Full_Type) then if Restriction_Active (No_Task_Hierarchy) then - Append_To (Args, - New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc)); + Append_To (Args, Make_Integer_Literal (Loc, Library_Task_Level)); else Append_To (Args, Make_Identifier (Loc, Name_uMaster)); end if; @@ -2218,8 +2217,8 @@ package body Exp_Ch3 is if Has_Task (Rec_Type) then if Restriction_Active (No_Task_Hierarchy) then - Append_To (Args, - New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc)); + Append_To + (Args, Make_Integer_Literal (Loc, Library_Task_Level)); else Append_To (Args, Make_Identifier (Loc, Name_uMaster)); end if; @@ -9071,7 +9070,7 @@ package body Exp_Ch3 is Defining_Identifier => Make_Defining_Identifier (Loc, Name_uMaster), Parameter_Type => - New_Occurrence_Of (RTE (RE_Master_Id), Loc))); + New_Occurrence_Of (Standard_Integer, Loc))); Set_Has_Master_Entity (Proc_Id); 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 @@ -5193,8 +5193,8 @@ package body Exp_Ch4 is end if; if Restriction_Active (No_Task_Hierarchy) then - Append_To (Args, - New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc)); + Append_To + (Args, Make_Integer_Literal (Loc, Library_Task_Level)); else Append_To (Args, New_Occurrence_Of diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -602,7 +602,7 @@ package body Exp_Ch6 is -- Use a dummy _master actual in case of No_Task_Hierarchy if Restriction_Active (No_Task_Hierarchy) then - Actual := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc); + Actual := Make_Integer_Literal (Loc, Library_Task_Level); -- In the case where we use the master associated with an access type, -- the actual is an entity and requires an explicit reference. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1756,34 +1756,21 @@ package body Exp_Ch9 is -- Generate a dummy master if tasks or tasking hierarchies are -- prohibited. - -- _Master : constant Master_Id := 3; + -- _Master : constant Integer := Library_Task_Level; if not Tasking_Allowed or else Restrictions.Set (No_Task_Hierarchy) or else not RTE_Available (RE_Current_Master) then - declare - Expr : Node_Id; - - begin - -- RE_Library_Task_Level is not always available in configurable - -- RunTime - - if not RTE_Available (RE_Library_Task_Level) then - Expr := Make_Integer_Literal (Loc, Uint_3); - else - Expr := New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc); - end if; - - Master_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uMaster), - Constant_Present => True, - Object_Definition => - New_Occurrence_Of (Standard_Integer, Loc), - Expression => Expr); - end; + Master_Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uMaster), + Constant_Present => True, + Object_Definition => + New_Occurrence_Of (Standard_Integer, Loc), + Expression => + Make_Integer_Literal (Loc, Library_Task_Level)); -- Generate: -- _master : constant Integer := Current_Master.all; @@ -3628,7 +3615,8 @@ package body Exp_Ch9 is Master_Decl := Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Master_Id, - Subtype_Mark => New_Occurrence_Of (RTE (RE_Master_Id), Loc), + Subtype_Mark => + New_Occurrence_Of (Standard_Integer, Loc), Name => Make_Identifier (Loc, Name_uMaster)); Insert_Action (Context, Master_Decl); @@ -14710,8 +14698,7 @@ package body Exp_Ch9 is if Restriction_Active (No_Task_Hierarchy) = False then Append_To (Args, Make_Identifier (Loc, Name_uMaster)); else - Append_To (Args, - New_Occurrence_Of (RTE (RE_Library_Task_Level), Loc)); + Append_To (Args, Make_Integer_Literal (Loc, Library_Task_Level)); end if; end if; diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -773,6 +773,9 @@ package System.Tasking is Environment_Task_Level : constant Master_Level := 1; Independent_Task_Level : constant Master_Level := 2; Library_Task_Level : constant Master_Level := 3; + -- Note that the value of Library_Task_Level is also hard coded in the + -- compiler, see Rtsfind.Library_Task_Level. The two should be kept in + -- sync. ------------------- -- Priority info -- diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -29,6 +29,7 @@ -- not been explicitly With'ed. with Types; use Types; +with Uintp; use Uintp; package Rtsfind is @@ -1975,11 +1976,6 @@ package Rtsfind is RE_Conditional_Call, -- System.Tasking RE_Asynchronous_Call, -- System.Tasking - RE_Foreign_Task_Level, -- System.Tasking - RE_Environment_Task_Level, -- System.Tasking - RE_Independent_Task_Level, -- System.Tasking - RE_Library_Task_Level, -- System.Tasking - RE_Ada_Task_Control_Block, -- System.Tasking RE_Task_List, -- System.Tasking @@ -1996,7 +1992,6 @@ package Rtsfind is RE_Task_Entry_Index, -- System.Tasking RE_Self, -- System.Tasking - RE_Master_Id, -- System.Tasking RE_Unspecified_Priority, -- System.Tasking RE_Activation_Chain, -- System.Tasking @@ -3665,11 +3660,6 @@ package Rtsfind is RE_Conditional_Call => System_Tasking, RE_Asynchronous_Call => System_Tasking, - RE_Foreign_Task_Level => System_Tasking, - RE_Environment_Task_Level => System_Tasking, - RE_Independent_Task_Level => System_Tasking, - RE_Library_Task_Level => System_Tasking, - RE_Ada_Task_Control_Block => System_Tasking, RE_Task_List => System_Tasking, @@ -3686,7 +3676,6 @@ package Rtsfind is RE_Task_Entry_Index => System_Tasking, RE_Self => System_Tasking, - RE_Master_Id => System_Tasking, RE_Unspecified_Priority => System_Tasking, RE_Activation_Chain => System_Tasking, @@ -3994,6 +3983,9 @@ package Rtsfind is System_Unsigned_Types => True, others => False); + Library_Task_Level : constant Uint := Uint_3; + -- Corresponds to System.Tasking.Library_Task_Level + ----------------- -- Subprograms -- ----------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9042,7 +9042,7 @@ package body Sem_Ch6 is if Needs_BIP_Task_Actuals (E) then Discard := Add_Extra_Formal - (E, RTE (RE_Master_Id), + (E, Standard_Integer, E, BIP_Formal_Suffix (BIP_Task_Master)); Set_Has_Master_Entity (E);