From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnarl/s-taprop__dummy.adb | 4 +-
gcc/ada/libgnarl/s-taprop__linux.adb | 47 ++++++++++-----------
gcc/ada/libgnarl/s-taprop__posix.adb | 61 +++++++++-------------------
gcc/ada/libgnarl/s-taprop__qnx.adb | 46 ++++++++++-----------
gcc/ada/libgnarl/s-taprop__rtems.adb | 61 +++++++++-------------------
5 files changed, 90 insertions(+), 129 deletions(-)
diff --git a/gcc/ada/libgnarl/s-taprop__dummy.adb
b/gcc/ada/libgnarl/s-taprop__dummy.adb
index 90c4cd4cf72..829d595694c 100644
--- a/gcc/ada/libgnarl/s-taprop__dummy.adb
+++ b/gcc/ada/libgnarl/s-taprop__dummy.adb
@@ -239,7 +239,9 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
- (L : not null access RTS_Lock; Level : Lock_Level) is
+ (L : not null access RTS_Lock;
+ Level : Lock_Level)
+ is
begin
null;
end Initialize_Lock;
diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb
b/gcc/ada/libgnarl/s-taprop__linux.adb
index d6a29b5e158..74717cb2d2b 100644
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -248,10 +248,10 @@ package body System.Task_Primitives.Operations is
-- 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 C.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 C.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.
-------------------
@@ -340,11 +340,20 @@ package body System.Task_Primitives.Operations is
function Self return Task_Id renames Specific.Self;
- ----------------
- -- Init_Mutex --
- ----------------
+ ---------------------
+ -- Initialize_Lock --
+ ---------------------
- function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int is
+ -- 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 Initialize_Lock
+ (L : not null access RTS_Lock;
+ Prio : Any_Priority) return C.int
+ is
Mutex_Attr : aliased pthread_mutexattr_t;
Result, Result_2 : C.int;
@@ -377,17 +386,7 @@ package body System.Task_Primitives.Operations is
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;
-
- ---------------------
- -- 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 : Any_Priority;
@@ -420,18 +419,19 @@ package body System.Task_Primitives.Operations is
end;
else
- 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 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;
@@ -840,7 +840,8 @@ package body System.Task_Primitives.Operations is
Self_ID.Common.LL.Thread := Null_Thread_Id;
- if Init_Mutex (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0 then
+ if Initialize_Lock (Self_ID.Common.LL.L'Access, Any_Priority'Last) /= 0
+ then
Succeeded := False;
return;
end if;
diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb
b/gcc/ada/libgnarl/s-taprop__posix.adb
index 79694129227..a71e42112ac 100644
--- a/gcc/ada/libgnarl/s-taprop__posix.adb
+++ b/gcc/ada/libgnarl/s-taprop__posix.adb
@@ -211,6 +211,11 @@ package body System.Task_Primitives.Operations is
pragma Import (C,
GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock;
+ Prio : System.Any_Priority);
+ -- Initialize an RTS_Lock with the specified priority
+
-------------------
-- Abort_Handler --
-------------------
@@ -319,11 +324,11 @@ package body System.Task_Primitives.Operations is
-- routines should be able to be handled safely.
procedure Initialize_Lock
- (Prio : System.Any_Priority;
- L : not null access Lock)
+ (L : not null access RTS_Lock;
+ Prio : System.Any_Priority)
is
Attributes : aliased pthread_mutexattr_t;
- Result : Interfaces.C.int;
+ Result : Interfaces.C.int;
begin
Result := pthread_mutexattr_init (Attributes'Access);
@@ -348,7 +353,7 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end if;
- Result := pthread_mutex_init (L.WO'Access, Attributes'Access);
+ Result := pthread_mutex_init (L, Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = ENOMEM then
@@ -361,46 +366,20 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
- (L : not null access RTS_Lock; Level : Lock_Level)
+ (Prio : System.Any_Priority;
+ L : not null access Lock)
is
- pragma Unreferenced (Level);
-
- Attributes : aliased pthread_mutexattr_t;
- Result : Interfaces.C.int;
-
begin
- Result := pthread_mutexattr_init (Attributes'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = ENOMEM then
- raise Storage_Error;
- end if;
-
- if Locking_Policy = 'C' then
- Result := pthread_mutexattr_setprotocol
- (Attributes'Access, PTHREAD_PRIO_PROTECT);
- pragma Assert (Result = 0);
-
- Result := pthread_mutexattr_setprioceiling
- (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last));
- pragma Assert (Result = 0);
-
- elsif Locking_Policy = 'I' then
- Result := pthread_mutexattr_setprotocol
- (Attributes'Access, PTHREAD_PRIO_INHERIT);
- pragma Assert (Result = 0);
- end if;
-
- Result := pthread_mutex_init (L, Attributes'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = ENOMEM then
- Result := pthread_mutexattr_destroy (Attributes'Access);
- raise Storage_Error;
- end if;
+ Initialize_Lock (L.WO'Access, Prio);
+ end Initialize_Lock;
- Result := pthread_mutexattr_destroy (Attributes'Access);
- pragma Assert (Result = 0);
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock;
+ Level : Lock_Level)
+ is
+ pragma Unreferenced (Level);
+ begin
+ Initialize_Lock (L, System.Any_Priority'Last);
end Initialize_Lock;
-------------------
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb
b/gcc/ada/libgnarl/s-taprop__qnx.adb
index 8b98af7284e..2f11d2821fb 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
diff --git a/gcc/ada/libgnarl/s-taprop__rtems.adb
b/gcc/ada/libgnarl/s-taprop__rtems.adb
index 68a956e5c06..b041592cbe0 100644
--- a/gcc/ada/libgnarl/s-taprop__rtems.adb
+++ b/gcc/ada/libgnarl/s-taprop__rtems.adb
@@ -202,6 +202,11 @@ package body System.Task_Primitives.Operations is
pragma Import (C,
GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock;
+ Prio : System.Any_Priority);
+ -- Initialize an RTS_Lock with the specified priority
+
-------------------
-- Abort_Handler --
-------------------
@@ -329,11 +334,11 @@ package body System.Task_Primitives.Operations is
-- routines should be able to be handled safely.
procedure Initialize_Lock
- (Prio : System.Any_Priority;
- L : not null access Lock)
+ (L : not null access RTS_Lock;
+ Prio : System.Any_Priority)
is
Attributes : aliased pthread_mutexattr_t;
- Result : Interfaces.C.int;
+ Result : Interfaces.C.int;
begin
Result := pthread_mutexattr_init (Attributes'Access);
@@ -358,7 +363,7 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0);
end if;
- Result := pthread_mutex_init (L.WO'Access, Attributes'Access);
+ Result := pthread_mutex_init (L, Attributes'Access);
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = ENOMEM then
@@ -371,46 +376,20 @@ package body System.Task_Primitives.Operations is
end Initialize_Lock;
procedure Initialize_Lock
- (L : not null access RTS_Lock; Level : Lock_Level)
+ (Prio : System.Any_Priority;
+ L : not null access Lock)
is
- pragma Unreferenced (Level);
-
- Attributes : aliased pthread_mutexattr_t;
- Result : Interfaces.C.int;
-
begin
- Result := pthread_mutexattr_init (Attributes'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = ENOMEM then
- raise Storage_Error;
- end if;
-
- if Locking_Policy = 'C' then
- Result := pthread_mutexattr_setprotocol
- (Attributes'Access, PTHREAD_PRIO_PROTECT);
- pragma Assert (Result = 0);
-
- Result := pthread_mutexattr_setprioceiling
- (Attributes'Access, Interfaces.C.int (System.Any_Priority'Last));
- pragma Assert (Result = 0);
-
- elsif Locking_Policy = 'I' then
- Result := pthread_mutexattr_setprotocol
- (Attributes'Access, PTHREAD_PRIO_INHERIT);
- pragma Assert (Result = 0);
- end if;
-
- Result := pthread_mutex_init (L, Attributes'Access);
- pragma Assert (Result = 0 or else Result = ENOMEM);
-
- if Result = ENOMEM then
- Result := pthread_mutexattr_destroy (Attributes'Access);
- raise Storage_Error;
- end if;
+ Initialize_Lock (L.WO'Access, Prio);
+ end Initialize_Lock;
- Result := pthread_mutexattr_destroy (Attributes'Access);
- pragma Assert (Result = 0);
+ procedure Initialize_Lock
+ (L : not null access RTS_Lock;
+ Level : Lock_Level)
+ is
+ pragma Unreferenced (Level);
+ begin
+ Initialize_Lock (L, System.Any_Priority'Last);
end Initialize_Lock;
-------------------
--
2.43.2
