From: Eric Botcazou <ebotca...@adacore.com>
Standard_Address is an internal entity that is meant to be a clone of
System.Address built at compilation startup. It needs to be seen as a
bona-fide address by the code generator. For the sake of completeness,
it is also given its modulus, although this does not matter in practice.
gcc/ada/
* cstand.adb (Create_Standard): Set the Is_Descendant_Of_Address
flag on Standard_Address.
* freeze.adb (Freeze_Entity): Copy the modulus of System.Address
onto Standard_Address.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/cstand.adb | 2 ++
gcc/ada/freeze.adb | 18 ++++++++++++++----
2 files changed, 16 insertions(+), 4 deletions(-)
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index fbd5888b198..d4a420deda9 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -1370,9 +1370,11 @@ package body CStand is
-- Standard_Address is not user visible, but is used internally. It is
-- an unsigned type mod 2**System_Address_Size with System.Address size.
+ -- We flag it as Is_Descendant_Of_Address for code generation purposes.
Standard_Address := New_Standard_Entity ("standard_address");
Build_Unsigned_Integer_Type (Standard_Address, System_Address_Size);
+ Set_Is_Descendant_Of_Address (Standard_Address);
-- Note: universal integer and universal real are constructed as fully
-- formed signed numeric types, with parameters corresponding to the
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 1a1eace600b..5d3413c1505 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7284,10 +7284,20 @@ package body Freeze is
elsif Is_Integer_Type (E) then
Adjust_Esize_For_Alignment (E);
- if Is_Modular_Integer_Type (E)
- and then Warn_On_Suspicious_Modulus_Value
- then
- Check_Suspicious_Modulus (E);
+ if Is_Modular_Integer_Type (E) then
+ -- Standard_Address has been built with the assumption that its
+ -- modulus was System_Address_Size, but this is not a universal
+ -- property and may need to be corrected.
+
+ if Is_RTE (E, RE_Address) then
+ Set_Modulus (Standard_Address, Modulus (E));
+ Set_Intval
+ (High_Bound (Scalar_Range (Standard_Address)),
+ Modulus (E) - 1);
+
+ elsif Warn_On_Suspicious_Modulus_Value then
+ Check_Suspicious_Modulus (E);
+ end if;
end if;
-- The pool applies to named and anonymous access types, but not
--
2.40.0
