ada: Port System.Stack_Usage to CHERI

This unit performed integer to address conversions to calculate stack addresses
which, on a CHERI target, result in an invalid capability that triggers a
capability tag fault when dereferenced during stack filling. This patch updates
the unit to preserve addresses (capabilities) during the calculations.

The method used to determine the stack base address is also updated to CHERI.
The current method tries to get the stack base from the compiler info for the
current task. If no info is found, then as a fallback it estimates the base by
taking the address of a variable on the stack. This address is then derived to
calculate the range of addresses to fill the stack.

This fallback does not work on CHERI since taking the 'Address of a stack variable
will result in a capability with bounds restricted to that object and attempting to
write outside those bounds triggers a capability bounds fault. Instead, we add a
new function Get_Stack_Base which, on CHERI, gets the exact stack base from the
upper bound of the capability stack pointer (CSP) register. On non-CHERI platforms,
Get_Stack_Base returns the stack base from the compiler info, resulting in the same
behaviour as before on those platforms.

gcc/ada/ChangeLog:

	* Makefile.rtl (LIBGNAT_TARGET_PAIRS): New unit s-tsgsba__cheri.adb for morello-freebsd.
	* libgnarl/s-tassta.adb (Get_Stack_Base): New function.
	* libgnarl/s-tsgsba__cheri.adb: New file for CHERI targets.
	* libgnarl/s-tsgsba.adb: New default file for non-CHERI targets.
	* libgnat/s-stausa.adb (Fill_Stack, Compute_Result): Port to CHERI.
	* libgnat/s-stausa.ads (Initialize_Analyzer, Stack_Analyzer): Port to CHERI.

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 8f925fce9e0d33a142822e29bb1addf12ea028b7..50e683aa80a78d9ed744d060d2eea489328419c0 100644 (file)
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -1854,6 +1854,7 @@ ifeq ($(strip $(filter-out %aarch64 freebsd%,$(target_cpu) $(target_os))),)
     LIBGNAT_TARGET_PAIRS += \
     s-intman.adb<libgnarl/s-intman__cheribsd.adb \
     s-osinte.ads<libgnarl/s-osinte__cheribsd.ads \
+    s-tsgsba.adb<libgnarl/s-tsgsba__cheri.adb \
     s-secsta.adb<libgnat/s-secsta__cheri.adb
 
     EXTRA_GNATRTL_NONTASKING_OBJS += i-cheri.o i-cheri-exceptions.o

diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index b1eb842ea60972e8e3468da0549773cae5e79fb9..98ee15b4baf22e32371ffdc1e179bc4ca8981a9d 100644 (file)
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -133,6 +133,11 @@ package body System.Tasking.Stages is
    --  Different code is used at master completion, in Terminate_Dependents,
    --  due to a need for tighter synchronization with the master.
 
+   function Get_Stack_Base (Self_ID : Task_Id) return System.Address;
+   --  Get the stack base of Self.
+   --
+   --  If the stack base cannot be determined, then Null_Address is returned.
+
    ----------------------
    -- Abort_Dependents --
    ----------------------
@@ -1113,7 +1118,7 @@ package body System.Tasking.Stages is
             --  Address of the base of the stack
 
          begin
-            Stack_Base := Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base;
+            Stack_Base := Get_Stack_Base (Self_ID);
 
             if Stack_Base = Null_Address then
 
@@ -1139,7 +1144,7 @@ package body System.Tasking.Stages is
               (Self_ID.Common.Analyzer,
                Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len),
                Natural (Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size),
-               SSE.To_Integer (Stack_Base),
+               Stack_Base,
                Pattern_Size);
             STPO.Unlock_RTS;
             Fill_Stack (Self_ID.Common.Analyzer);
@@ -1966,6 +1971,15 @@ package body System.Tasking.Stages is
       System.Task_Primitives.Operations.Finalize_TCB (T);
    end Vulnerable_Free_Task;
 
+   --------------------
+   -- Get_Stack_Base --
+   --------------------
+
+   --  Get_Stack_Base is architecture-specific
+
+   function Get_Stack_Base (Self_ID : Task_Id) return System.Address
+   is separate;
+
 --  Package elaboration code
 
 begin

diff --git a/gcc/ada/libgnarl/s-tsgsba.adb b/gcc/ada/libgnarl/s-tsgsba.adb
new file mode 100644 (file)
index 0000000..450513d
--- /dev/null
+++ b/gcc/ada/libgnarl/s-tsgsba.adb
@@ -0,0 +1,40 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+-- S Y S T E M . T A S K I N G . S T A G E S . G E T _ S T A C K _ B A S E  --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--         Copyright (C) 1992-2025, Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the default version for most platforms which tries to get the
+--  stack base from the compiler info. It returns Null_Address if the stack
+--  base is not available.
+
+separate (System.Tasking.Stages)
+function Get_Stack_Base (Self_ID : Task_Id) return System.Address is
+begin
+   return Self_ID.Common.Compiler_Data.Pri_Stack_Info.Base;
+end Get_Stack_Base;

