Skip to content

Commit

Permalink
ada: Fix address arithmetic issues in the runtime
Browse files Browse the repository at this point in the history
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.

Tested on x86_64-pc-linux-gnu, committed on master.
  • Loading branch information
Eric Botcazou authored and ouuleilei-bot committed May 23, 2023
1 parent c2d62cd commit f7cd5e0
Show file tree
Hide file tree
Showing 4 changed files with 26 additions and 24 deletions.
21 changes: 11 additions & 10 deletions gcc/ada/libgnat/i-cpoint.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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 "+";

---------
Expand All @@ -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
Expand Down
17 changes: 10 additions & 7 deletions gcc/ada/libgnat/s-bituti.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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

Expand Down
8 changes: 4 additions & 4 deletions gcc/ada/libgnat/s-statxd.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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;

Expand Down Expand Up @@ -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
Expand Down
4 changes: 1 addition & 3 deletions gcc/ada/libgnat/s-stratt.ads
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down

0 comments on commit f7cd5e0

Please sign in to comment.