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.

diff --git a/gcc/ada/libgnarl/s-taprop__dummy.adb b/gcc/ada/libgnarl/s-taprop__dummy.adb
index 90c4cd4cf72f71724c60c28603c412d7d06fb348..829d595694c39d31b8d4f6e1739349369a9deaa9 100644 (file)
--- 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 d6a29b5e1581e55cce0551f24ec6ed2052b50845..74717cb2d2b1ec10e8e9a05e75ac94cf0b7677d3 100644 (file)
--- 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 79694129227ccd980b6dfeb289098911e6084f35..a71e42112ac5785362fc35b091f50197cbf0e8d1 100644 (file)
--- 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 8b98af7284e3dab0f4feb7c8970fac6e9e12ec4c..2f11d2821fb59bb4deefc5239ae74d40c8ec2f82 100644 (file)
--- 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 68a956e5c06a2580a778c3df35d4c85837946a94..b041592cbe098511fa013231825848779a30a31f 100644 (file)
--- 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;
 
    -------------------