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.

diff --git a/gcc/ada/libgnat/i-cpoint.adb b/gcc/ada/libgnat/i-cpoint.adb
index bf08e1a74ac1f82e82c4cb94fd0277f01b32ae48..e1805f497de2feb4882838ecd3b42834c360a30e 100644 (file)
--- 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 1b0acc18d68926bc0b07987eb88451fbaa4e64bf..28e41f36b14f408104e1e30d5039669162079e6c 100644 (file)
--- 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 dc45ee857fbfc81c0121d081e8e3f1a95c94a4de..69412b8a385065b868a4c48afa1b9a982b9a6eab 100644 (file)
--- 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 e0ddc2346e16f3da04359a472227ac98cef984d3..1a3fb60591f317729e65f8ceb435465a7c9a3111 100644 (file)
--- 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;