From: Daniel King <dmk...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/Makefile.rtl | 1 +
gcc/ada/libgnarl/s-tassta.adb | 18 ++++++++--
gcc/ada/libgnarl/s-tsgsba.adb | 40 +++++++++++++++++++++++
gcc/ada/libgnarl/s-tsgsba__cheri.adb | 49 ++++++++++++++++++++++++++++
gcc/ada/libgnat/s-stausa.adb | 41 ++++++++++++-----------
gcc/ada/libgnat/s-stausa.ads | 8 ++---
6 files changed, 130 insertions(+), 27 deletions(-)
create mode 100644 gcc/ada/libgnarl/s-tsgsba.adb
create mode 100644 gcc/ada/libgnarl/s-tsgsba__cheri.adb
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 8f925fce9e0..50e683aa80a 100644
--- 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 b1eb842ea60..98ee15b4baf 100644
--- 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
index 00000000000..450513db132
--- /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
index 00000000000..5c1783675b4
--- /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 6bdbc4342f1..cbecc0bb20e 100644
--- 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 c67b1240ac4..36cebd7cde0 100644
--- 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
--
2.43.0
