ada: Fix address arithmetic issues in the runtime

This is most notably the addition of addresses in Interfaces.C.Pointers and
System.Bitfield_Utils.  There is also a change to System.Stream_Attributes,
which was representing a thin pointer as a record, which is not problematic
per se, but is in the end, because the expanded code performs an unchecked
conversion from it to the access type instead of accessing the component.

gcc/ada/

	* libgnat/i-cpoint.adb: Add clauses for System.Storage_Elements.
	(Addr): Delete.
	(Offset): New subtype of Storage_Offset.
	(To_Offset): New instance of Unchecked_Conversion.
	(To_Pointer): Adjust.
	(To_Addr): Likewise.
	(To_Ptrdiff): Likewise.
	("+"): Call To_Offset on the offset.
	("-"): Likewise.
	* libgnat/s-bituti.adb: Add clauses for System.Storage_Elements.
	(Val_Bytes): Change type to Storage_Count.
	(Get_Val_2): Add qualification to second operand of mod operator.
	(Set_Val_2): Likewise.
	(Copy_Bitfield): Likewise.  Change type of Src_Adjust & Dest_Adjust.
	* libgnat/s-stratt.ads (Thin_Pointer): Change to subtype of Address.
	* libgnat/s-statxd.adb (I_AD): Adjust.
	(I_AS): Likewise.
	(W_AS): Likewise.

4 files changed, 26 insertions, 24 deletions

diff --git a/gcc/ada/libgnat/i-cpoint.adb b/gcc/ada/libgnat/i-cpoint.adb
index bf08e1a..e1805f4 100644
--- a/gcc/ada/libgnat/i-cpoint.adb
+++ b/gcc/ada/libgnat/i-cpoint.adb
@@ -29,19 +29,20 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Interfaces.C.Strings; use Interfaces.C.Strings;
-with System;               use System;
+with Interfaces.C.Strings;    use Interfaces.C.Strings;
+with System.Storage_Elements; use System.Storage_Elements;
+with System;                  use System;
 
 with Ada.Unchecked_Conversion;
 
 package body Interfaces.C.Pointers is
 
-   type Addr is mod 2 ** System.Parameters.ptr_bits;
+   subtype Offset is Storage_Offset;
 
-   function To_Pointer is new Ada.Unchecked_Conversion (Addr,      Pointer);
-   function To_Addr    is new Ada.Unchecked_Conversion (Pointer,   Addr);
-   function To_Addr    is new Ada.Unchecked_Conversion (ptrdiff_t, Addr);
-   function To_Ptrdiff is new Ada.Unchecked_Conversion (Addr,      ptrdiff_t);
+   function To_Pointer is new Ada.Unchecked_Conversion (Address,   Pointer);
+   function To_Addr    is new Ada.Unchecked_Conversion (Pointer,   Address);
+   function To_Offset  is new Ada.Unchecked_Conversion (ptrdiff_t, Offset);
+   function To_Ptrdiff is new Ada.Unchecked_Conversion (Offset,    ptrdiff_t);
 
    Elmt_Size : constant ptrdiff_t :=
                  (Element_Array'Component_Size
@@ -59,7 +60,7 @@ package body Interfaces.C.Pointers is
          raise Pointer_Error;
       end if;
 
-      return To_Pointer (To_Addr (Left) + To_Addr (Elmt_Size * Right));
+      return To_Pointer (To_Addr (Left) + To_Offset (Elmt_Size * Right));
    end "+";
 
    function "+" (Left : ptrdiff_t; Right : Pointer) return Pointer is
@@ -68,7 +69,7 @@ package body Interfaces.C.Pointers is
          raise Pointer_Error;
       end if;
 
-      return To_Pointer (To_Addr (Elmt_Size * Left) + To_Addr (Right));
+      return To_Pointer (To_Offset (Elmt_Size * Left) + To_Addr (Right));
    end "+";
 
    ---------
@@ -81,7 +82,7 @@ package body Interfaces.C.Pointers is
          raise Pointer_Error;
       end if;
 
-      return To_Pointer (To_Addr (Left) - To_Addr (Right * Elmt_Size));
+      return To_Pointer (To_Addr (Left) - To_Offset (Right * Elmt_Size));
    end "-";
 
    function "-" (Left : Pointer; Right : Pointer) return ptrdiff_t is
diff --git a/gcc/ada/libgnat/s-bituti.adb b/gcc/ada/libgnat/s-bituti.adb
index 1b0acc1..28e41f3 100644
--- a/gcc/ada/libgnat/s-bituti.adb
+++ b/gcc/ada/libgnat/s-bituti.adb
@@ -29,11 +29,13 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with System.Storage_Elements; use System.Storage_Elements;
+
 package body System.Bitfield_Utils is
 
    package body G is
 
-      Val_Bytes : constant Address := Address (Val'Size / Storage_Unit);
+      Val_Bytes : constant Storage_Count := Val'Size / Storage_Unit;
 
       --  A Val_2 can cross a memory page boundary (e.g. an 8-byte Val_2 that
       --  starts 4 bytes before the end of a page). If the bit field also
@@ -119,7 +121,7 @@ package body System.Bitfield_Utils is
          Size : Small_Size)
         return Val_2 is
       begin
-         pragma Assert (Src_Address mod Val'Alignment = 0);
+         pragma Assert (Src_Address mod Storage_Count'(Val'Alignment) = 0);
 
          --  Bit field fits in first half; fetch just one Val. On little
          --  endian, we want that in the low half, but on big endian, we
@@ -154,7 +156,7 @@ package body System.Bitfield_Utils is
          V : Val_2;
          Size : Small_Size) is
       begin
