===================================================================
@@ -38,7 +38,7 @@
-- Turn off polling, we do not want ATC polling to take place during tasking
-- operations. It causes infinite loops and other problems.
-with Interfaces.C;
+with Interfaces.C; use Interfaces; use type Interfaces.C.int;
with System.Task_Info;
with System.Tasking.Debug;
@@ -60,7 +60,6 @@
use System.Tasking.Debug;
use System.Tasking;
- use Interfaces.C;
use System.OS_Interface;
use System.Parameters;
use System.OS_Primitives;
@@ -111,14 +110,6 @@
-- Constant to indicate that the thread identifier has not yet been
-- initialized.
- function geteuid return Integer;
- pragma Import (C, geteuid, "geteuid");
- pragma Warnings (Off, "non-static call not allowed in preelaborated unit");
- Superuser : constant Boolean := geteuid = 0;
- pragma Warnings (On, "non-static call not allowed in preelaborated unit");
- -- True if we are running as 'root'. On Linux, ceiling priorities work only
- -- in that case, so if this is False, we ignore Locking_Policy = 'C'.
-
--------------------
-- Local Packages --
--------------------
@@ -170,17 +161,52 @@
procedure Abort_Handler (signo : Signal);
function GNAT_pthread_condattr_setup
- (attr : access pthread_condattr_t) return int;
- pragma Import (C,
- GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ (attr : access pthread_condattr_t) return C.int;
+ pragma Import
+ (C, GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ function Prio_To_Linux_Prio (Prio : Any_Priority) return C.int is
+ (C.int (Prio) + 1);
+ -- Convert Ada priority to Linux priority. Priorities are 1 .. 99 on
+ -- GNU/Linux, so we map 0 .. 98 to 1 .. 99.
+
+ function Get_Ceiling_Support return Boolean;
+ -- Get the value of the Ceiling_Support constant (see below).
+ -- ???For now, we're returning True only if running as superuser,
+ -- and ignore capabilities.
+
+ function Get_Ceiling_Support return Boolean is
+ Ceiling_Support : Boolean := False;
+ begin
+ if Locking_Policy = 'C' then
+ declare
+ function geteuid return Integer;
+ pragma Import (C, geteuid, "geteuid");
+ Superuser : constant Boolean := geteuid = 0;
+ begin
+ if Superuser then
+ Ceiling_Support := True;
+ end if;
+ end;
+ end if;
+
+ return Ceiling_Support;
+ end Get_Ceiling_Support;
+
+ pragma Warnings (Off, "non-static call not allowed in preelaborated unit");
+ Ceiling_Support : constant Boolean := Get_Ceiling_Support;
+ pragma Warnings (On, "non-static call not allowed in preelaborated unit");
+ -- True if the locking policy is Ceiling_Locking, and the current process
+ -- has permission to use this policy. The process has permission if it is
+ -- running as 'root', or if the capability was set by the setcap command,
+ -- as in "sudo /sbin/setcap cap_sys_nice=ep exe_file". If it doesn't have
+ -- permission, then a request for Ceiling_Locking is ignored.
+
type RTS_Lock_Ptr is not null access all RTS_Lock;
- function Init_Mutex
- (L : RTS_Lock_Ptr; Prio : Any_Priority)
- return Interfaces.C.int;
- -- Initialize the mutex L. If the locking policy is Ceiling_Locking, then
- -- set the ceiling to Prio.
+ function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int;
+ -- Initialize the mutex L. If Ceiling_Support is True, then set the ceiling
+ -- to Prio. Returns 0 for success, or ENOMEM for out-of-memory.
-------------------
-- Abort_Handler --
@@ -190,7 +216,7 @@
pragma Unreferenced (signo);
Self_Id : constant Task_Id := Self;
- Result : Interfaces.C.int;
+ Result : C.int;
Old_Set : aliased sigset_t;
begin
@@ -272,30 +298,26 @@
-- Init_Mutex --
----------------
- function Init_Mutex
- (L : RTS_Lock_Ptr; Prio : Any_Priority)
- return Interfaces.C.int
- is
+ function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int is
Mutex_Attr : aliased pthread_mutexattr_t;
- Result : Interfaces.C.int;
+ Result, Result_2 : C.int;
+
begin
Result := pthread_mutexattr_init (Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result = ENOMEM then
- return ENOMEM;
+ return Result;
end if;
- if Locking_Policy = 'C' then
- if Superuser then
- Result := pthread_mutexattr_setprotocol
- (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT);
- pragma Assert (Result = 0);
+ if Ceiling_Support then
+ Result := pthread_mutexattr_setprotocol
+ (Mutex_Attr'Access, PTHREAD_PRIO_PROTECT);
+ pragma Assert (Result = 0);
- Result := pthread_mutexattr_setprioceiling
- (Mutex_Attr'Access, Interfaces.C.int (Prio));
- pragma Assert (Result = 0);
- end if;
+ Result := pthread_mutexattr_setprioceiling
+ (Mutex_Attr'Access, Prio_To_Linux_Prio (Prio));
+ pragma Assert (Result = 0);
elsif Locking_Policy = 'I' then
Result := pthread_mutexattr_setprotocol
@@ -304,16 +326,11 @@
end if;
Result := pthread_mutex_init (L, Mutex_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
- if Result = ENOMEM then
- Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
- return ENOMEM;
- end if;
-
- Result := pthread_mutexattr_destroy (Mutex_Attr'Access);
- pragma Assert (Result = 0);
- return 0;
+ Result_2 := pthread_mutexattr_destroy (Mutex_Attr'Access);
+ pragma Assert (Result_2 = 0);
+ return Result; -- of pthread_mutex_init, not pthread_mutexattr_destroy
end Init_Mutex;
---------------------
@@ -327,14 +344,14 @@
-- routines should be able to be handled safely.
procedure Initialize_Lock
- (Prio : System.Any_Priority;
+ (Prio : Any_Priority;
L : not null access Lock)
is
begin
if Locking_Policy = 'R' then
declare
RWlock_Attr : aliased pthread_rwlockattr_t;
- Result : Interfaces.C.int;
+ Result : C.int;
begin
-- Set the rwlock to prefer writer to avoid writers starvation
@@ -349,7 +366,7 @@
Result := pthread_rwlock_init (L.RW'Access, RWlock_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result = ENOMEM then
raise Storage_Error with "Failed to allocate a lock";
@@ -378,7 +395,7 @@
-------------------
procedure Finalize_Lock (L : not null access Lock) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if Locking_Policy = 'R' then
Result := pthread_rwlock_destroy (L.RW'Access);
@@ -389,7 +406,7 @@
end Finalize_Lock;
procedure Finalize_Lock (L : not null access RTS_Lock) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
Result := pthread_mutex_destroy (L);
pragma Assert (Result = 0);
@@ -403,7 +420,7 @@
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if Locking_Policy = 'R' then
Result := pthread_rwlock_wrlock (L.RW'Access);
@@ -413,15 +430,15 @@
-- The cause of EINVAL is a priority ceiling violation
+ pragma Assert (Result in 0 | EINVAL);
Ceiling_Violation := Result = EINVAL;
- pragma Assert (Result = 0 or else Ceiling_Violation);
end Write_Lock;
procedure Write_Lock
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if not Single_Lock or else Global_Lock then
Result := pthread_mutex_lock (L);
@@ -430,7 +447,7 @@
end Write_Lock;
procedure Write_Lock (T : Task_Id) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if not Single_Lock then
Result := pthread_mutex_lock (T.Common.LL.L'Access);
@@ -446,7 +463,7 @@
(L : not null access Lock;
Ceiling_Violation : out Boolean)
is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if Locking_Policy = 'R' then
Result := pthread_rwlock_rdlock (L.RW'Access);
@@ -456,8 +473,8 @@
-- The cause of EINVAL is a priority ceiling violation
+ pragma Assert (Result in 0 | EINVAL);
Ceiling_Violation := Result = EINVAL;
- pragma Assert (Result = 0 or else Ceiling_Violation);
end Read_Lock;
------------
@@ -465,7 +482,7 @@
------------
procedure Unlock (L : not null access Lock) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if Locking_Policy = 'R' then
Result := pthread_rwlock_unlock (L.RW'Access);
@@ -479,7 +496,7 @@
(L : not null access RTS_Lock;
Global_Lock : Boolean := False)
is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if not Single_Lock or else Global_Lock then
Result := pthread_mutex_unlock (L);
@@ -488,7 +505,7 @@
end Unlock;
procedure Unlock (T : Task_Id) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if not Single_Lock then
Result := pthread_mutex_unlock (T.Common.LL.L'Access);
@@ -504,7 +521,7 @@
procedure Set_Ceiling
(L : not null access Lock;
- Prio : System.Any_Priority)
+ Prio : Any_Priority)
is
pragma Unreferenced (L, Prio);
begin
@@ -521,7 +538,7 @@
is
pragma Unreferenced (Reason);
- Result : Interfaces.C.int;
+ Result : C.int;
begin
pragma Assert (Self_ID = Self);
@@ -535,7 +552,7 @@
-- EINTR is not considered a failure
- pragma Assert (Result = 0 or else Result = EINTR);
+ pragma Assert (Result in 0 | EINTR);
end Sleep;
-----------------
@@ -560,7 +577,7 @@
Check_Time : Duration := Base_Time;
Abs_Time : Duration;
Request : aliased timespec;
- Result : Interfaces.C.int;
+ Result : C.int;
begin
Timedout := True;
@@ -588,7 +605,7 @@
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
- if Result = 0 or else Result = EINTR then
+ if Result in 0 | EINTR then
-- Somebody may have called Wakeup for us
@@ -618,7 +635,7 @@
Abs_Time : Duration;
Request : aliased timespec;
- Result : Interfaces.C.int;
+ Result : C.int;
pragma Warnings (Off, Result);
begin
@@ -651,9 +668,7 @@
Check_Time := Monotonic_Clock;
exit when Abs_Time <= Check_Time or else Check_Time < Base_Time;
- pragma Assert (Result = 0 or else
- Result = ETIMEDOUT or else
- Result = EINTR);
+ pragma Assert (Result in 0 | ETIMEDOUT | EINTR);
end loop;
Self_ID.Common.State := Runnable;
@@ -674,7 +689,7 @@
function Monotonic_Clock return Duration is
TS : aliased timespec;
- Result : int;
+ Result : C.int;
begin
Result := clock_gettime
(clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
@@ -689,7 +704,7 @@
function RT_Resolution return Duration is
TS : aliased timespec;
- Result : int;
+ Result : C.int;
begin
Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
@@ -704,7 +719,7 @@
procedure Wakeup (T : Task_Id; Reason : System.Tasking.Task_States) is
pragma Unreferenced (Reason);
- Result : Interfaces.C.int;
+ Result : C.int;
begin
Result := pthread_cond_signal (T.Common.LL.CV'Access);
pragma Assert (Result = 0);
@@ -715,7 +730,7 @@
-----------
procedure Yield (Do_Yield : Boolean := True) is
- Result : Interfaces.C.int;
+ Result : C.int;
pragma Unreferenced (Result);
begin
if Do_Yield then
@@ -729,15 +744,15 @@
procedure Set_Priority
(T : Task_Id;
- Prio : System.Any_Priority;
+ Prio : Any_Priority;
Loss_Of_Inheritance : Boolean := False)
is
pragma Unreferenced (Loss_Of_Inheritance);
- Result : Interfaces.C.int;
+ Result : C.int;
Param : aliased struct_sched_param;
- function Get_Policy (Prio : System.Any_Priority) return Character;
+ function Get_Policy (Prio : Any_Priority) return Character;
pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
-- Get priority specific dispatching policy
@@ -748,10 +763,8 @@
begin
T.Common.Current_Priority := Prio;
- -- Priorities are 1 .. 99 on GNU/Linux, so we map 0 .. 98 to 1 .. 99
+ Param.sched_priority := Prio_To_Linux_Prio (Prio);
- Param.sched_priority := Interfaces.C.int (Prio) + 1;
-
if Dispatching_Policy = 'R'
or else Priority_Specific_Policy = 'R'
or else Time_Slice_Val > 0
@@ -776,14 +789,14 @@
SCHED_OTHER, Param'Access);
end if;
- pragma Assert (Result = 0 or else Result = EPERM);
+ pragma Assert (Result in 0 | EPERM | EINVAL);
end Set_Priority;
------------------
-- Get_Priority --
------------------
- function Get_Priority (T : Task_Id) return System.Any_Priority is
+ function Get_Priority (T : Task_Id) return Any_Priority is
begin
return T.Common.Current_Priority;
end Get_Priority;
@@ -817,7 +830,7 @@
Len : Natural := 0;
-- Length of the task name contained in Task_Name
- Result : int;
+ Result : C.int;
-- Result from the prctl call
begin
Result := prctl (PR_GET_NAME, unsigned_long (Thread_Name'Address));
@@ -849,7 +862,7 @@
elsif Self_ID.Common.Task_Image_Len > 0 then
declare
Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1);
- Result : int;
+ Result : C.int;
begin
Task_Name (1 .. Self_ID.Common.Task_Image_Len) :=
@@ -868,7 +881,7 @@
then
declare
Stack : aliased stack_t;
- Result : Interfaces.C.int;
+ Result : C.int;
begin
Stack.ss_sp := Self_ID.Common.Task_Alternate_Stack;
Stack.ss_size := Alternate_Stack_Size;
@@ -903,7 +916,7 @@
--------------------
procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
- Result : Interfaces.C.int;
+ Result : C.int;
Cond_Attr : aliased pthread_condattr_t;
begin
@@ -917,7 +930,7 @@
if not Single_Lock then
if Init_Mutex
- (Self_ID.Common.LL.L'Access, System.Any_Priority'Last) /= 0
+ (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0
then
Succeeded := False;
return;
@@ -925,7 +938,7 @@
end if;
Result := pthread_condattr_init (Cond_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result = 0 then
Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
@@ -934,7 +947,7 @@
Result :=
pthread_cond_init
(Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
end if;
if Result = 0 then
@@ -960,14 +973,14 @@
(T : Task_Id;
Wrapper : System.Address;
Stack_Size : System.Parameters.Size_Type;
- Priority : System.Any_Priority;
+ Priority : Any_Priority;
Succeeded : out Boolean)
is
Thread_Attr : aliased pthread_attr_t;
- Adjusted_Stack_Size : Interfaces.C.size_t;
- Result : Interfaces.C.int;
+ Adjusted_Stack_Size : C.size_t;
+ Result : C.int;
- use type System.Multiprocessors.CPU_Range;
+ use type Multiprocessors.CPU_Range, Interfaces.C.size_t;
begin
-- Check whether both Dispatching_Domain and CPU are specified for
@@ -975,7 +988,7 @@
-- processors for the domain.
if T.Common.Domain /= null
- and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
+ and then T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU
and then
(T.Common.Base_CPU not in T.Common.Domain'Range
or else not T.Common.Domain (T.Common.Base_CPU))
@@ -984,11 +997,10 @@
return;
end if;
- Adjusted_Stack_Size :=
- Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
+ Adjusted_Stack_Size := C.size_t (Stack_Size + Alternate_Stack_Size);
Result := pthread_attr_init (Thread_Attr'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result /= 0 then
Succeeded := False;
@@ -1013,16 +1025,15 @@
-- Do nothing if required support not provided by the operating system
- if pthread_attr_setaffinity_np'Address = System.Null_Address then
+ if pthread_attr_setaffinity_np'Address = Null_Address then
null;
-- Support is available
- elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+ elsif T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t
- (System.Multiprocessors.Number_Of_CPUs);
+ C.size_t (Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
@@ -1061,8 +1072,7 @@
then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t
- (System.Multiprocessors.Number_Of_CPUs);
+ C.size_t (Multiprocessors.Number_Of_CPUs);
CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
@@ -1103,8 +1113,7 @@
Thread_Body_Access (Wrapper),
To_Address (T));
- pragma Assert
- (Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
+ pragma Assert (Result in 0 | EAGAIN | ENOMEM);
if Result /= 0 then
Succeeded := False;
@@ -1126,7 +1135,7 @@
------------------
procedure Finalize_TCB (T : Task_Id) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
if not Single_Lock then
@@ -1158,7 +1167,7 @@
----------------
procedure Abort_Task (T : Task_Id) is
- Result : Interfaces.C.int;
+ Result : C.int;
ESRCH : constant := 3; -- No such process
-- It can happen that T has already vanished, in which case pthread_kill
@@ -1170,7 +1179,7 @@
pthread_kill
(T.Common.LL.Thread,
Signal (System.Interrupt_Management.Abort_Task_Interrupt));
- pragma Assert (Result = 0 or else Result = ESRCH);
+ pragma Assert (Result in 0 | ESRCH);
end if;
end Abort_Task;
@@ -1179,7 +1188,7 @@
----------------
procedure Initialize (S : in out Suspension_Object) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
-- Initialize internal state (always to False (RM D.10(6)))
@@ -1191,7 +1200,7 @@
Result := pthread_mutex_init (S.L'Access, null);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result = ENOMEM then
raise Storage_Error;
@@ -1201,7 +1210,7 @@
Result := pthread_cond_init (S.CV'Access, null);
- pragma Assert (Result = 0 or else Result = ENOMEM);
+ pragma Assert (Result in 0 | ENOMEM);
if Result /= 0 then
Result := pthread_mutex_destroy (S.L'Access);
@@ -1218,7 +1227,7 @@
--------------
procedure Finalize (S : in out Suspension_Object) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
-- Destroy internal mutex
@@ -1249,7 +1258,7 @@
---------------
procedure Set_False (S : in out Suspension_Object) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
SSL.Abort_Defer.all;
@@ -1270,7 +1279,7 @@
--------------
procedure Set_True (S : in out Suspension_Object) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
SSL.Abort_Defer.all;
@@ -1305,7 +1314,7 @@
------------------------
procedure Suspend_Until_True (S : in out Suspension_Object) is
- Result : Interfaces.C.int;
+ Result : C.int;
begin
SSL.Abort_Defer.all;
@@ -1343,7 +1352,7 @@
-- POSIX does not guarantee it so this may change in future.
Result := pthread_cond_wait (S.CV'Access, S.L'Access);
- pragma Assert (Result = 0 or else Result = EINTR);
+ pragma Assert (Result in 0 | EINTR);
exit when not S.Waiting;
end loop;
@@ -1456,7 +1465,7 @@
act : aliased struct_sigaction;
old_act : aliased struct_sigaction;
Tmp_Set : aliased sigset_t;
- Result : Interfaces.C.int;
+ Result : C.int;
-- Whether to use an alternate signal stack for stack overflows
function State
@@ -1538,7 +1547,7 @@
-----------------------
procedure Set_Task_Affinity (T : ST.Task_Id) is
- use type System.Multiprocessors.CPU_Range;
+ use type Multiprocessors.CPU_Range;
begin
-- Do nothing if there is no support for setting affinities or the
@@ -1546,17 +1555,16 @@
-- yet been created then the proper affinity will be set during its
-- creation.
- if pthread_setaffinity_np'Address /= System.Null_Address
+ if pthread_setaffinity_np'Address /= Null_Address
and then T.Common.LL.Thread /= Null_Thread_Id
then
declare
CPUs : constant size_t :=
- Interfaces.C.size_t
- (System.Multiprocessors.Number_Of_CPUs);
+ C.size_t (Multiprocessors.Number_Of_CPUs);
CPU_Set : cpu_set_t_ptr := null;
Size : constant size_t := CPU_ALLOC_SIZE (CPUs);
- Result : Interfaces.C.int;
+ Result : C.int;
begin
-- We look at the specific CPU (Base_CPU) first, then at the