diff options
Diffstat (limited to 'gcc/ada/s-taprop-hpux-dce.adb')
| -rw-r--r-- | gcc/ada/s-taprop-hpux-dce.adb | 49 |
1 files changed, 20 insertions, 29 deletions
diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb index 1789635f685..c5a13d03951 100644 --- a/gcc/ada/s-taprop-hpux-dce.adb +++ b/gcc/ada/s-taprop-hpux-dce.adb @@ -73,7 +73,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 @@ -93,9 +93,9 @@ package body System.Task_Primitives.Operations is package PIO renames System.Task_Primitives.Interrupt_Operations; package SSL renames System.Soft_Links; - ------------------ - -- Local Data -- - ------------------ + ---------------- + -- Local Data -- + ---------------- -- The followings are logically constants, but need to be initialized -- at run time. @@ -109,7 +109,7 @@ 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 @@ -125,10 +125,10 @@ package body System.Task_Primitives.Operations is -- stage considered dead, and no further work is planned on it. FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F'; - -- Indicates whether FIFO_Within_Priorities is set. + -- Indicates whether FIFO_Within_Priorities is set 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 -- @@ -138,7 +138,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); @@ -146,23 +146,23 @@ 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); - -- Return a pointer to the Ada Task Control Block of the calling task. + -- Return a pointer to the Ada Task Control Block of the calling task 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; @@ -339,7 +339,6 @@ package body System.Task_Primitives.Operations is (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_lock (L); @@ -349,7 +348,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); @@ -372,7 +370,6 @@ package body System.Task_Primitives.Operations is procedure Unlock (L : access Lock) is Result : Interfaces.C.int; - begin Result := pthread_mutex_unlock (L.L'Access); pragma Assert (Result = 0); @@ -389,7 +386,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); @@ -417,7 +413,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; @@ -498,9 +495,8 @@ package body System.Task_Primitives.Operations is Result : Interfaces.C.int; begin - -- Only the little window between deferring abort and - -- locking Self_ID is the reason we need to - -- check for pending abort and priority change below! :( + -- The little window between deferring abort and locking Self_ID is the + -- only reason to check for pending abort and priority change below! SSL.Abort_Defer.all; @@ -564,7 +560,6 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is TS : aliased timespec; Result : Interfaces.C.int; - begin Result := Clock_Gettime (CLOCK_REALTIME, TS'Unchecked_Access); pragma Assert (Result = 0); @@ -918,8 +913,7 @@ package body System.Task_Primitives.Operations is -- Check_Exit -- ---------------- - -- Dummy versions. The only currently working versions is for solaris - -- (native). + -- Dummy version function Check_Exit (Self_ID : ST.Task_Id) return Boolean is pragma Unreferenced (Self_ID); @@ -974,7 +968,6 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (T); pragma Unreferenced (Thread_Self); - begin return False; end Suspend_Task; @@ -989,7 +982,6 @@ package body System.Task_Primitives.Operations is is pragma Unreferenced (T); pragma Unreferenced (Thread_Self); - begin return False; end Resume_Task; @@ -1007,9 +999,8 @@ package body System.Task_Primitives.Operations is function State (Int : System.Interrupt_Management.Interrupt_ID) return Character; pragma Import (C, State, "__gnat_get_interrupt_state"); - -- Get interrupt state. Defined in a-init.c - -- The input argument is the interrupt number, - -- and the result is one of the following: + -- Get interrupt state. Defined in a-init.c. The input argument is + -- the interrupt number, and the result is one of the following: Default : constant Character := 's'; -- 'n' this interrupt not set by any Interrupt_State pragma @@ -1021,7 +1012,7 @@ package body System.Task_Primitives.Operations is begin Environment_Task_Id := Environment_Task; - -- Initialize the lock used to synchronize chain of all ATCBs. + -- Initialize the lock used to synchronize chain of all ATCBs Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level); |