aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/libgnarl
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/libgnarl')
-rw-r--r--gcc/ada/libgnarl/s-linux__android-aarch64.ads20
-rw-r--r--gcc/ada/libgnarl/s-linux__android-arm.ads18
-rw-r--r--gcc/ada/libgnarl/s-osinte__android.ads104
-rw-r--r--gcc/ada/libgnarl/s-stusta.adb5
-rw-r--r--gcc/ada/libgnarl/s-tasini.adb6
-rw-r--r--gcc/ada/libgnarl/s-taskin.ads2
-rw-r--r--gcc/ada/libgnarl/s-tassta.adb18
-rw-r--r--gcc/ada/libgnarl/s-tsgsba.adb40
-rw-r--r--gcc/ada/libgnarl/s-tsgsba__cheri.adb49
9 files changed, 213 insertions, 49 deletions
diff --git a/gcc/ada/libgnarl/s-linux__android-aarch64.ads b/gcc/ada/libgnarl/s-linux__android-aarch64.ads
index 4f9e81d..537c46b 100644
--- a/gcc/ada/libgnarl/s-linux__android-aarch64.ads
+++ b/gcc/ada/libgnarl/s-linux__android-aarch64.ads
@@ -118,13 +118,19 @@ package System.Linux is
SIG33 : constant := 33; -- glibc internal signal
SIG34 : constant := 34; -- glibc internal signal
- -- struct_sigaction offsets
-
- -- sa_flags come first on aarch64-android (sa_flags, sa_handler, sa_mask)
-
- sa_flags_pos : constant := 0;
- sa_handler_pos : constant := sa_flags_pos + Interfaces.C.int'Size / 8;
- sa_mask_pos : constant := sa_handler_pos + Standard'Address_Size / 8;
+ -- struct_sigaction
+
+ generic
+ type sigset_t is private;
+ package Android_Sigaction is
+ type struct_sigaction is record
+ sa_flags : Interfaces.C.int;
+ sa_handler : System.Address;
+ sa_mask : sigset_t;
+ sa_restorer : System.Address;
+ end record;
+ pragma Convention (C, struct_sigaction);
+ end Android_Sigaction;
SA_SIGINFO : constant := 16#00000004#;
SA_ONSTACK : constant := 16#08000000#;
diff --git a/gcc/ada/libgnarl/s-linux__android-arm.ads b/gcc/ada/libgnarl/s-linux__android-arm.ads
index 3e0325e..07bca55 100644
--- a/gcc/ada/libgnarl/s-linux__android-arm.ads
+++ b/gcc/ada/libgnarl/s-linux__android-arm.ads
@@ -118,11 +118,19 @@ package System.Linux is
SIG33 : constant := 33; -- glibc internal signal
SIG34 : constant := 34; -- glibc internal signal
- -- struct_sigaction offsets
-
- sa_handler_pos : constant := 0;
- sa_mask_pos : constant := Standard'Address_Size / 8;
- sa_flags_pos : constant := 4 + sa_mask_pos;
+ -- struct_sigaction
+
+ generic
+ type sigset_t is private;
+ package Android_Sigaction is
+ type struct_sigaction is record
+ sa_handler : System.Address;
+ sa_mask : sigset_t;
+ sa_flags : Interfaces.C.int;
+ sa_restorer : System.Address;
+ end record;
+ pragma Convention (C, struct_sigaction);
+ end Android_Sigaction;
SA_SIGINFO : constant := 16#00000004#;
SA_ONSTACK : constant := 16#08000000#;
diff --git a/gcc/ada/libgnarl/s-osinte__android.ads b/gcc/ada/libgnarl/s-osinte__android.ads
index cd7e148..4383860 100644
--- a/gcc/ada/libgnarl/s-osinte__android.ads
+++ b/gcc/ada/libgnarl/s-osinte__android.ads
@@ -147,7 +147,20 @@ package System.OS_Interface is
-- Not clear why these two signals are reserved. Perhaps they are not
-- supported by this version of GNU/Linux ???
- type sigset_t is private;
+ -- struct sigaction fields are of different sizes and come in different
+ -- order on ARM vs aarch64. As this source is shared by the two
+ -- configurations, fetch the type definition through System.Linux, which
+ -- is specialized.
+
+ type sigset_t is
+ array (0 .. OS_Constants.SIZEOF_sigset - 1) of Interfaces.C.unsigned_char;
+ pragma Convention (C, sigset_t);
+ for sigset_t'Alignment use Interfaces.C.unsigned_long'Alignment;
+
+ package Android_Sigaction is new
+ System.Linux.Android_Sigaction (sigset_t => sigset_t);
+
+ type struct_sigaction is new Android_Sigaction.struct_sigaction;
function sigaddset (set : access sigset_t; sig : Signal) return int;
pragma Import (C, sigaddset, "_sigaddset");
@@ -173,14 +186,6 @@ package System.OS_Interface is
end record;
pragma Convention (C, siginfo_t);
- type struct_sigaction is record
- sa_handler : System.Address;
- sa_mask : sigset_t;
- sa_flags : Interfaces.C.int;
- sa_restorer : System.Address;
- end record;
- pragma Convention (C, struct_sigaction);
-
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := System.Linux.SA_SIGINFO;
@@ -258,6 +263,14 @@ package System.OS_Interface is
function getpid return pid_t;
pragma Import (C, getpid, "getpid");
+ PR_SET_NAME : constant := 15;
+ PR_GET_NAME : constant := 16;
+
+ function prctl
+ (option : int;
+ arg : unsigned_long) return int;
+ pragma Import (C_Variadic_1, prctl, "prctl");
+
-------------
-- Threads --
-------------
@@ -276,9 +289,11 @@ package System.OS_Interface is
new Ada.Unchecked_Conversion (unsigned_long, pthread_t);
subtype pthread_mutex_t is System.OS_Locks.pthread_mutex_t;
+ type pthread_rwlock_t is limited private;
type pthread_cond_t is limited private;
type pthread_attr_t is limited private;
type pthread_mutexattr_t is limited private;
+ type pthread_rwlockattr_t is limited private;
type pthread_condattr_t is limited private;
type pthread_key_t is private;
@@ -287,11 +302,6 @@ package System.OS_Interface is
PTHREAD_SCOPE_PROCESS : constant := 1;
PTHREAD_SCOPE_SYSTEM : constant := 0;
- -- Read/Write lock not supported on Android.
-
- subtype pthread_rwlock_t is pthread_mutex_t;
- subtype pthread_rwlockattr_t is pthread_mutexattr_t;
-
-----------
-- Stack --
-----------
@@ -389,6 +399,43 @@ package System.OS_Interface is
function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock");
+ function pthread_rwlockattr_init
+ (attr : access pthread_rwlockattr_t) return int;
+ pragma Import (C, pthread_rwlockattr_init, "pthread_rwlockattr_init");
+
+ function pthread_rwlockattr_destroy
+ (attr : access pthread_rwlockattr_t) return int;
+ pragma Import (C, pthread_rwlockattr_destroy, "pthread_rwlockattr_destroy");
+
+ PTHREAD_RWLOCK_PREFER_READER_NP : constant := 0;
+ PTHREAD_RWLOCK_PREFER_WRITER_NONRECURSIVE_NP : constant := 1;
+
+ -- No PTHREAD_RWLOCK_PREFER_WRITER_NP in Android's pthread.h API level 29
+
+ function pthread_rwlockattr_setkind_np
+ (attr : access pthread_rwlockattr_t;
+ pref : int) return int;
+ pragma Import
+ (C, pthread_rwlockattr_setkind_np, "pthread_rwlockattr_setkind_np");
+
+ function pthread_rwlock_init
+ (mutex : access pthread_rwlock_t;
+ attr : access pthread_rwlockattr_t) return int;
+ pragma Import (C, pthread_rwlock_init, "pthread_rwlock_init");
+
+ function pthread_rwlock_destroy
+ (mutex : access pthread_rwlock_t) return int;
+ pragma Import (C, pthread_rwlock_destroy, "pthread_rwlock_destroy");
+
+ function pthread_rwlock_rdlock (mutex : access pthread_rwlock_t) return int;
+ pragma Import (C, pthread_rwlock_rdlock, "pthread_rwlock_rdlock");
+
+ function pthread_rwlock_wrlock (mutex : access pthread_rwlock_t) return int;
+ pragma Import (C, pthread_rwlock_wrlock, "pthread_rwlock_wrlock");
+
+ function pthread_rwlock_unlock (mutex : access pthread_rwlock_t) return int;
+ pragma Import (C, pthread_rwlock_unlock, "pthread_rwlock_unlock");
+
function pthread_condattr_init
(attr : access pthread_condattr_t) return int;
pragma Import (C, pthread_condattr_init, "pthread_condattr_init");
@@ -581,23 +628,6 @@ package System.OS_Interface is
private
- type sigset_t is
- array (0 .. OS_Constants.SIZEOF_sigset - 1) of unsigned_char;
- pragma Convention (C, sigset_t);
- for sigset_t'Alignment use Interfaces.C.unsigned_long'Alignment;
-
- pragma Warnings (Off);
- for struct_sigaction use record
- sa_handler at Linux.sa_handler_pos range 0 .. Standard'Address_Size - 1;
- sa_mask at Linux.sa_mask_pos
- range 0 .. OS_Constants.SIZEOF_sigset * 8 - 1;
- sa_flags at Linux.sa_flags_pos
- range 0 .. Interfaces.C.int'Size - 1;
- end record;
- -- We intentionally leave sa_restorer unspecified and let the compiler
- -- append it after the last field, so disable corresponding warning.
- pragma Warnings (On);
-
type pid_t is new int;
type time_t is range -2 ** (System.Parameters.time_t_bits - 1)
@@ -632,6 +662,18 @@ private
pragma Convention (C, pthread_mutexattr_t);
for pthread_mutexattr_t'Alignment use Interfaces.C.int'Alignment;
+ type pthread_rwlockattr_t is record
+ Data : char_array (1 .. OS_Constants.PTHREAD_RWLOCKATTR_SIZE);
+ end record;
+ pragma Convention (C, pthread_rwlockattr_t);
+ for pthread_rwlockattr_t'Alignment use Interfaces.C.unsigned_long'Alignment;
+
+ type pthread_rwlock_t is record
+ Data : char_array (1 .. OS_Constants.PTHREAD_RWLOCK_SIZE);
+ end record;
+ pragma Convention (C, pthread_rwlock_t);
+ for pthread_rwlock_t'Alignment use Interfaces.C.unsigned_long'Alignment;
+
type pthread_cond_t is record
Data : char_array (1 .. OS_Constants.PTHREAD_COND_SIZE);
end record;
diff --git a/gcc/ada/libgnarl/s-stusta.adb b/gcc/ada/libgnarl/s-stusta.adb
index 5aca435..c9848a0 100644
--- a/gcc/ada/libgnarl/s-stusta.adb
+++ b/gcc/ada/libgnarl/s-stusta.adb
@@ -32,6 +32,7 @@
-- This is why this package is part of GNARL:
with System.Tasking.Debug;
+with System.Tasking.Stages;
with System.Task_Primitives.Operations;
with System.IO;
@@ -103,7 +104,9 @@ package body System.Stack_Usage.Tasking is
-- Calculate the task usage for a given task
- Report_For_Task (Id);
+ if not System.Tasking.Stages.Terminated (Id) then
+ Report_For_Task (Id);
+ end if;
end loop;
end if;
diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
index 144ac7c..ae08265 100644
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -115,11 +115,13 @@ package body System.Tasking.Initialization is
procedure Tasking_Runtime_Initialize;
pragma Export (Ada, Tasking_Runtime_Initialize,
"__gnat_tasking_runtime_initialize");
+ pragma Linker_Constructor (Tasking_Runtime_Initialize);
-- This procedure starts the initialization of the GNARL. It installs the
- -- tasking versions of the RTS_Lock manipulation routines. It is called
+ -- tasking version of the RTS_Lock manipulation routines. It is called
-- very early before the elaboration of all the Ada units of the program,
-- including those of the runtime, because this elaboration may require
- -- the initialization of RTS_Lock objects.
+ -- the initialization of RTS_Lock objects, which means that it must only
+ -- contain code to which pragma Restrictions (No_Elaboration_Code) applies.
--------------------------
-- Change_Base_Priority --
diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
index d68e199..dbf2e7b 100644
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -390,7 +390,7 @@ package System.Tasking is
System_Domain : Dispatching_Domain_Access;
-- All processors belong to default system dispatching domain at start up.
-- We use a pointer which creates the actual variable for the reasons
- -- explained bellow in Dispatching_Domain_Tasks.
+ -- explained below in Dispatching_Domain_Tasks.
Dispatching_Domains_Frozen : Boolean := False;
-- True when the main procedure has been called. Hence, no new dispatching
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index b1eb842..98ee15b 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 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
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;
generated by cgit v1.1 at 2025-07-16 17:57:34 +0000