[COMMITTED] ada: Remove the body of System.Storage_Elements
Checks
Commit Message
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
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
--
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
> 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."
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
--
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
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
--
@@ -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
@@ -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 --
-----------------------
@@ -29,8 +29,8 @@
-- --
------------------------------------------------------------------------------
+-- 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;
@@ -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;
@@ -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;
@@ -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))
@@ -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;
@@ -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