-         pragma Assert (Dest_Address mod Val'Alignment = 0);
+         pragma Assert (Dest_Address mod Storage_Count'(Val'Alignment) = 0);
 
          --  Comments in Get_Val_2 apply, except we're storing instead of
          --  fetching.
@@ -381,18 +383,19 @@ package body System.Bitfield_Utils is
          --  Align the Address values as for Val and Val_2, and adjust the
          --  Bit_Offsets accordingly.
 
-         Src_Adjust     : constant Address := Src_Address mod Val_Bytes;
+         Src_Adjust     : constant Storage_Offset := Src_Address mod Val_Bytes;
          Al_Src_Address : constant Address := Src_Address - Src_Adjust;
          Al_Src_Offset  : constant Bit_Offset :=
            Src_Offset + Bit_Offset (Src_Adjust * Storage_Unit);
 
-         Dest_Adjust     : constant Address := Dest_Address mod Val_Bytes;
+         Dest_Adjust     : constant Storage_Offset :=
+           Dest_Address mod Val_Bytes;
          Al_Dest_Address : constant Address := Dest_Address - Dest_Adjust;
          Al_Dest_Offset  : constant Bit_Offset :=
            Dest_Offset + Bit_Offset (Dest_Adjust * Storage_Unit);
 
-         pragma Assert (Al_Src_Address mod Val'Alignment = 0);
-         pragma Assert (Al_Dest_Address mod Val'Alignment = 0);
+         pragma Assert (Al_Src_Address mod Storage_Count'(Val'Alignment) = 0);
+         pragma Assert (Al_Dest_Address mod Storage_Count'(Val'Alignment) = 0);
       begin
          --  Optimized small case
 
diff --git a/gcc/ada/libgnat/s-statxd.adb b/gcc/ada/libgnat/s-statxd.adb
index dc45ee8..69412b8 100644
--- a/gcc/ada/libgnat/s-statxd.adb
+++ b/gcc/ada/libgnat/s-statxd.adb
@@ -295,8 +295,8 @@ package body System.Stream_Attributes.XDR is
       FP : Fat_Pointer;
 
    begin
-      FP.P1 := I_AS (Stream).P1;
-      FP.P2 := I_AS (Stream).P1;
+      FP.P1 := I_AS (Stream);
+      FP.P2 := I_AS (Stream);
 
       return FP;
    end I_AD;
@@ -321,7 +321,7 @@ package body System.Stream_Attributes.XDR is
             U := U * BB + XDR_TM (S (N));
          end loop;
 
-         return (P1 => To_XDR_SA (XDR_SA (U)));
+         return To_XDR_SA (XDR_SA (U));
       end if;
    end I_AS;
 
@@ -1181,7 +1181,7 @@ package body System.Stream_Attributes.XDR is
 
    procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is
       S : XDR_S_TM;
-      U : XDR_TM := XDR_TM (To_XDR_SA (Item.P1));
+      U : XDR_TM := XDR_TM (To_XDR_SA (Item));
 
    begin
       for N in reverse S'Range loop
diff --git a/gcc/ada/libgnat/s-stratt.ads b/gcc/ada/libgnat/s-stratt.ads
index e0ddc23..1a3fb60 100644
--- a/gcc/ada/libgnat/s-stratt.ads
+++ b/gcc/ada/libgnat/s-stratt.ads
@@ -67,9 +67,7 @@ package System.Stream_Attributes is
    --  (double address) form. The following types are used to hold access
    --  values using unchecked conversions.
 
-   type Thin_Pointer is record
-      P1 : System.Address;
-   end record;
+   subtype Thin_Pointer is System.Address;
 
    type Fat_Pointer is record
       P1 : System.Address;