diff --git a/gcc/ada/libgnarl/s-tsgsba__cheri.adb b/gcc/ada/libgnarl/s-tsgsba__cheri.adb
new file mode 100644 (file)
index 0000000..5c17836
--- /dev/null
+++ b/gcc/ada/libgnarl/s-tsgsba__cheri.adb
@@ -0,0 +1,49 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+-- S Y S T E M . T A S K I N G . S T A G E S . G E T _ S T A C K _ B A S E  --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--         Copyright (C) 1992-2025, Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+with Interfaces.CHERI;
+
+--  This is the version for CHERI targets where we can derive the stack base
+--  from the upper bound of the capability stack pointer (CSP).
+
+separate (System.Tasking.Stages)
+function Get_Stack_Base (Self_ID : Task_Id) return System.Address is
+   pragma Unreferenced (Self_ID);
+
+   use type SSE.Integer_Address;
+
+   CSP : constant System.Address := Interfaces.CHERI.Get_CSP;
+begin
+   return Interfaces.CHERI.Capability_With_Address
+            (Cap  => CSP,
+             Addr => Interfaces.CHERI.Get_Base (CSP) +
+                       SSE.Integer_Address
+                         (Interfaces.CHERI.Get_Length (CSP)));
+end Get_Stack_Base;

diff --git a/gcc/ada/libgnat/s-stausa.adb b/gcc/ada/libgnat/s-stausa.adb
index 6bdbc4342f13e489d6148e4fea1a1f89786b3372..cbecc0bb20ed5a841a6ce96cf10b480f6c36eae9 100644 (file)
--- a/gcc/ada/libgnat/s-stausa.adb
+++ b/gcc/ada/libgnat/s-stausa.adb
@@ -188,7 +188,8 @@ package body System.Stack_Usage is
       --  allocated byte on the stack.
    begin
       if Parameters.Stack_Grows_Down then
