diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2024-03-04 12:44:11 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-17 10:21:05 +0200 |
commit | 3a5c4f926676bada86b7862ec0257ac5170b7976 (patch) | |
tree | f219ac2a0da17cd755d481e661633ffea75a6b1d /gcc/ada/libgnarl/s-taprop__qnx.adb | |
parent | 75de817d88aade7fc5e8b4bebe3f179f1c5b6a87 (diff) | |
download | gcc-3a5c4f926676bada86b7862ec0257ac5170b7976.zip gcc-3a5c4f926676bada86b7862ec0257ac5170b7976.tar.gz gcc-3a5c4f926676bada86b7862ec0257ac5170b7976.tar.bz2 |
ada: Factor out duplicated code in bodies of System.Task_Primitives.Operations
The duplication is present in some POSIX-like implementations (POSIX
and RTEMS) while it has already been eliminated in others (Linux, QNX). The
latter implementations are also slightly modified for consistency's sake.
No functional changes.
gcc/ada/
* libgnarl/s-taprop__dummy.adb (Initialize_Lock): Fix formatting.
* libgnarl/s-taprop__linux.adb (RTS_Lock_Ptr): Delete.
(Init_Mutex): Rename into...
(Initialize_Lock): ...this.
(Initialize_Lock [Lock]): Call above procedure.
(Initialize_Lock [RTS_Lock]): Likewise.
(Initialize_TCB): Likewise.
* libgnarl/s-taprop__posix.adb (Initialize_Lock): New procedure
factored out from the other two homonyms.
(Initialize_Lock [Lock]): Call above procedure.
(Initialize_Lock [RTS_Lock]): Likewise.
* libgnarl/s-taprop__qnx.adb (RTS_Lock_Ptr): Delete.
(Init_Mutex): Rename into...
(Initialize_Lock): ...this.
(Initialize_Lock [Lock]): Call above procedure.
(Initialize_Lock [RTS_Lock]): Likewise.
(Initialize_TCB): Likewise.
* libgnarl/s-taprop__rtems.adb (Initialize_Lock): New procedure
factored out from the other two homonyms.
(Initialize_Lock [Lock]): Call above procedure.
(Initialize_Lock [RTS_Lock]): Likewise.
Diffstat (limited to 'gcc/ada/libgnarl/s-taprop__qnx.adb')
-rw-r--r-- | gcc/ada/libgnarl/s-taprop__qnx.adb | 46 |
1 files changed, 23 insertions, 23 deletions
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb b/gcc/ada/libgnarl/s-taprop__qnx.adb index 8b98af7..2f11d28 100644 --- a/gcc/ada/libgnarl/s-taprop__qnx.adb +++ b/gcc/ada/libgnarl/s-taprop__qnx.adb @@ -115,10 +115,10 @@ package body System.Task_Primitives.Operations is Abort_Handler_Installed : Boolean := False; -- True if a handler for the abort signal is installed - type RTS_Lock_Ptr is not null access all RTS_Lock; - - function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return int; - -- Initialize the mutex L. If Ceiling_Support is True, then set the ceiling + function Initialize_Lock + (L : not null access RTS_Lock; + Prio : Any_Priority) return int; + -- Initialize the lock L. If Ceiling_Support is True, then set the ceiling -- to Prio. Returns 0 for success, or ENOMEM for out-of-memory. function Get_Policy (Prio : System.Any_Priority) return Character; @@ -319,11 +319,19 @@ package body System.Task_Primitives.Operations is function Self return Task_Id renames Specific.Self; - ---------------- - -- Init_Mutex -- - ---------------- + --------------------- + -- Initialize_Lock -- + --------------------- + + -- Note: mutexes and cond_variables needed per-task basis are initialized + -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such + -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any + -- status change of RTS. Therefore raising Storage_Error in the following + -- routines should be able to be handled safely. - function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return int + function Initialize_Lock + (L : not null access RTS_Lock; + Prio : Any_Priority) return int is Attributes : aliased pthread_mutexattr_t; Result : int; @@ -365,35 +373,26 @@ package body System.Task_Primitives.Operations is pragma Assert (Result_2 = 0); return Result; - end Init_Mutex; - - --------------------- - -- Initialize_Lock -- - --------------------- - - -- Note: mutexes and cond_variables needed per-task basis are initialized - -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such - -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any - -- status change of RTS. Therefore raising Storage_Error in the following - -- routines should be able to be handled safely. + end Initialize_Lock; procedure Initialize_Lock (Prio : System.Any_Priority; L : not null access Lock) is begin - if Init_Mutex (L.WO'Access, Prio) = ENOMEM then + if Initialize_Lock (L.WO'Access, Prio) = ENOMEM then raise Storage_Error with "Failed to allocate a lock"; end if; end Initialize_Lock; procedure Initialize_Lock - (L : not null access RTS_Lock; Level : Lock_Level) + (L : not null access RTS_Lock; + Level : Lock_Level) is pragma Unreferenced (Level); begin - if Init_Mutex (L.all'Access, Any_Priority'Last) = ENOMEM then + if Initialize_Lock (L, Any_Priority'Last) = ENOMEM then raise Storage_Error with "Failed to allocate a lock"; end if; end Initialize_Lock; @@ -706,7 +705,8 @@ package body System.Task_Primitives.Operations is Next_Serial_Number := Next_Serial_Number + 1; pragma Assert (Next_Serial_Number /= 0); - Result := Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last); + Result := + Initialize_Lock (Self_ID.Common.LL.L'Access, Any_Priority'Last); pragma Assert (Result = 0); if Result /= 0 then |