diff mbox series

[COMMITTED] ada: Preserve capability validity in address arithmetic

Message ID 20230905110804.562514-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Preserve capability validity in address arithmetic |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès Sept. 5, 2023, 11:08 a.m. UTC 
  From: Daniel King <dmking@adacore.com>

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

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/libgnat/s-carsi8.adb  |  9 ++++----
 gcc/ada/libgnat/s-carun8.adb  |  9 ++++----
 gcc/ada/libgnat/s-casi128.adb |  9 ++++----
 gcc/ada/libgnat/s-casi16.adb  | 13 ++++++-----
 gcc/ada/libgnat/s-casi32.adb  |  9 ++++----
 gcc/ada/libgnat/s-casi64.adb  |  9 ++++----
 gcc/ada/libgnat/s-caun128.adb |  9 ++++----
 gcc/ada/libgnat/s-caun16.adb  | 13 ++++++-----
 gcc/ada/libgnat/s-caun32.adb  |  9 ++++----
 gcc/ada/libgnat/s-caun64.adb  |  9 ++++----
 gcc/ada/libgnat/s-geveop.adb  | 43 ++++++++++++++++++-----------------
 11 files changed, 76 insertions(+), 65 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/libgnat/s-carsi8.adb b/gcc/ada/libgnat/s-carsi8.adb
index 839f157a2ee..3946d474dd9 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 b20e4e1b922..e6938def56a 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 2b0caac75b2..91569e1091d 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 fa529c9d559..8aa5502dc03 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 7ed9ec5c519..f42d5e06db7 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 f0211107baf..d0c8f1c1859 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 00f2d8cfd78..85b350b50b8 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 43bf35b907a..a082e61bf8e 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 0a5ca12144e..72ac399cd99 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 cca2069a62b..e4246975654 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 1221d356683..502ada299ad 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;