From patchwork Tue May 23 08:08:36 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: 97838 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp1973849vqo; Tue, 23 May 2023 01:11:54 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ5cB3AR0zDY1N2j4byANa1MLylRQaJufJah/ee1T1am/5TVjkJ/T6yAu61XGV/gebZwf7eb X-Received: by 2002:a17:907:3184:b0:94f:3521:396 with SMTP id xe4-20020a170907318400b0094f35210396mr11106643ejb.23.1684829514228; Tue, 23 May 2023 01:11:54 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1684829514; cv=none; d=google.com; s=arc-20160816; b=BKmBBcHVOHRl8P3QY7caouowAtKgI+POQ9ZQmlcCfDZf8+n6sIlS+n5klyKDfI4VaY 2CvLk3ngMZxNO0/MrAV4u4CWXq+srlmkgdQ5YkruZwhHHHXzjULKzRyNHirkxwksAa2G hkbw7MLZbOuMFE9md1ZG8kRYa2vOoMM6Uki0mx7kPE8HiKLiDEqMjWw0hv3tNhnf6ScS BLTMchPe7haMVYaJToJYeMXR9GF3MI6EqYFxuknq9PA4CuDfXvd9lMUikyvUvn32poiq MQ07Q41GVcl+8Rf7U2u5AqqGbroyeuUmZyVNMREpO7QxbXAuV1TQSGcqgVlfyn8sLvPQ v9Vw== 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=U8QAbk9NVvxg/KXZj07nfyoYNPkvPTOS6CjtAeCxqs4=; b=YVaSnHSOhhIh6DD5NAs+ZMYm2OD4np0VQBRnzjE5RM0FvccnVCXFoc0aO6gvHApYu+ +TBQeWspaKEvZrfmHwSqXs7ewLaBe+0VYLX7BWDHy6ZuDucvIafDbHA7Jffme0rMscE/ qZf8Xg0heETeeDrI6Q+tBXgMhlKW9Bf9fpxtrwu4ZOmKG48PvhrwoO56zV1a5GClgkVa xuJIf9QwPdPZiupnUH184nJAiagh243yJYql+vAcu7TP/q1vY8l4bmghc15zg4mqHTuV rEAuMXuz/Q5I2tdbc6+EdHTiSIJGRkVMFmFL78ZN8xqSVlYIgM/BaXH8uTdzOBtzQM4c 35aA== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=phLoNeMd; 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 u8-20020aa7d888000000b0050b2f588dafsi4641080edq.219.2023.05.23.01.11.53 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:11:54 -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=phLoNeMd; 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 E89CA3888C40 for ; Tue, 23 May 2023 08:09:40 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E89CA3888C40 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1684829380; bh=U8QAbk9NVvxg/KXZj07nfyoYNPkvPTOS6CjtAeCxqs4=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=phLoNeMdvD3QCBfStNDRkMi0ZO/qjGyx5QI+htdd72x5KToz1yLNZtuc3HtQ8pBal xNjXaVsQIaom3GO2Pu4qnxyStnAzFsKrcVbIOa3ZWn+CVnRnOihLjeVSzwevKSOHHk gdM/ZA+RebyihFVEmRpzMEG/dQjx5zs0IiDl7Pdc= 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 5E77F388212D for ; Tue, 23 May 2023 08:08:38 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 5E77F388212D Received: by mail-wr1-x432.google.com with SMTP id ffacd0b85a97d-3078aa0b152so4591143f8f.3 for ; Tue, 23 May 2023 01:08:38 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684829318; x=1687421318; 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=U8QAbk9NVvxg/KXZj07nfyoYNPkvPTOS6CjtAeCxqs4=; b=EII1ilMP74rhMlC1Ge93ChQwkci9qe00TTIUaPcTArbLuLHfqbYgGg0VCNilYlbrd9 E3HOQSHoZWlOdS3QOmRxqnG1N1YTTlok48aBfhEYBTtgl8cnBRSYS7ZiWDTROp+rLjdu yQoJQF2UfkHNEi2s2M8tl9Ms8vzCgP9aoRHnlhfwnOjz5D7cG6lHzPSqZgY+CW2qRJR3 cxdr4DL5NregEZOi7LYQTRVOWOVGjpuS+qzMjbhInpbvmEc7KL209ah0/jbTX3KgdsrU Z835u7+Rr1KyfS8ykzDekaOW7eSBTtalR5bUav5/KaP/LseAK9Y98F4y6XiOSNe6axaP yc6Q== X-Gm-Message-State: AC+VfDzlOE2Djng0yOH1jX/MWVGkGgBUQ8fVw47vFDKTLHBUbBDqNs7a 1P8JEG4qJL8VrIAKXUJ/Ejm94HCWnqw93pgqJh5VLw== X-Received: by 2002:a5d:4908:0:b0:304:4460:11e7 with SMTP id x8-20020a5d4908000000b00304446011e7mr10428413wrq.51.1684829317772; Tue, 23 May 2023 01:08:37 -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 n11-20020a5d484b000000b00307c0afc030sm10391240wrs.4.2023.05.23.01.08.37 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:08:37 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix address arithmetic issues in the runtime Date: Tue, 23 May 2023 10:08:36 +0200 Message-Id: <20230523080836.1873982-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?1766671792691718796?= X-GMAIL-MSGID: =?utf-8?q?1766671792691718796?= From: Eric Botcazou This is most notably the addition of addresses in Interfaces.C.Pointers and System.Bitfield_Utils. There is also a change to System.Stream_Attributes, which was representing a thin pointer as a record, which is not problematic per se, but is in the end, because the expanded code performs an unchecked conversion from it to the access type instead of accessing the component. gcc/ada/ * libgnat/i-cpoint.adb: Add clauses for System.Storage_Elements. (Addr): Delete. (Offset): New subtype of Storage_Offset. (To_Offset): New instance of Unchecked_Conversion. (To_Pointer): Adjust. (To_Addr): Likewise. (To_Ptrdiff): Likewise. ("+"): Call To_Offset on the offset. ("-"): Likewise. * libgnat/s-bituti.adb: Add clauses for System.Storage_Elements. (Val_Bytes): Change type to Storage_Count. (Get_Val_2): Add qualification to second operand of mod operator. (Set_Val_2): Likewise. (Copy_Bitfield): Likewise. Change type of Src_Adjust & Dest_Adjust. * libgnat/s-stratt.ads (Thin_Pointer): Change to subtype of Address. * libgnat/s-statxd.adb (I_AD): Adjust. (I_AS): Likewise. (W_AS): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/i-cpoint.adb | 21 +++++++++++---------- gcc/ada/libgnat/s-bituti.adb | 17 ++++++++++------- gcc/ada/libgnat/s-statxd.adb | 8 ++++---- gcc/ada/libgnat/s-stratt.ads | 4 +--- 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/gcc/ada/libgnat/i-cpoint.adb b/gcc/ada/libgnat/i-cpoint.adb index bf08e1a74ac..e1805f497de 100644 --- a/gcc/ada/libgnat/i-cpoint.adb +++ b/gcc/ada/libgnat/i-cpoint.adb @@ -29,19 +29,20 @@ -- -- ------------------------------------------------------------------------------ -with Interfaces.C.Strings; use Interfaces.C.Strings; -with System; use System; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with System.Storage_Elements; use System.Storage_Elements; +with System; use System; with Ada.Unchecked_Conversion; package body Interfaces.C.Pointers is - type Addr is mod 2 ** System.Parameters.ptr_bits; + subtype Offset is Storage_Offset; - function To_Pointer is new Ada.Unchecked_Conversion (Addr, Pointer); - function To_Addr is new Ada.Unchecked_Conversion (Pointer, Addr); - function To_Addr is new Ada.Unchecked_Conversion (ptrdiff_t, Addr); - function To_Ptrdiff is new Ada.Unchecked_Conversion (Addr, ptrdiff_t); + function To_Pointer is new Ada.Unchecked_Conversion (Address, Pointer); + function To_Addr is new Ada.Unchecked_Conversion (Pointer, Address); + function To_Offset is new Ada.Unchecked_Conversion (ptrdiff_t, Offset); + function To_Ptrdiff is new Ada.Unchecked_Conversion (Offset, ptrdiff_t); Elmt_Size : constant ptrdiff_t := (Element_Array'Component_Size @@ -59,7 +60,7 @@ package body Interfaces.C.Pointers is raise Pointer_Error; end if; - return To_Pointer (To_Addr (Left) + To_Addr (Elmt_Size * Right)); + return To_Pointer (To_Addr (Left) + To_Offset (Elmt_Size * Right)); end "+"; function "+" (Left : ptrdiff_t; Right : Pointer) return Pointer is @@ -68,7 +69,7 @@ package body Interfaces.C.Pointers is raise Pointer_Error; end if; - return To_Pointer (To_Addr (Elmt_Size * Left) + To_Addr (Right)); + return To_Pointer (To_Offset (Elmt_Size * Left) + To_Addr (Right)); end "+"; --------- @@ -81,7 +82,7 @@ package body Interfaces.C.Pointers is raise Pointer_Error; end if; - return To_Pointer (To_Addr (Left) - To_Addr (Right * Elmt_Size)); + return To_Pointer (To_Addr (Left) - To_Offset (Right * Elmt_Size)); end "-"; function "-" (Left : Pointer; Right : Pointer) return ptrdiff_t is diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb index 1b0acc18d68..28e41f36b14 100644 --- a/gcc/ada/libgnat/s-bituti.adb +++ b/gcc/ada/libgnat/s-bituti.adb @@ -29,11 +29,13 @@ -- -- ------------------------------------------------------------------------------ +with System.Storage_Elements; use System.Storage_Elements; + package body System.Bitfield_Utils is package body G is - Val_Bytes : constant Address := Address (Val'Size / Storage_Unit); + Val_Bytes : constant Storage_Count := Val'Size / Storage_Unit; -- A Val_2 can cross a memory page boundary (e.g. an 8-byte Val_2 that -- starts 4 bytes before the end of a page). If the bit field also @@ -119,7 +121,7 @@ package body System.Bitfield_Utils is Size : Small_Size) return Val_2 is begin - pragma Assert (Src_Address mod Val'Alignment = 0); + pragma Assert (Src_Address mod Storage_Count'(Val'Alignment) = 0); -- Bit field fits in first half; fetch just one Val. On little -- endian, we want that in the low half, but on big endian, we @@ -154,7 +156,7 @@ package body System.Bitfield_Utils is V : Val_2; Size : Small_Size) is begin - pragma Assert (Dest_Address mod Val'Alignment = 0); + pragma Assert (Dest_Address mod Storage_Count'(Val'Alignment) = 0); -- Comments in Get_Val_2 apply, except we're storing instead of -- fetching. @@ -381,18 +383,19 @@ package body System.Bitfield_Utils is -- Align the Address values as for Val and Val_2, and adjust the -- Bit_Offsets accordingly. - Src_Adjust : constant Address := Src_Address mod Val_Bytes; + Src_Adjust : constant Storage_Offset := Src_Address mod Val_Bytes; Al_Src_Address : constant Address := Src_Address - Src_Adjust; Al_Src_Offset : constant Bit_Offset := Src_Offset + Bit_Offset (Src_Adjust * Storage_Unit); - Dest_Adjust : constant Address := Dest_Address mod Val_Bytes; + Dest_Adjust : constant Storage_Offset := + Dest_Address mod Val_Bytes; Al_Dest_Address : constant Address := Dest_Address - Dest_Adjust; Al_Dest_Offset : constant Bit_Offset := Dest_Offset + Bit_Offset (Dest_Adjust * Storage_Unit); - pragma Assert (Al_Src_Address mod Val'Alignment = 0); - pragma Assert (Al_Dest_Address mod Val'Alignment = 0); + pragma Assert (Al_Src_Address mod Storage_Count'(Val'Alignment) = 0); + pragma Assert (Al_Dest_Address mod Storage_Count'(Val'Alignment) = 0); begin -- Optimized small case diff --git a/gcc/ada/libgnat/s-statxd.adb b/gcc/ada/libgnat/s-statxd.adb index dc45ee857fb..69412b8a385 100644 --- a/gcc/ada/libgnat/s-statxd.adb +++ b/gcc/ada/libgnat/s-statxd.adb @@ -295,8 +295,8 @@ package body System.Stream_Attributes.XDR is FP : Fat_Pointer; begin - FP.P1 := I_AS (Stream).P1; - FP.P2 := I_AS (Stream).P1; + FP.P1 := I_AS (Stream); + FP.P2 := I_AS (Stream); return FP; end I_AD; @@ -321,7 +321,7 @@ package body System.Stream_Attributes.XDR is U := U * BB + XDR_TM (S (N)); end loop; - return (P1 => To_XDR_SA (XDR_SA (U))); + return To_XDR_SA (XDR_SA (U)); end if; end I_AS; @@ -1181,7 +1181,7 @@ package body System.Stream_Attributes.XDR is procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is S : XDR_S_TM; - U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1)); + U : XDR_TM := XDR_TM (To_XDR_SA (Item)); begin for N in reverse S'Range loop diff --git a/gcc/ada/libgnat/s-stratt.ads b/gcc/ada/libgnat/s-stratt.ads index e0ddc2346e1..1a3fb60591f 100644 --- a/gcc/ada/libgnat/s-stratt.ads +++ b/gcc/ada/libgnat/s-stratt.ads @@ -67,9 +67,7 @@ package System.Stream_Attributes is -- (double address) form. The following types are used to hold access -- values using unchecked conversions. - type Thin_Pointer is record - P1 : System.Address; - end record; + subtype Thin_Pointer is System.Address; type Fat_Pointer is record P1 : System.Address;