-         if Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size) >
+         if To_Stack_Address (Analyzer.Stack_Base) -
+              Stack_Address (Analyzer.Pattern_Size) >
               To_Stack_Address (Current_Stack_Level'Address) - Guard
          then
             --  No room for a pattern
@@ -198,22 +199,22 @@ package body System.Stack_Usage is
          end if;
 
          Analyzer.Pattern_Limit :=
-           Analyzer.Stack_Base - Stack_Address (Analyzer.Pattern_Size);
+           Analyzer.Stack_Base - Storage_Offset (Analyzer.Pattern_Size);
 
-         if Analyzer.Stack_Base >
+         if To_Stack_Address (Analyzer.Stack_Base) >
               To_Stack_Address (Current_Stack_Level'Address) - Guard
          then
             --  Reduce pattern size to prevent local frame overwrite
 
             Analyzer.Pattern_Size :=
               Integer (To_Stack_Address (Current_Stack_Level'Address) - Guard
-                         - Analyzer.Pattern_Limit);
+                         - To_Stack_Address (Analyzer.Pattern_Limit));
          end if;
 
-         Analyzer.Pattern_Overlay_Address :=
-           To_Address (Analyzer.Pattern_Limit);
+         Analyzer.Pattern_Overlay_Address := Analyzer.Pattern_Limit;
       else
-         if Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size) <
+         if To_Stack_Address (Analyzer.Stack_Base) +
+              Stack_Address (Analyzer.Pattern_Size) <
               To_Stack_Address (Current_Stack_Level'Address) + Guard
          then
             --  No room for a pattern
@@ -223,22 +224,21 @@ package body System.Stack_Usage is
          end if;
 
          Analyzer.Pattern_Limit :=
-           Analyzer.Stack_Base + Stack_Address (Analyzer.Pattern_Size);
+           Analyzer.Stack_Base + Storage_Offset (Analyzer.Pattern_Size);
 
-         if Analyzer.Stack_Base <
+         if To_Stack_Address (Analyzer.Stack_Base) <
            To_Stack_Address (Current_Stack_Level'Address) + Guard
          then
             --  Reduce pattern size to prevent local frame overwrite
 
             Analyzer.Pattern_Size :=
               Integer
-                (Analyzer.Pattern_Limit -
+                (To_Stack_Address (Analyzer.Pattern_Limit) -
                   (To_Stack_Address (Current_Stack_Level'Address) + Guard));
          end if;
 
          Analyzer.Pattern_Overlay_Address :=
-           To_Address (Analyzer.Pattern_Limit -
-                         Stack_Address (Analyzer.Pattern_Size));
+           Analyzer.Pattern_Limit - Storage_Offset (Analyzer.Pattern_Size);
       end if;
 
       --  Declare and fill the pattern buffer
@@ -270,7 +270,7 @@ package body System.Stack_Usage is
      (Analyzer         : in out Stack_Analyzer;
       Task_Name        : String;
       Stack_Size       : Natural;
-      Stack_Base       : Stack_Address;
+      Stack_Base       : System.Address;
       Pattern_Size     : Natural;
       Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#)
    is
@@ -332,10 +332,10 @@ package body System.Stack_Usage is
 
       if Parameters.Stack_Grows_Down then
          Analyzer.Topmost_Touched_Mark :=
-           Analyzer.Pattern_Limit + Stack_Address (Analyzer.Pattern_Size);
+           Analyzer.Pattern_Limit + Storage_Offset (Analyzer.Pattern_Size);
       else
          Analyzer.Topmost_Touched_Mark :=
-           Analyzer.Pattern_Limit - Stack_Address (Analyzer.Pattern_Size);
+           Analyzer.Pattern_Limit - Storage_Offset (Analyzer.Pattern_Size);
       end if;
 
       if Analyzer.Pattern_Size = 0 then
@@ -349,8 +349,7 @@ package body System.Stack_Usage is
       if System.Parameters.Stack_Grows_Down then
          for J in Stack'Range loop
             if Stack (J) /= Analyzer.Pattern then
-               Analyzer.Topmost_Touched_Mark :=
-                 To_Stack_Address (Stack (J)'Address);
+               Analyzer.Topmost_Touched_Mark := Stack (J)'Address;
                exit;
             end if;
          end loop;
@@ -358,8 +357,7 @@ package body System.Stack_Usage is
       else
          for J in reverse Stack'Range loop
             if Stack (J) /= Analyzer.Pattern then
-               Analyzer.Topmost_Touched_Mark :=
-                 To_Stack_Address (Stack (J)'Address);
+               Analyzer.Topmost_Touched_Mark := Stack (J)'Address;
                exit;
             end if;
          end loop;
@@ -514,8 +512,9 @@ package body System.Stack_Usage is
          Result.Value := Analyzer.Stack_Size;
 
       else
-         Result.Value := Stack_Size (Analyzer.Topmost_Touched_Mark,
-                                     Analyzer.Stack_Base);
+         Result.Value :=
+           Stack_Size (To_Stack_Address (Analyzer.Topmost_Touched_Mark),
+                       To_Stack_Address (Analyzer.Stack_Base));
       end if;
 
       if Analyzer.Result_Id in Result_Array'Range then

diff --git a/gcc/ada/libgnat/s-stausa.ads b/gcc/ada/libgnat/s-stausa.ads
index c67b1240ac473c6adc10519e4724e5bc63620454..36cebd7cde0762bb92e7be2b5150e1d23ce9d617 100644 (file)
--- a/gcc/ada/libgnat/s-stausa.ads
+++ b/gcc/ada/libgnat/s-stausa.ads
@@ -230,7 +230,7 @@ package System.Stack_Usage is
      (Analyzer         : in out Stack_Analyzer;
       Task_Name        : String;
       Stack_Size       : Natural;
-      Stack_Base       : Stack_Address;
+      Stack_Base       : System.Address;
       Pattern_Size     : Natural;
       Pattern          : Interfaces.Unsigned_32 := 16#DEAD_BEEF#);
    --  Should be called before any use of a Stack_Analyzer, to initialize it.
@@ -287,7 +287,7 @@ private
       Task_Name : String (1 .. Task_Name_Length);
       --  Name of the task
 
-      Stack_Base : Stack_Address;
+      Stack_Base : System.Address;
       --  Address of the base of the stack, as given by the caller of
       --  Initialize_Analyzer.
 
@@ -300,10 +300,10 @@ private
       Pattern : Pattern_Type;
       --  Pattern used to recognize untouched memory
 
-      Pattern_Limit : Stack_Address;
+      Pattern_Limit : System.Address;
       --  Bound of the pattern area farthest to the base
 
-      Topmost_Touched_Mark : Stack_Address;
+      Topmost_Touched_Mark : System.Address;
       --  Topmost address of the pattern area whose value it is pointing
       --  at has been modified during execution. If the systematic error are
       --  compensated, it is the topmost value of the stack pointer during