aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorDaniel King <dmking@adacore.com>2023-08-01 14:39:39 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-09-05 13:05:12 +0200
commitc416d2f768b73daa28d2fcd0c80656956ae9242c (patch)
treeefcdee05d34e631f9f9a7342c3f6753a37c5511e /gcc/ada
parent518f93c17983623107ff2091728c93b02fc0eeb2 (diff)
downloadgcc-c416d2f768b73daa28d2fcd0c80656956ae9242c.zip
gcc-c416d2f768b73daa28d2fcd0c80656956ae9242c.tar.gz
gcc-c416d2f768b73daa28d2fcd0c80656956ae9242c.tar.bz2
ada: Preserve capability validity in address arithmetic
On CHERI targets where System.Address is a capability, arithmetic on addresses should avoid converting to integers and instead use the operations defined in System.Storage_Elements to perform the arithmetic directly on the System.Address object. This preserves the capability's validity throughout the calculation, ensuring that the resulting capability can be dereferenced. gcc/ada/ * libgnat/s-carsi8.adb: Use operations from System.Storage_Elements for address arithmetic. * libgnat/s-carun8.adb: Likewise * libgnat/s-casi128.adb: Likewise * libgnat/s-casi16.adb: Likewise * libgnat/s-casi32.adb: Likewise * libgnat/s-casi64.adb: Likewise * libgnat/s-caun128.adb: Likewise * libgnat/s-caun16.adb: Likewise * libgnat/s-caun32.adb: Likewise * libgnat/s-caun64.adb: Likewise * libgnat/s-geveop.adb: Likewise
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/libgnat/s-carsi8.adb9
-rw-r--r--gcc/ada/libgnat/s-carun8.adb9
-rw-r--r--gcc/ada/libgnat/s-casi128.adb9
-rw-r--r--gcc/ada/libgnat/s-casi16.adb13
-rw-r--r--gcc/ada/libgnat/s-casi32.adb9
-rw-r--r--gcc/ada/libgnat/s-casi64.adb9
-rw-r--r--gcc/ada/libgnat/s-caun128.adb9
-rw-r--r--gcc/ada/libgnat/s-caun16.adb13
-rw-r--r--gcc/ada/libgnat/s-caun32.adb9
-rw-r--r--gcc/ada/libgnat/s-caun64.adb9
-rw-r--r--gcc/ada/libgnat/s-geveop.adb43
11 files changed, 76 insertions, 65 deletions
diff --git a/gcc/ada/libgnat/s-carsi8.adb b/gcc/ada/libgnat/s-carsi8.adb
index 839f157..3946d47 100644
--- a/gcc/ada/libgnat/s-carsi8.adb
+++ b/gcc/ada/libgnat/s-carsi8.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -94,8 +95,8 @@ package body System.Compare_Array_Signed_8 is
for J in 0 .. Words_To_Compare - 1 loop
if LeftP (J) /= RightP (J) then
return Compare_Array_S8_Unaligned
- (AddA (Left, Address (4 * J)),
- AddA (Right, Address (4 * J)),
+ (Left + Storage_Offset (4 * J),
+ Right + Storage_Offset (4 * J),
4, 4);
end if;
end loop;
@@ -108,8 +109,8 @@ package body System.Compare_Array_Signed_8 is
-- * Words_To_Compare = Compare_Len / 4
-- * Bytes_Compared_As_Words = Words_To_Compare * 4
return Compare_Array_S8_Unaligned
- (AddA (Left, Address (Bytes_Compared_As_Words)),
- AddA (Right, Address (Bytes_Compared_As_Words)),
+ (Left + Storage_Offset (Bytes_Compared_As_Words),
+ Right + Storage_Offset (Bytes_Compared_As_Words),
Left_Len - Bytes_Compared_As_Words,
Right_Len - Bytes_Compared_As_Words);
end;
diff --git a/gcc/ada/libgnat/s-carun8.adb b/gcc/ada/libgnat/s-carun8.adb
index b20e4e1..e6938de 100644
--- a/gcc/ada/libgnat/s-carun8.adb
+++ b/gcc/ada/libgnat/s-carun8.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -93,8 +94,8 @@ package body System.Compare_Array_Unsigned_8 is
for J in 0 .. Words_To_Compare - 1 loop
if LeftP (J) /= RightP (J) then
return Compare_Array_U8_Unaligned
- (AddA (Left, Address (4 * J)),
- AddA (Right, Address (4 * J)),
+ (Left + Storage_Offset (4 * J),
+ Right + Storage_Offset (4 * J),
4, 4);
end if;
end loop;
@@ -107,8 +108,8 @@ package body System.Compare_Array_Unsigned_8 is
-- * Words_To_Compare = Compare_Len / 4
-- * Bytes_Compared_As_Words = Words_To_Compare * 4
return Compare_Array_U8_Unaligned
- (AddA (Left, Address (Bytes_Compared_As_Words)),
- AddA (Right, Address (Bytes_Compared_As_Words)),
+ (Left + Storage_Offset (Bytes_Compared_As_Words),
+ Right + Storage_Offset (Bytes_Compared_As_Words),
Left_Len - Bytes_Compared_As_Words,
Right_Len - Bytes_Compared_As_Words);
end;
diff --git a/gcc/ada/libgnat/s-casi128.adb b/gcc/ada/libgnat/s-casi128.adb
index 2b0caac..91569e1 100644
--- a/gcc/ada/libgnat/s-casi128.adb
+++ b/gcc/ada/libgnat/s-casi128.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -80,8 +81,8 @@ package body System.Compare_Array_Signed_128 is
end if;
Clen := Clen - 1;
- L := AddA (L, 16);
- R := AddA (R, 16);
+ L := L + Storage_Offset (16);
+ R := R + Storage_Offset (16);
end loop;
-- Case of going by unaligned quadruple words
@@ -97,8 +98,8 @@ package body System.Compare_Array_Signed_128 is
end if;
Clen := Clen - 1;
- L := AddA (L, 16);
- R := AddA (R, 16);
+ L := L + Storage_Offset (16);
+ R := R + Storage_Offset (16);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-casi16.adb b/gcc/ada/libgnat/s-casi16.adb
index fa529c9..8aa5502 100644
--- a/gcc/ada/libgnat/s-casi16.adb
+++ b/gcc/ada/libgnat/s-casi16.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -82,8 +83,8 @@ package body System.Compare_Array_Signed_16 is
and then W (L).all = W (R).all
loop
Clen := Clen - 2;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
end if;
@@ -100,8 +101,8 @@ package body System.Compare_Array_Signed_16 is
end if;
Clen := Clen - 1;
- L := AddA (L, 2);
- R := AddA (R, 2);
+ L := L + Storage_Offset (2);
+ R := R + Storage_Offset (2);
end loop;
-- Case of going by unaligned half words
@@ -117,8 +118,8 @@ package body System.Compare_Array_Signed_16 is
end if;
Clen := Clen - 1;
- L := AddA (L, 2);
- R := AddA (R, 2);
+ L := L + Storage_Offset (2);
+ R := R + Storage_Offset (2);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-casi32.adb b/gcc/ada/libgnat/s-casi32.adb
index 7ed9ec5..f42d5e0 100644
--- a/gcc/ada/libgnat/s-casi32.adb
+++ b/gcc/ada/libgnat/s-casi32.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -83,8 +84,8 @@ package body System.Compare_Array_Signed_32 is
end if;
Clen := Clen - 1;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
-- Case of going by unaligned words
@@ -100,8 +101,8 @@ package body System.Compare_Array_Signed_32 is
end if;
Clen := Clen - 1;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-casi64.adb b/gcc/ada/libgnat/s-casi64.adb
index f021110..d0c8f1c 100644
--- a/gcc/ada/libgnat/s-casi64.adb
+++ b/gcc/ada/libgnat/s-casi64.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -83,8 +84,8 @@ package body System.Compare_Array_Signed_64 is
end if;
Clen := Clen - 1;
- L := AddA (L, 8);
- R := AddA (R, 8);
+ L := L + Storage_Offset (8);
+ R := R + Storage_Offset (8);
end loop;
-- Case of going by unaligned double words
@@ -100,8 +101,8 @@ package body System.Compare_Array_Signed_64 is
end if;
Clen := Clen - 1;
- L := AddA (L, 8);
- R := AddA (R, 8);
+ L := L + Storage_Offset (8);
+ R := R + Storage_Offset (8);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-caun128.adb b/gcc/ada/libgnat/s-caun128.adb
index 00f2d8c..85b350b 100644
--- a/gcc/ada/libgnat/s-caun128.adb
+++ b/gcc/ada/libgnat/s-caun128.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -79,8 +80,8 @@ package body System.Compare_Array_Unsigned_128 is
end if;
Clen := Clen - 1;
- L := AddA (L, 16);
- R := AddA (R, 16);
+ L := L + Storage_Offset (16);
+ R := R + Storage_Offset (16);
end loop;
-- Case of going by unaligned quadruple words
@@ -96,8 +97,8 @@ package body System.Compare_Array_Unsigned_128 is
end if;
Clen := Clen - 1;
- L := AddA (L, 16);
- R := AddA (R, 16);
+ L := L + Storage_Offset (16);
+ R := R + Storage_Offset (16);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-caun16.adb b/gcc/ada/libgnat/s-caun16.adb
index 43bf35b..a082e61 100644
--- a/gcc/ada/libgnat/s-caun16.adb
+++ b/gcc/ada/libgnat/s-caun16.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -82,8 +83,8 @@ package body System.Compare_Array_Unsigned_16 is
and then W (L).all = W (R).all
loop
Clen := Clen - 2;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
end if;
@@ -100,8 +101,8 @@ package body System.Compare_Array_Unsigned_16 is
end if;
Clen := Clen - 1;
- L := AddA (L, 2);
- R := AddA (R, 2);
+ L := L + Storage_Offset (2);
+ R := R + Storage_Offset (2);
end loop;
-- Case of going by unaligned half words
@@ -117,8 +118,8 @@ package body System.Compare_Array_Unsigned_16 is
end if;
Clen := Clen - 1;
- L := AddA (L, 2);
- R := AddA (R, 2);
+ L := L + Storage_Offset (2);
+ R := R + Storage_Offset (2);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-caun32.adb b/gcc/ada/libgnat/s-caun32.adb
index 0a5ca12..72ac399 100644
--- a/gcc/ada/libgnat/s-caun32.adb
+++ b/gcc/ada/libgnat/s-caun32.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -83,8 +84,8 @@ package body System.Compare_Array_Unsigned_32 is
end if;
Clen := Clen - 1;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
-- Case of going by unaligned words
@@ -100,8 +101,8 @@ package body System.Compare_Array_Unsigned_32 is
end if;
Clen := Clen - 1;
- L := AddA (L, 4);
- R := AddA (R, 4);
+ L := L + Storage_Offset (4);
+ R := R + Storage_Offset (4);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-caun64.adb b/gcc/ada/libgnat/s-caun64.adb
index cca2069..e4246975 100644
--- a/gcc/ada/libgnat/s-caun64.adb
+++ b/gcc/ada/libgnat/s-caun64.adb
@@ -30,6 +30,7 @@
------------------------------------------------------------------------------
with System.Address_Operations; use System.Address_Operations;
+with System.Storage_Elements; use System.Storage_Elements;
with Ada.Unchecked_Conversion;
@@ -82,8 +83,8 @@ package body System.Compare_Array_Unsigned_64 is
end if;
Clen := Clen - 1;
- L := AddA (L, 8);
- R := AddA (R, 8);
+ L := L + Storage_Offset (8);
+ R := R + Storage_Offset (8);
end loop;
-- Case of going by unaligned double words
@@ -99,8 +100,8 @@ package body System.Compare_Array_Unsigned_64 is
end if;
Clen := Clen - 1;
- L := AddA (L, 8);
- R := AddA (R, 8);
+ L := L + Storage_Offset (8);
+ R := R + Storage_Offset (8);
end loop;
end if;
diff --git a/gcc/ada/libgnat/s-geveop.adb b/gcc/ada/libgnat/s-geveop.adb
index 1221d35..502ada2 100644
--- a/gcc/ada/libgnat/s-geveop.adb
+++ b/gcc/ada/libgnat/s-geveop.adb
@@ -36,9 +36,10 @@ with Ada.Unchecked_Conversion;
package body System.Generic_Vector_Operations is
- IU : constant Integer := Integer (Storage_Unit);
- VU : constant Address := Address (Vectors.Vector'Size / IU);
- EU : constant Address := Address (Element_Array'Component_Size / IU);
+ IU : constant Integer := Integer (Storage_Unit);
+ VU : constant Storage_Count := Storage_Count (Vectors.Vector'Size / IU);
+ EU : constant Storage_Count :=
+ Storage_Count (Element_Array'Component_Size / IU);
----------------------
-- Binary_Operation --
@@ -53,10 +54,10 @@ package body System.Generic_Vector_Operations is
YA : Address := Y;
-- Address of next element to process in R, X and Y
- VI : constant Integer_Address := To_Integer (VU);
+ VI : constant Integer_Address := Integer_Address (VU);
Unaligned : constant Integer_Address :=
- Boolean'Pos (ModA (OrA (OrA (RA, XA), YA), VU) /= 0) - 1;
+ Boolean'Pos (OrA (OrA (RA, XA), YA) mod VU /= 0) - 1;
-- Zero iff one or more argument addresses is not aligned, else all 1's
type Vector_Ptr is access all Vectors.Vector;
@@ -73,23 +74,23 @@ package body System.Generic_Vector_Operations is
-- Vector'Size > Storage_Unit
-- VI > 0
SA : constant Address :=
- AddA (XA, To_Address
- ((Integer_Address (Length) / VI * VI) and Unaligned));
+ XA + Storage_Offset
+ ((Integer_Address (Length) / VI * VI) and Unaligned);
-- First address of argument X to start serial processing
begin
while XA < SA loop
VP (RA).all := Vector_Op (VP (XA).all, VP (YA).all);
- XA := AddA (XA, VU);
- YA := AddA (YA, VU);
- RA := AddA (RA, VU);
+ XA := XA + VU;
+ YA := YA + VU;
+ RA := RA + VU;
end loop;
while XA < X + Length loop
EP (RA).all := Element_Op (EP (XA).all, EP (YA).all);
- XA := AddA (XA, EU);
- YA := AddA (YA, EU);
- RA := AddA (RA, EU);
+ XA := XA + EU;
+ YA := YA + EU;
+ RA := RA + EU;
end loop;
end Binary_Operation;
@@ -105,10 +106,10 @@ package body System.Generic_Vector_Operations is
XA : Address := X;
-- Address of next element to process in R and X
- VI : constant Integer_Address := To_Integer (VU);
+ VI : constant Integer_Address := Integer_Address (VU);
Unaligned : constant Integer_Address :=
- Boolean'Pos (ModA (OrA (RA, XA), VU) /= 0) - 1;
+ Boolean'Pos (OrA (RA, XA) mod VU /= 0) - 1;
-- Zero iff one or more argument addresses is not aligned, else all 1's
type Vector_Ptr is access all Vectors.Vector;
@@ -125,21 +126,21 @@ package body System.Generic_Vector_Operations is
-- Vector'Size > Storage_Unit
-- VI > 0
SA : constant Address :=
- AddA (XA, To_Address
- ((Integer_Address (Length) / VI * VI) and Unaligned));
+ XA + Storage_Offset
+ ((Integer_Address (Length) / VI * VI) and Unaligned);
-- First address of argument X to start serial processing
begin
while XA < SA loop
VP (RA).all := Vector_Op (VP (XA).all);
- XA := AddA (XA, VU);
- RA := AddA (RA, VU);
+ XA := XA + VU;
+ RA := RA + VU;
end loop;
while XA < X + Length loop
EP (RA).all := Element_Op (EP (XA).all);
- XA := AddA (XA, EU);
- RA := AddA (RA, EU);
+ XA := XA + EU;
+ RA := RA + EU;
end loop;
end Unary_Operation;