diff options
Diffstat (limited to 'gcc/ada/s-taprop-linux.adb')
-rw-r--r-- | gcc/ada/s-taprop-linux.adb | 39 |
1 files changed, 16 insertions, 23 deletions
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 250bd8de779..e2aab2e2c0e 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -75,7 +75,7 @@ with System.Soft_Links; -- Note that we do not use System.Tasking.Initialization directly since -- this is a higher level package that we shouldn't depend on. For example -- when using the restricted run time, it is replaced by --- System.Tasking.Restricted.Initialization +-- System.Tasking.Restricted.Stages. with System.OS_Primitives; -- used for Delay_Modes @@ -97,9 +97,9 @@ package body System.Task_Primitives.Operations is package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -113,18 +113,18 @@ package body System.Task_Primitives.Operations is -- Key used to find the Ada Task_Id associated with a thread Environment_Task_Id : Task_Id; - -- A variable to hold Task_Id for the environment task. + -- A variable to hold Task_Id for the environment task Unblocked_Signal_Mask : aliased sigset_t; -- The set of signals that should unblocked in all tasks - -- The followings are internal configuration constants needed. + -- The followings are internal configuration constants needed + Priority_Ceiling_Emulation : constant Boolean := True; Next_Serial_Number : Task_Serial_Number := 100; -- We start at 100, to reserve some special values for -- using in error checking. - -- The following are internal configuration constants needed. Time_Slice_Val : Integer; pragma Import (C, Time_Slice_Val, "__gl_time_slice_val"); @@ -133,7 +133,7 @@ package body System.Task_Primitives.Operations is pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy"); FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F'; - -- Indicates whether FIFO_Within_Priorities is set. + -- Indicates whether FIFO_Within_Priorities is set -- The following are effectively constants, but they need to -- be initialized by calling a pthread_ function. @@ -142,7 +142,7 @@ package body System.Task_Primitives.Operations is Cond_Attr : aliased pthread_condattr_t; Foreign_Task_Elaborated : aliased Boolean := True; - -- Used to identified fake tasks (i.e., non-Ada Threads). + -- Used to identified fake tasks (i.e., non-Ada Threads) -------------------- -- Local Packages -- @@ -152,7 +152,7 @@ package body System.Task_Primitives.Operations is procedure Initialize (Environment_Task : Task_Id); pragma Inline (Initialize); - -- Initialize various data needed by this package. + -- Initialize various data needed by this package function Is_Valid_Task return Boolean; pragma Inline (Is_Valid_Task); @@ -160,7 +160,7 @@ package body System.Task_Primitives.Operations is procedure Set (Self_Id : Task_Id); pragma Inline (Set); - -- Set the self id for the current task. + -- Set the self id for the current task function Self return Task_Id; pragma Inline (Self); @@ -169,14 +169,14 @@ package body System.Task_Primitives.Operations is end Specific; package body Specific is separate; - -- The body of this package is target specific. + -- The body of this package is target specific --------------------------------- -- Support for foreign threads -- --------------------------------- function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id; - -- Allocate and Initialize a new ATCB for the current Thread. + -- Allocate and Initialize a new ATCB for the current Thread function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is separate; @@ -323,7 +323,6 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : access Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_destroy (L.L'Access); pragma Assert (Result = 0); @@ -331,7 +330,6 @@ package body System.Task_Primitives.Operations is procedure Finalize_Lock (L : access RTS_Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_destroy (L); pragma Assert (Result = 0); @@ -381,7 +379,6 @@ package body System.Task_Primitives.Operations is Global_Lock : Boolean := False) is Result : Interfaces.C.int; - begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_lock (L); @@ -391,7 +388,6 @@ package body System.Task_Primitives.Operations is procedure Write_Lock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_lock (T.Common.LL.L'Access); @@ -437,7 +433,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False) is Result : Interfaces.C.int; - begin if not Single_Lock or else Global_Lock then Result := pthread_mutex_unlock (L); @@ -447,7 +442,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (T : Task_Id) is Result : Interfaces.C.int; - begin if not Single_Lock then Result := pthread_mutex_unlock (T.Common.LL.L'Access); @@ -478,7 +472,8 @@ package body System.Task_Primitives.Operations is (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access); end if; - -- EINTR is not considered a failure. + -- EINTR is not considered a failure + pragma Assert (Result = 0 or else Result = EINTR); end Sleep; @@ -631,7 +626,6 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TV : aliased struct_timeval; Result : Interfaces.C.int; - begin Result := gettimeofday (TV'Access, System.Null_Address); pragma Assert (Result = 0); @@ -785,7 +779,7 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin - -- Give the task a unique serial number. + -- Give the task a unique serial number Self_ID.Serial_Number := Next_Serial_Number; Next_Serial_Number := Next_Serial_Number + 1; @@ -932,7 +926,6 @@ package body System.Task_Primitives.Operations is procedure Abort_Task (T : Task_Id) is Result : Interfaces.C.int; - begin Result := pthread_kill (T.Common.LL.Thread, Signal (System.Interrupt_Management.Abort_Task_Interrupt)); |