diff mbox series

[COMMITTED] ada: Remove the body of System.Storage_Elements

Message ID 20230523080826.1873735-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: Remove the body of System.Storage_Elements | expand

Commit Message

Marc Poulhiès May 23, 2023, 8:08 a.m. UTC 
From: Eric Botcazou <ebotcazou@adacore.com>

All the subprograms declared in the unit have convention Intrinsic and
their current implementation makes some implicit assumptions that are
not valid universally, so it is replaced by a direct expansion.

This is mostly straightforward because Resolve_Intrinsic_Operator already
contains the required circuitry, but a few adjustements are necessary.

gcc/ada/

	* exp_ch4.adb (Expand_N_Op_Mod): Deal with the special mod
	operator of System.Storage_Elements.
	* exp_intr.adb (Expand_To_Integer): New procedure.
	(Expand_Intrinsic_Call): Call Expand_To_Integer appropriately.
	(Expand_To_Address): Deal with an argument with modular type.
	* sem_ch3.adb (Derive_Subprogram): Also set convention Intrinsic
	on a derived intrinsic subprogram.
	* sem_res.adb (Resolve_Arithmetic_Op): Deal with intrinsic
	operators not coming from source exactly as those coming from
	source and also generate a reference in both cases.
	(Resolve_Op_Expon): Likewise.
	(Resolve_Intrinsic_Operator): Call Implementation_Base_Type to get
	a nonprivate base type.
	* snames.ads-tmpl (Name_To_Integer): New intrinsic name.
	* libgnat/s-stoele.ads: Replace pragma Convention with pragma
	Import throughout and remove pragma Inline_Always and
	Pure_Function.
	* libgnat/s-stoele.adb: Replace entire contents with pragma
	No_Body.
	* libgnat/s-atacco.adb: Adjust comment about pragma No_Body.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch4.adb          |  28 +++++++++-
 gcc/ada/exp_intr.adb         |  27 ++++++++++
 gcc/ada/libgnat/s-atacco.adb |   6 +--
 gcc/ada/libgnat/s-stoele.adb | 101 ++---------------------------------
 gcc/ada/libgnat/s-stoele.ads |  36 +++----------
 gcc/ada/sem_ch3.adb          |   1 +
 gcc/ada/sem_res.adb          |  10 ++--
 gcc/ada/snames.ads-tmpl      |   3 +-
 8 files changed, 75 insertions(+), 137 deletions(-)

Comments

Jan-Benedict Glaw May 29, 2023, 2:10 p.m. UTC | #1 
Hi Eric!

On Tue, 2023-05-23 10:08:26 +0200, Marc Poulhiès via Gcc-patches <gcc-patches@gcc.gnu.org> wrote:
> From: Eric Botcazou <ebotcazou@adacore.com>
> 
> All the subprograms declared in the unit have convention Intrinsic and
> their current implementation makes some implicit assumptions that are
> not valid universally, so it is replaced by a direct expansion.
> 
> This is mostly straightforward because Resolve_Intrinsic_Operator already
> contains the required circuitry, but a few adjustements are necessary.

Starting with this commit, my CI builder cannt build GCC:

../gcc/configure '--with-pkgversion=basepoints/gcc-14-1314-gff313e1c74b, built at 1685339868' --prefix=/var/lib/laminar/run/gcc-aarch64-linux/74/toolchain-install --enable-werror-always --enable-languages=all --disable-gcov --disable-shared --disable-threads --target=aarch64-linux --without-headers

make V=1 all-gcc
[...]
mkdir -p ada/
/usr/lib/gcc-snapshot/bin/gcc -c -g -O2    -gnatpg -gnata -W -Wall -nostdinc -I- -I. -Iada/generated -Iada -I../../gcc/gcc/ada -Iada/libgnat -I../../gcc/gcc/ada/libgnat -Iada/gcc-interface -I../../gcc/gcc/ada/gcc-interface ../../gcc/gcc/ada/spark_xrefs.adb -o ada/spark_xrefs.o
s-stoele.ads:84:13: error: unrecognized intrinsic subprogram
make[1]: *** [../../gcc/gcc/ada/gcc-interface/Make-lang.in:165: ada/spark_xrefs.o] Error 1
make[1]: Leaving directory '/var/lib/laminar/run/gcc-aarch64-linux/74/toolchain-build/gcc'
make: *** [Makefile:4637: all-gcc] Error 2

