From patchwork Tue May 23 08:09:08 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: 97861 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp1976163vqo; Tue, 23 May 2023 01:16:55 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ4G+9dTIvl7GlEK/EtAoYPP0nul/448dqBtQ8GbuIyfKHiW7Gxyon1G2eBk/9ExUOBS0ZUB X-Received: by 2002:a17:906:9b84:b0:968:2b4a:aba3 with SMTP id dd4-20020a1709069b8400b009682b4aaba3mr16395429ejc.5.1684829815764; Tue, 23 May 2023 01:16:55 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684829815; cv=none; d=google.com; s=arc-20160816; b=qADwEFJEEzeBNqe4R80tFkaD0jN2l46B98mkcq9VbxOz5rK2Xx8AcHlbdAiejd1NiX T3N/ZsLUKOkaZVglr6Gs00UYu3MGUKYu5KzfJouxLf/ukV0LHIG50GJNor4BVz+kepCk du349aZatkNrAlAoKhIWzj8bxjlEg5E7S56Yvv7TA/1MRZ5OZCUXCB9gdL2m+kKUBFbE usKIDcW4fJbp2y3meBdgqvWMgTjLQUsHtwcsfOod51aof6aEvPEsQ6nhbHeHkMDNY82l yt5KfrkGwOQplRdW3Q5n+5PqPNZrl8qfd8f5bN9InfR9OIeyI8o4ec7IeG9Nvf9XPxs7 V5pg== 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=DyLKHZ4ETQWRD0C327pl5xS+7yHQubUFuIw67uKkUeo=; b=pufx15rnoTHAWWy9A21YgJl9a9lutaPK1pry7oIrA3UEaLez7aoHOcoRYPZB8s4f2j bnjBLq6DnNnboqrh5rlNGVqma8xrGhUU/V2hDW1EYUo1NuoSFAUHbZo6NvyGAJOgJuUD TJ4Ph1I98MpxmoZzGdEjFiNiuANAqM+pGXPKwlbJhC/NVpl2+syGoDLWVfKrXECUu4mD re8JE2yqAP4RBg3GgHeZqoeHlDe4BRAM8DvELuRusWVWDSNYE5vUDlf1oN1R60/I/Fuu Jdy9StySDVy4T7u9Ly+wWHTgTz3iGPDEYPWzQfxcke65HQUXn03WCmk9tOyDMwcTXM6j UBOg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=qL0Tzuum; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id gy7-20020a170906f24700b0096f57693a81si4277817ejb.566.2023.05.23.01.16.55 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:16:55 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=qL0Tzuum; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 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 5A7343946C36 for ; Tue, 23 May 2023 08:11:58 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5A7343946C36 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684829518; bh=DyLKHZ4ETQWRD0C327pl5xS+7yHQubUFuIw67uKkUeo=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=qL0Tzuum0p5zNC/Z7HuGFBlwNZerUUnDzx8D1FeuUOugNxnUY8LnIp93NqGVep0o5 4FC2GF+EXNuLuEKRbDUJtcZk8Hj7gaAhVyFG+DgmnphkynlHEGj9eW7QIqIaDJb1ZI oQPBc/jongcNK7nuq8KBbsYI1KhfJtY2DdW/X9b4= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x432.google.com (mail-wr1-x432.google.com [IPv6:2a00:1450:4864:20::432]) by sourceware.org (Postfix) with ESMTPS id 584BC3883017 for ; Tue, 23 May 2023 08:09:12 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 584BC3883017 Received: by mail-wr1-x432.google.com with SMTP id ffacd0b85a97d-30a8fa6e6fcso1504677f8f.1 for ; Tue, 23 May 2023 01:09:12 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684829350; x=1687421350; 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=DyLKHZ4ETQWRD0C327pl5xS+7yHQubUFuIw67uKkUeo=; b=BDb0o4eFBHnSFWyUZFB8irL/15+o+nbTDs3A30plfBz064xSnQiuFfRZbSgot0sITh 5d3kYUxfSRdIYwB87geEX5Nh6BZq0ll0dt+rvFTN+LTHztovIHmdHI0RVgy3Da7KYoOJ Hu9+gnaB1KqXdN6NX0TM3JwP2KGNjBT342wVVoNJJvupLJEHxDdCK1/sIeQlp+G3DsQ7 FyCnpgpp8TxkPuh0RjaLXn5WZPs+uhhQ5KYJaPhS9D/dr5BoyZQZfWh8qWp6MexTwO+i nPHPa32LIMlFqk2D2eNFHs+FHT+R9h/xkung8/CrR+EirUGpqHqX122MARUfxb3Iy14A 4QOg== X-Gm-Message-State: AC+VfDzBWTE4jPS8jjnzaqZ0GfNykEBCnATx5kwK23TqrGjbSIxcKVQy g7N6Gv32bOMwhGvUVcfV+dXV/mXUNLUwF4EQvvYV0g== X-Received: by 2002:adf:f711:0:b0:2ff:f37:9d0f with SMTP id r17-20020adff711000000b002ff0f379d0fmr9522832wrp.57.1684829350163; Tue, 23 May 2023 01:09:10 -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 s4-20020a5d4244000000b00307bc4e39e5sm10105572wrr.117.2023.05.23.01.09.09 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:09:09 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix address manipulation issue in the tasking runtime Date: Tue, 23 May 2023 10:09:08 +0200 Message-Id: <20230523080908.1874670-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 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: =?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?1766672108461885888?= X-GMAIL-MSGID: =?utf-8?q?1766672108461885888?= From: Eric Botcazou The implementation of task attributes in the runtime defines an atomic clone of System.Address, which is awkward for targets where addresses and pointers have a specific representation, so this change replaces that with a pragma Atomic_Components on the Attribute_Array type. gcc/ada/ * libgnarl/s-taskin.ads (Atomic_Address): Delete. (Attribute_Array): Add pragma Atomic_Components. (Ada_Task_Control_Block): Adjust default value of Attributes. * libgnarl/s-tasini.adb (Finalize_Attributes): Adjust type of local variable. * libgnarl/s-tataat.ads (Deallocator): Adjust type of parameter. (To_Attribute): Adjust source type. * libgnarl/a-tasatt.adb: Add clauses for System.Storage_Elements. (New_Attribute): Adjust return type. (Deallocate): Adjust type of parameter. (To_Real_Attribute): Adjust source type. (To_Address): Add target type. (To_Attribute): Adjust source type. (Fast_Path): Adjust tested type. (Finalize): Compare with Null_Address. (Reference): Likewise. (Reinitialize): Likewise. (Set_Value): Likewise. Add conversion to Integer_Address. (Value): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/a-tasatt.adb | 51 ++++++++++++++++++----------------- gcc/ada/libgnarl/s-tasini.adb | 2 +- gcc/ada/libgnarl/s-taskin.ads | 9 +++---- gcc/ada/libgnarl/s-tataat.ads | 4 +-- 4 files changed, 33 insertions(+), 33 deletions(-) diff --git a/gcc/ada/libgnarl/a-tasatt.adb b/gcc/ada/libgnarl/a-tasatt.adb index fb3ca682f15..6111f2987a5 100644 --- a/gcc/ada/libgnarl/a-tasatt.adb +++ b/gcc/ada/libgnarl/a-tasatt.adb @@ -29,6 +29,7 @@ -- -- ------------------------------------------------------------------------------ +with System.Storage_Elements; with System.Tasking; with System.Tasking.Initialization; with System.Tasking.Task_Attributes; @@ -43,6 +44,7 @@ with Ada.Unchecked_Deallocation; package body Ada.Task_Attributes is use System, + System.Storage_Elements, System.Tasking.Initialization, System.Tasking, System.Tasking.Task_Attributes; @@ -75,34 +77,32 @@ package body Ada.Task_Attributes is -- System.Tasking.Task_Attributes.Attribute_Record and to allow unchecked -- conversions between Attribute_Access and Real_Attribute_Access. - function New_Attribute (Val : Attribute) return Atomic_Address; + function New_Attribute (Val : Attribute) return System.Address; -- Create a new Real_Attribute using Val, and return its address. The -- returned value can be converted via To_Real_Attribute. - procedure Deallocate (Ptr : Atomic_Address); + procedure Deallocate (Ptr : System.Address); -- Free memory associated with Ptr, a Real_Attribute_Access in reality function To_Real_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Real_Attribute_Access); + Ada.Unchecked_Conversion (System.Address, Real_Attribute_Access); pragma Warnings (Off); -- Kill warning about possible size mismatch function To_Address is new - Ada.Unchecked_Conversion (Attribute, Atomic_Address); + Ada.Unchecked_Conversion (Attribute, System.Address); function To_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Attribute); + Ada.Unchecked_Conversion (System.Address, Attribute); type Unsigned is mod 2 ** Integer'Size; - function To_Address is new - Ada.Unchecked_Conversion (Attribute, System.Address); function To_Unsigned is new Ada.Unchecked_Conversion (Attribute, Unsigned); pragma Warnings (On); function To_Address is new - Ada.Unchecked_Conversion (Real_Attribute_Access, Atomic_Address); + Ada.Unchecked_Conversion (Real_Attribute_Access, System.Address); pragma Warnings (Off); -- Kill warning about possible aliasing @@ -121,12 +121,12 @@ package body Ada.Task_Attributes is Fast_Path : constant Boolean := (Attribute'Size = Integer'Size - and then Attribute'Alignment <= Atomic_Address'Alignment + and then Attribute'Alignment <= System.Address'Alignment and then To_Unsigned (Initial_Value) = 0) or else (Attribute'Size = System.Address'Size - and then Attribute'Alignment <= Atomic_Address'Alignment - and then To_Address (Initial_Value) = System.Null_Address); - -- If the attribute fits in an Atomic_Address (both size and alignment) + and then Attribute'Alignment <= System.Address'Alignment + and then To_Address (Initial_Value) = Null_Address); + -- If the attribute fits in a System.Address (both size and alignment) -- and Initial_Value is 0 (or null), then we will map the attribute -- directly into ATCB.Attributes (Index), otherwise we will create -- a level of indirection and instead use Attributes (Index) as a @@ -153,11 +153,11 @@ package body Ada.Task_Attributes is while C /= null loop STPO.Write_Lock (C); - if C.Attributes (Index) /= 0 + if C.Attributes (Index) /= Null_Address and then Require_Finalization (Index) then Deallocate (C.Attributes (Index)); - C.Attributes (Index) := 0; + C.Attributes (Index) := Null_Address; end if; STPO.Unlock (C); @@ -173,7 +173,7 @@ package body Ada.Task_Attributes is -- Deallocate -- ---------------- - procedure Deallocate (Ptr : Atomic_Address) is + procedure Deallocate (Ptr : System.Address) is Obj : Real_Attribute_Access := To_Real_Attribute (Ptr); begin Free (Obj); @@ -183,7 +183,7 @@ package body Ada.Task_Attributes is -- New_Attribute -- ------------------- - function New_Attribute (Val : Attribute) return Atomic_Address is + function New_Attribute (Val : Attribute) return System.Address is Tmp : Real_Attribute_Access; begin Tmp := new Real_Attribute'(Free => Deallocate'Unrestricted_Access, @@ -223,7 +223,7 @@ package body Ada.Task_Attributes is Self_Id := STPO.Self; Task_Lock (Self_Id); - if TT.Attributes (Index) = 0 then + if TT.Attributes (Index) = Null_Address then TT.Attributes (Index) := New_Attribute (Initial_Value); end if; @@ -266,11 +266,11 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr /= 0 then + if Attr /= Null_Address then Deallocate (Attr); - Attr := 0; + Attr := Null_Address; end if; end; @@ -304,7 +304,8 @@ package body Ada.Task_Attributes is -- No finalization needed, simply set to Val if Attribute'Size = Integer'Size then - TT.Attributes (Index) := Atomic_Address (To_Unsigned (Val)); + TT.Attributes (Index) := + To_Address (Integer_Address (To_Unsigned (Val))); else TT.Attributes (Index) := To_Address (Val); end if; @@ -314,10 +315,10 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr /= 0 then + if Attr /= Null_Address then Deallocate (Attr); end if; @@ -357,10 +358,10 @@ package body Ada.Task_Attributes is Task_Lock (Self_Id); declare - Attr : Atomic_Address renames TT.Attributes (Index); + Attr : System.Address renames TT.Attributes (Index); begin - if Attr = 0 then + if Attr = Null_Address then Task_Unlock (Self_Id); return Initial_Value; diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb index 24f4ba2085a..2000543ee2b 100644 --- a/gcc/ada/libgnarl/s-tasini.adb +++ b/gcc/ada/libgnarl/s-tasini.adb @@ -758,7 +758,7 @@ package body System.Tasking.Initialization is ------------------------- procedure Finalize_Attributes (T : Task_Id) is - Attr : Atomic_Address; + Attr : System.Address; begin for J in T.Attributes'Range loop diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads index 47c5ca25a03..5aa3e37a904 100644 --- a/gcc/ada/libgnarl/s-taskin.ads +++ b/gcc/ada/libgnarl/s-taskin.ads @@ -958,11 +958,10 @@ package System.Tasking is type Entry_Call_Array is array (ATC_Level_Index) of aliased Entry_Call_Record; - type Atomic_Address is mod Memory_Size; - pragma Atomic (Atomic_Address); type Attribute_Array is - array (1 .. Parameters.Max_Attribute_Count) of Atomic_Address; - -- Array of task attributes. The value (Atomic_Address) will either be + array (1 .. Parameters.Max_Attribute_Count) of System.Address; + pragma Atomic_Components (Attribute_Array); + -- Array of task attributes. The value (System.Address) will either be -- converted to a task attribute if it fits, or to a pointer to a record -- by Ada.Task_Attributes. @@ -1157,7 +1156,7 @@ package System.Tasking is -- non-terminated task so that the associated storage is automatically -- reclaimed when the task terminates. - Attributes : Attribute_Array := [others => 0]; + Attributes : Attribute_Array := [others => Null_Address]; -- Task attributes -- IMPORTANT Note: the Entry_Queues field is last for efficiency of diff --git a/gcc/ada/libgnarl/s-tataat.ads b/gcc/ada/libgnarl/s-tataat.ads index 002a7cec1fe..e6d597cf907 100644 --- a/gcc/ada/libgnarl/s-tataat.ads +++ b/gcc/ada/libgnarl/s-tataat.ads @@ -35,7 +35,7 @@ with Ada.Unchecked_Conversion; package System.Tasking.Task_Attributes is - type Deallocator is access procedure (Ptr : Atomic_Address); + type Deallocator is access procedure (Ptr : System.Address); pragma Favor_Top_Level (Deallocator); type Attribute_Record is record @@ -48,7 +48,7 @@ package System.Tasking.Task_Attributes is pragma No_Strict_Aliasing (Attribute_Access); function To_Attribute is new - Ada.Unchecked_Conversion (Atomic_Address, Attribute_Access); + Ada.Unchecked_Conversion (System.Address, Attribute_Access); function Next_Index (Require_Finalization : Boolean) return Integer; -- Return the next attribute index available. Require_Finalization is True