include/adainclude/rtems-barrier.adb

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 --  RTEMS / Body
0005 --
0006 --  DESCRIPTION:
0007 --
0008 --  This package provides the interface to the RTEMS API.
0009 --
0010 --
0011 --  DEPENDENCIES:
0012 --
0013 --
0014 --
0015 --  COPYRIGHT (c) 1997-2011.
0016 --  On-Line Applications Research Corporation (OAR).
0017 --
0018 --  Redistribution and use in source and binary forms, with or without
0019 --  modification, are permitted provided that the following conditions
0020 --  are met:
0021 --  1. Redistributions of source code must retain the above copyright
0022 --     notice, this list of conditions and the following disclaimer.
0023 --  2. Redistributions in binary form must reproduce the above copyright
0024 --     notice, this list of conditions and the following disclaimer in the
0025 --     documentation and/or other materials provided with the distribution.
0026 --
0027 --  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0028 --  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0029 --  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0030 --  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0031 --  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0032 --  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0033 --  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0034 --  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0035 --  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0036 --  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0037 --  POSSIBILITY OF SUCH DAMAGE.
0038 --
0039
0040 with Ada;
0041 with Ada.Unchecked_Conversion;
0042 with Interfaces;               use Interfaces;
0043 with Interfaces.C;             use Interfaces.C;
0044 with Interfaces.C.Strings;     use Interfaces.C.Strings;
0045
0046 package body RTEMS.Barrier is
0047
0048    --
0049    -- Barrier Manager
0050    --
0051
0052    procedure Create
0053      (Name            : in RTEMS.Name;
0054       Attribute_Set   : in RTEMS.Attribute;
0055       Maximum_Waiters : in RTEMS.Unsigned32;
0056       ID              : out RTEMS.ID;
0057       Result          : out RTEMS.Status_Codes)
0058    is
0059       function Create_Base
0060         (Name            : RTEMS.Name;
0061          Attribute_Set   : RTEMS.Attribute;
0062          Maximum_Waiters : RTEMS.Unsigned32;
0063          ID              : access RTEMS.ID)
0064          return            RTEMS.Status_Codes;
0065       pragma Import (C, Create_Base, "rtems_barrier_create");
0066       ID_Base : aliased RTEMS.ID;
0067    begin
0068
0069       Result :=
0070          Create_Base
0071            (Name,
0072             Attribute_Set,
0073             Maximum_Waiters,
0074             ID_Base'Access);
0075       ID     := ID_Base;
0076
0077    end Create;
0078
0079    procedure Ident
0080      (Name   : in RTEMS.Name;
0081       ID     : out RTEMS.ID;
0082       Result : out RTEMS.Status_Codes)
0083    is
0084       function Ident_Base
0085         (Name : RTEMS.Name;
0086          ID   : access RTEMS.ID)
0087          return RTEMS.Status_Codes;
0088       pragma Import (C, Ident_Base, "rtems_barrier_ident");
0089       ID_Base : aliased RTEMS.ID;
0090    begin
0091
0092       Result := Ident_Base (Name, ID_Base'Access);
0093       ID     := ID_Base;
0094
0095    end Ident;
0096
0097    procedure Delete
0098      (ID     : in RTEMS.ID;
0099       Result : out RTEMS.Status_Codes)
0100    is
0101       function Delete_Base
0102         (ID   : RTEMS.ID)
0103          return RTEMS.Status_Codes;
0104       pragma Import (C, Delete_Base, "rtems_barrier_delete");
0105    begin
0106
0107       Result := Delete_Base (ID);
0108
0109    end Delete;
0110
0111    procedure Wait
0112      (ID      : in RTEMS.ID;
0113       Timeout : in RTEMS.Interval;
0114       Result  : out RTEMS.Status_Codes)
0115    is
0116       function Wait_Base
0117         (ID      : RTEMS.ID;
0118          Timeout : RTEMS.Interval)
0119          return    RTEMS.Status_Codes;
0120       pragma Import (C, Wait_Base, "rtems_barrier_wait");
0121    begin
0122
0123       Result := Wait_Base (ID, Timeout);
0124
0125    end Wait;
0126
0127    procedure Release
0128      (ID       : in RTEMS.ID;
0129       Released : out RTEMS.Unsigned32;
0130       Result   : out RTEMS.Status_Codes)
0131    is
0132       function Release_Base
0133         (ID       : RTEMS.ID;
0134          Released : access RTEMS.Unsigned32)
0135          return     RTEMS.Status_Codes;
0136       pragma Import (C, Release_Base, "rtems_barrier_release");
0137       Released_Base : aliased RTEMS.Unsigned32;
0138    begin
0139
0140       Result   := Release_Base (ID, Released_Base'Access);
0141       Released := Released_Base;
0142
0143    end Release;
0144
0145 end RTEMS.Barrier;