From patchwork Fri May 17 08:31:58 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 1936346 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=f+gk7eg3; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4VggV70t4vz1ydW for ; Fri, 17 May 2024 18:43:43 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 49E093858415 for ; Fri, 17 May 2024 08:43:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x236.google.com (mail-lj1-x236.google.com [IPv6:2a00:1450:4864:20::236]) by sourceware.org (Postfix) with ESMTPS id D2087384AB44 for ; Fri, 17 May 2024 08:32:41 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org D2087384AB44 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org D2087384AB44 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::236 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715934788; cv=none; b=hI7pV0YiIToWVd+co1LkegZ2N3qrJWmkOLDAuPs7YZmwe4/Xw+awzG6v/MedNzMUehXoF77WobGQs4I1bvEhImlO00B4Tu+eHg7RE+Ip0QwEzp/PflOyH7Xi90eJHcpvanjO+xpghGxp27wDnjwUFxHVv5WoauXukNzmwtEEPmk= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1715934788; c=relaxed/simple; bh=g16jTb0PZdMKnYvC/CYaHgxA6aND1La94LEjmok/ANY=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=p5zEouaViU7hbauSwvtucIomIzXnJ/O9zV1FWeizekuCIsSQjW5DsLBz9fznXAg6p3CEDJSsJwexlg108+yWUgOhSbN/zgxVhYx7nlQT9PeRiui70+uVV5YkkUXHzOj6hzeApAMrd7/3s3LbHzLScNQSHeyOJ4EzLv55IIHCZaY= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x236.google.com with SMTP id 38308e7fff4ca-2e27277d2c1so22911841fa.2 for ; Fri, 17 May 2024 01:32:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1715934760; x=1716539560; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=sh5ZzC1Rp8QzPOt7bizoPyXoNhPm15W/U7aV6Xovwm8=; b=f+gk7eg3IBJ4F37MSfwbnTzYXYfEBbufcZ/VwzsMzXoIsc3LNHw0nqL0g2AkY9sAN+ e0mm4Es6iYmA+0vkW4yfRQH89DWDfCQhuCpQbEWOPUv4zLcsALa+3DRLwg0W8YoBcyHC 5agiQ5dAimT5BTxgTlk523BVUj4Us3BznSn+QaQWUXxZt8pAPJqbu74OS5tTvLI7A57n VVLg9QWqLZhKnY9YTQx953/jW2ZnY/kzuQOFfLXfzNNP22RqYCN733vCdWftew1md/8F gimmIr8N0XeuY8rUcYhzy/gs6GRmF+tsxa/CtZUqAoTqVerXvep4ohfEtTnFTaFK1zMT C7Hw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1715934760; x=1716539560; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=sh5ZzC1Rp8QzPOt7bizoPyXoNhPm15W/U7aV6Xovwm8=; b=ZREDQTd/MqunbGzIqYfT/PG+j+rNwbAW/0mZ79w4ZIVkotDZTMxyeVPnz1cTfnvCNG FjOVYtsiBLGfYIXM13FJOsPhpUyTkWJee6/sHngBCWS7+LUvpXkCyOBGDwGj9/fUxXcp NP7/Fo9FVeFwbys8H7Nj6V1FlvPs5/ETMgZEEQV2bx0L9O7wo/Vcx2khToPwVU5mKOpC MzScDxZ53Ryjbbj1yL+1UpSDEPbpcic36e05HGF0v0B/DL2JmKAsN4y18sYFIOsAbzZp iwFvIuVc5xI9jU8sGZ0PiuEt12aNO4s2gZea5RCPHldq+UIOBnIYD998ZrexgrWaonq6 IBMw== X-Gm-Message-State: AOJu0Yw7FcSKMN+7ntA0Cr7DgA98gNxq/bRpdB8pO3pSZfZzUqPyfip0 z0qC65mt3TvFpWshD09oxqA+CFglLCNzcvnjCsXAM0KBxPrD9zFbFrYSuiQ2cKyjCNIT8YE7pWo = X-Google-Smtp-Source: AGHT+IGWU3shdA7VEqUeLuDqm/jTgQ4yrbwGQ/JoCipJASu3ndPgwN1S58YuXGe1i4SqcWeXU13YJw== X-Received: by 2002:a2e:a7d5:0:b0:2e1:5684:8fa3 with SMTP id 38308e7fff4ca-2e51ff5ce98mr166777771fa.22.1715934760229; Fri, 17 May 2024 01:32:40 -0700 (PDT) Received: from poulhies-Precision-5550.lan ([2001:861:3382:1a90:de37:8b1c:1f33:2610]) by smtp.gmail.com with ESMTPSA id 5b1f17b1804b1-420273cff03sm75197045e9.26.2024.05.17.01.32.39 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 17 May 2024 01:32:39 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED 26/35] ada: Factor out duplicated code in bodies of System.Task_Primitives.Operations Date: Fri, 17 May 2024 10:31:58 +0200 Message-ID: <20240517083207.130391-26-poulhies@adacore.com> X-Mailer: git-send-email 2.43.2 In-Reply-To: <20240517083207.130391-1-poulhies@adacore.com> References: <20240517083207.130391-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org From: Eric Botcazou 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; -------------------