[COMMITTED] ada: Minor adjustments to Standard_Address

Message ID 20230525080615.1957429-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Minor adjustments to Standard_Address |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès May 25, 2023, 8:06 a.m. UTC
  From: Eric Botcazou <ebotcazou@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(-)
  

Patch

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