(A full build log is at
http://toolchain.lug-owl.de/laminar/jobs/gcc-aarch64-linux/74)

Is this an issue with the patch? Or does it need a newer Ada compiler
to for building it?

MfG, JBG

--
Marc Poulhiès May 29, 2023, 2:11 p.m. UTC | #2 
Jan-Benedict Glaw <jbglaw@lug-owl.de> writes:

> (A full build log is at
> http://toolchain.lug-owl.de/laminar/jobs/gcc-aarch64-linux/74)
>
> Is this an issue with the patch? Or does it need a newer Ada compiler
> to for building it?

Hello Jan,

IIUC, your base compiler is "g++ (Debian 20230315-1) 13.0.1 20230315".

It looks like you are doing a native build with bootstrap. If that's the
case it should work correctly.

Can you elaborate how you build GCC?

Thanks,
Marc
Eric Botcazou May 29, 2023, 2:17 p.m. UTC | #3 
> Is this an issue with the patch? Or does it need a newer Ada compiler
> to for building it?

Neither, it's very likely an issue with your build procedure: you need to use 
a matching host Ada compiler to build a cross Ada compiler, that's documented 
in https://gcc.gnu.org/install/prerequisites.html#GNAT-prerequisite

"In order to build a cross compiler, it is strongly recommended to install the 
new compiler as native first, and then use it to build the cross compiler. 
Other native compiler versions may work but this is not guaranteed and will 
typically fail with hard to understand compilation errors during the build."
Jan-Benedict Glaw May 29, 2023, 3:28 p.m. UTC | #4 
On Mon, 2023-05-29 16:11:26 +0200, Marc Poulhiès <poulhies@adacore.com> wrote:
> Jan-Benedict Glaw <jbglaw@lug-owl.de> writes:
> > (A full build log is at
> > http://toolchain.lug-owl.de/laminar/jobs/gcc-aarch64-linux/74)
> >
> > Is this an issue with the patch? Or does it need a newer Ada compiler
> > to for building it?
> 
> Hello Jan,
> 
> IIUC, your base compiler is "g++ (Debian 20230315-1) 13.0.1 20230315".
> 
> It looks like you are doing a native build with bootstrap. If that's the
> case it should work correctly.
> 
> Can you elaborate how you build GCC?

My host compileris Debian's "gcc-snapshot", by now some two months
old. (As Eric wrote, it's probably just too old.) That compiler is
given for CC/CXX. The new build is just (as I wrote in the initial
mail) the configure/make call. So I'll just wait for the next drop for
Debian's "gcc-snapshot" package. I see that there are already a good
number of additional commits on the package source, I guess a new
package version is imminent.

MfG, JBG

--
Maciej W. Rozycki May 30, 2023, 8:05 a.m. UTC | #5 
On Mon, 29 May 2023, Jan-Benedict Glaw wrote:

> > Can you elaborate how you build GCC?
> 
> My host compileris Debian's "gcc-snapshot", by now some two months
> old. (As Eric wrote, it's probably just too old.) That compiler is
> given for CC/CXX. The new build is just (as I wrote in the initial
> mail) the configure/make call. So I'll just wait for the next drop for
> Debian's "gcc-snapshot" package. I see that there are already a good
> number of additional commits on the package source, I guess a new
> package version is imminent.

 Alternatively you can just bootstrap GCC under test natively first and 
then use the newly-built compiler for all the cross builds you want to 
verify.  As you need to do it only once per iteration the extra time spent 
on the native build shouldn't be a big fraction of the duration of the 
whole iteration.  A drawback is if this native bootstrap fails for any 
reason, it will make the whole run invalid, i.e. none of the cross targets 
will be verified.

  Maciej
Jan-Benedict Glaw May 30, 2023, 4:55 p.m. UTC | #6 
On Tue, 2023-05-30 09:05:43 +0100, Maciej W. Rozycki <macro@orcam.me.uk> wrote:
[Ada as a cross-compiler fails to build with a slightly-older compiler.]

>  Alternatively you can just bootstrap GCC under test natively first and 
> then use the newly-built compiler for all the cross builds you want to 
> verify.  As you need to do it only once per iteration the extra time spent 
> on the native build shouldn't be a big fraction of the duration of the 
> whole iteration.  A drawback is if this native bootstrap fails for any 
> reason, it will make the whole run invalid, i.e. none of the cross targets 
> will be verified.

Just implemented that: Extract the most recent GCC that got no
`--target` given and try to use that. On a higher level, that GCC is
built first, delaying the rest of the builds some hours.

MfG, JBG

--
diff mbox series

Patch

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 70e779d0406..c974a9e8d44 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -9560,6 +9560,12 @@  package body Exp_Ch4 is
       Typ   : constant Entity_Id  := Etype (N);
       DDC   : constant Boolean    := Do_Division_Check (N);
 
+      Is_Stoele_Mod : constant Boolean :=
+        Is_RTE (First_Subtype (Typ), RE_Storage_Offset)
+          and then Nkind (Left_Opnd (N)) = N_Unchecked_Type_Conversion
+          and then Is_RTE (Etype (Expression (Left_Opnd (N))), RE_Address);
+      --  True if this is the special mod operator of System.Storage_Elements
+
       Left  : Node_Id;
       Right : Node_Id;
 
@@ -9593,7 +9599,10 @@  package body Exp_Ch4 is
          end if;
       end if;
 
-      if Is_Integer_Type (Typ) then
+      --  For the special mod operator of System.Storage_Elements, the checks
+      --  are subsumed into the handling of the negative case below.
+
+      if Is_Integer_Type (Typ) and then not Is_Stoele_Mod then
          Apply_Divide_Checks (N);
 
          --  All done if we don't have a MOD any more, which can happen as a
@@ -9663,6 +9672,23 @@  package body Exp_Ch4 is
             return;
          end if;
 
+         --  The negative case makes no sense since it is a case of a mod where
+         --  the left argument is unsigned and the right argument is signed. In
+         --  accordance with the (spirit of the) permission of RM 13.7.1(16),
+         --  we raise CE, and also include the zero case here. Yes, the RM says
+         --  PE, but this really is so obviously more like a constraint error.
+
+         if Is_Stoele_Mod and then (not ROK or else Rlo <= 0) then
+            Insert_Action (N,
+              Make_Raise_Constraint_Error (Loc,
+                Condition =>
+                  Make_Op_Le (Loc,
+                    Left_Opnd  => Duplicate_Subexpr_No_Checks (Right),
+                    Right_Opnd => Make_Integer_Literal (Loc, 0)),
+                Reason => CE_Overflow_Check_Failed));
+            return;
+         end if;
+
          --  If we still have a mod operator and we are in Modify_Tree_For_C
          --  mode, and we have a signed integer type, then here is where we do
          --  the rewrite in terms of Rem. Note this rewrite bypasses the need
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index a1e55882391..2eee892605e 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -102,6 +102,12 @@  package body Exp_Intr is
    --  N_Free_Statement and appropriate context.
 
    procedure Expand_To_Address (N : Node_Id);
+   --  Expand a call to corresponding function from System.Storage_Elements or
+   --  declared in an instance of System.Address_To_Access_Conversions.
+
+   procedure Expand_To_Integer (N : Node_Id);
+   --  Expand a call to corresponding function from System.Storage_Elements
+
    procedure Expand_To_Pointer (N : Node_Id);
    --  Expand a call to corresponding function, declared in an instance of
    --  System.Address_To_Access_Conversions.
@@ -708,6 +714,9 @@  package body Exp_Intr is
       elsif Nam = Name_To_Address then
          Expand_To_Address (N);
 
+      elsif Nam = Name_To_Integer then
+         Expand_To_Integer (N);
+
       elsif Nam = Name_To_Pointer then
          Expand_To_Pointer (N);
 
@@ -1356,6 +1365,12 @@  package body Exp_Intr is
       Obj : Node_Id;
 
    begin
+      if Is_Modular_Integer_Type (Etype (Arg)) then
+         Rewrite (N, Unchecked_Convert_To (Etype (N), Arg));
+         Analyze (N);
+         return;
+      end if;
+
       Remove_Side_Effects (Arg);
 
       Obj := Make_Explicit_Dereference (Loc, Relocate_Node (Arg));
@@ -1374,6 +1389,18 @@  package body Exp_Intr is
       Analyze_And_Resolve (N, RTE (RE_Address));
    end Expand_To_Address;
 
+   -----------------------
+   -- Expand_To_Integer --
+   -----------------------
+
+   procedure Expand_To_Integer (N : Node_Id) is
+      Arg : constant Node_Id := First_Actual (N);
+
+   begin
+      Rewrite (N, Unchecked_Convert_To (Etype (N), Arg));
+      Analyze (N);
+   end Expand_To_Integer;
+
    -----------------------
    -- Expand_To_Pointer --
    -----------------------
diff --git a/gcc/ada/libgnat/s-atacco.adb b/gcc/ada/libgnat/s-atacco.adb
index a98b25ce184..8c10681ac0c 100644
--- a/gcc/ada/libgnat/s-atacco.adb
+++ b/gcc/ada/libgnat/s-atacco.adb
@@ -29,8 +29,8 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package does not require a body, since it is a package renaming. We
---  provide a dummy file containing a No_Body pragma so that previous versions
---  of the body (which did exist) will not interfere.
+--  This package does not require a body. We provide a dummy file containing a
+--  No_Body pragma so that previous versions of the body (which did exist) will
+--  not interfere.
 
 pragma No_Body;
diff --git a/gcc/ada/libgnat/s-stoele.adb b/gcc/ada/libgnat/s-stoele.adb
index e029f510468..dfd1ba36601 100644
--- a/gcc/ada/libgnat/s-stoele.adb
+++ b/gcc/ada/libgnat/s-stoele.adb
@@ -29,101 +29,8 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Unchecked_Conversion;
+--  This package does not require a body. We provide a dummy file containing a
+--  No_Body pragma so that previous versions of the body (which did exist) will
+--  not interfere.
 
-package body System.Storage_Elements is
-
-   pragma Suppress (All_Checks);
-
-   --  Conversion to/from address
-
-   --  Note qualification below of To_Address to avoid ambiguities systems
-   --  where Address is a visible integer type.
-
-   function To_Address is
-     new Ada.Unchecked_Conversion (Storage_Offset, Address);
-   function To_Offset  is
-     new Ada.Unchecked_Conversion (Address, Storage_Offset);
-
-   --  Conversion to/from integers
-
-   --  These functions must be place first because they are inlined_always
-   --  and are used and inlined in other subprograms defined in this unit.
-
-   ----------------
-   -- To_Address --
-   ----------------
-
-   function To_Address (Value : Integer_Address) return Address is
-   begin
-      return Address (Value);
-   end To_Address;
-
-   ----------------
-   -- To_Integer --
-   ----------------
-
-   function To_Integer (Value : Address) return Integer_Address is
-   begin
-      return Integer_Address (Value);
-   end To_Integer;
-
-   --  Address arithmetic
-
-   ---------
-   -- "+" --
-   ---------
-
-   function "+" (Left : Address; Right : Storage_Offset) return Address is
-   begin
-      return Storage_Elements.To_Address
-        (To_Integer (Left) + To_Integer (To_Address (Right)));
-   end "+";
-
-   function "+" (Left : Storage_Offset; Right : Address) return Address is
-   begin
-      return Storage_Elements.To_Address
-        (To_Integer (To_Address (Left)) + To_Integer (Right));
-   end "+";
-
-   ---------
-   -- "-" --
-   ---------
-
-   function "-" (Left : Address; Right : Storage_Offset) return Address is
-   begin
-      return Storage_Elements.To_Address
-        (To_Integer (Left) - To_Integer (To_Address (Right)));
-   end "-";
-
-   function "-" (Left, Right : Address) return Storage_Offset is
-   begin
-      return To_Offset (Storage_Elements.To_Address
-                         (To_Integer (Left) - To_Integer (Right)));
-   end "-";
-
-   -----------
-   -- "mod" --
-   -----------
-
-   function "mod"
-     (Left  : Address;
-      Right : Storage_Offset) return Storage_Offset
-   is
-   begin
-      if Right > 0 then
-         return Storage_Offset
-           (To_Integer (Left) mod Integer_Address (Right));
-
-         --  The negative case makes no sense since it is a case of a mod where
-         --  the left argument is unsigned and the right argument is signed. In
-         --  accordance with the (spirit of the) permission of RM 13.7.1(16),
-         --  we raise CE, and also include the zero case here. Yes, the RM says
-         --  PE, but this really is so obviously more like a constraint error.
-
-      else
-         raise Constraint_Error;
-      end if;
-   end "mod";
-
-end System.Storage_Elements;
+pragma No_Body;
diff --git a/gcc/ada/libgnat/s-stoele.ads b/gcc/ada/libgnat/s-stoele.ads
index 9fd31e7d030..99a195a1338 100644
--- a/gcc/ada/libgnat/s-stoele.ads
+++ b/gcc/ada/libgnat/s-stoele.ads
@@ -45,12 +45,6 @@  package System.Storage_Elements is
 
    pragma Annotate (GNATprove, Always_Return, Storage_Elements);
 
-   --  We also add the pragma Pure_Function to the operations in this package,
-   --  because otherwise functions with parameters derived from Address are
-   --  treated as non-pure by the back-end (see exp_ch6.adb). This is because
-   --  in many cases such a parameter is used to hide read/out access to
-   --  objects, and it would be unsafe to treat such functions as pure.
-
    type Storage_Offset is range
      -(2 ** (Integer'(Standard'Address_Size) - 1)) ..
      +(2 ** (Integer'(Standard'Address_Size) - 1)) - Long_Long_Integer'(1);
@@ -73,44 +67,26 @@  package System.Storage_Elements is
    --  Address arithmetic
 
    function "+" (Left : Address; Right : Storage_Offset) return Address;
-   pragma Convention (Intrinsic, "+");
-   pragma Inline_Always ("+");
-   pragma Pure_Function ("+");
-
    function "+" (Left : Storage_Offset; Right : Address) return Address;
-   pragma Convention (Intrinsic, "+");
-   pragma Inline_Always ("+");
-   pragma Pure_Function ("+");
+   pragma Import (Intrinsic, "+");
 
    function "-" (Left : Address; Right : Storage_Offset) return Address;
-   pragma Convention (Intrinsic, "-");
-   pragma Inline_Always ("-");
-   pragma Pure_Function ("-");
-
    function "-" (Left, Right : Address) return Storage_Offset;
-   pragma Convention (Intrinsic, "-");
-   pragma Inline_Always ("-");
-   pragma Pure_Function ("-");
+   pragma Import (Intrinsic, "-");
 
    function "mod"
      (Left  : Address;
-      Right : Storage_Offset) return  Storage_Offset;
-   pragma Convention (Intrinsic, "mod");
-   pragma Inline_Always ("mod");
-   pragma Pure_Function ("mod");
+      Right : Storage_Offset) return Storage_Offset;
+   pragma Import (Intrinsic, "mod");
 
    --  Conversion to/from integers
 
    type Integer_Address is mod Memory_Size;
 
    function To_Address (Value : Integer_Address) return Address;
-   pragma Convention (Intrinsic, To_Address);
-   pragma Inline_Always (To_Address);
-   pragma Pure_Function (To_Address);
+   pragma Import (Intrinsic, To_Address);
 
    function To_Integer (Value : Address) return Integer_Address;
-   pragma Convention (Intrinsic, To_Integer);
-   pragma Inline_Always (To_Integer);
-   pragma Pure_Function (To_Integer);
+   pragma Import (Intrinsic, To_Integer);
 
 end System.Storage_Elements;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index bace2cf616a..50ccb390363 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16206,6 +16206,7 @@  package body Sem_Ch3 is
 
       if No (Actual_Subp) then
          if Is_Intrinsic_Subprogram (Parent_Subp) then
+            Set_Convention (New_Subp, Convention_Intrinsic);
             Set_Is_Intrinsic_Subprogram (New_Subp);
 
             if Present (Alias (Parent_Subp))
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 365c75041a9..a99bed00118 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6037,11 +6037,11 @@  package body Sem_Res is
    --  Start of processing for Resolve_Arithmetic_Op
 
    begin
-      if Comes_From_Source (N)
-        and then Ekind (Entity (N)) = E_Function
+      if Ekind (Entity (N)) = E_Function
         and then Is_Imported (Entity (N))
         and then Is_Intrinsic_Subprogram (Entity (N))
       then
+         Generate_Reference (Entity (N), N);
          Resolve_Intrinsic_Operator (N, Typ);
          return;
 
@@ -9710,7 +9710,7 @@  package body Sem_Res is
    --------------------------------
 
    procedure Resolve_Intrinsic_Operator  (N : Node_Id; Typ : Entity_Id) is
-      Btyp : constant Entity_Id := Base_Type (Underlying_Type (Typ));
+      Btyp : constant Entity_Id := Implementation_Base_Type (Typ);
       Op   : Entity_Id;
       Arg1 : Node_Id;
       Arg2 : Node_Id;
@@ -10641,11 +10641,11 @@  package body Sem_Res is
          end if;
       end if;
 
-      if Comes_From_Source (N)
-        and then Ekind (Entity (N)) = E_Function
+      if Ekind (Entity (N)) = E_Function
         and then Is_Imported (Entity (N))
         and then Is_Intrinsic_Subprogram (Entity (N))
       then
+         Generate_Reference (Entity (N), N);
          Resolve_Intrinsic_Operator (N, Typ);
          return;
       end if;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index afe7508ac28..cf2efbbbb63 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1337,9 +1337,10 @@  package Snames is
    Name_Shift_Right                      : constant Name_Id := N + $;
    Name_Shift_Right_Arithmetic           : constant Name_Id := N + $;
    Name_Source_Location                  : constant Name_Id := N + $;
+   Name_To_Integer                       : constant Name_Id := N + $;
+   Name_To_Pointer                       : constant Name_Id := N + $;
    Name_Unchecked_Conversion             : constant Name_Id := N + $;
    Name_Unchecked_Deallocation           : constant Name_Id := N + $;
-   Name_To_Pointer                       : constant Name_Id := N + $;
    Last_Intrinsic_Name                   : constant Name_Id := N + $;
 
    --  Names used in processing intrinsic calls