From: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed, 8 Mar 2023 22:02:34 +0000 (+0100)
Subject: ada: Minor adjustments to Standard_Address
X-Git-Tag: basepoints/gcc-15~8913
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ce4718eca7efacc5a97204bef6571a96c6ad391f;p=thirdparty%2Fgcc.git

ada: Minor adjustments to Standard_Address

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.
---

diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index fbd5888b1981..d4a420deda96 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 1a1eace600bb..5d3413c1505c 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