source: rtems/c/src/ada/rtems-barrier.adb @ c499856

4.115
Last change on this file since c499856 was c499856, checked in by Chris Johns <chrisj@…>, on Mar 20, 2014 at 9:10:47 PM

Change all references of rtems.com to rtems.org.

  • Property mode set to 100644
File size: 3.0 KB
Line 
1--
2--  RTEMS / Body
3--
4--  DESCRIPTION:
5--
6--  This package provides the interface to the RTEMS API.
7--
8--
9--  DEPENDENCIES:
10--
11--
12--
13--  COPYRIGHT (c) 1997-2011.
14--  On-Line Applications Research Corporation (OAR).
15--
16--  The license and distribution terms for this file may in
17--  the file LICENSE in this distribution or at
18--  http://www.rtems.org/license/LICENSE.
19--
20
21with Ada;
22with Ada.Unchecked_Conversion;
23with Interfaces;               use Interfaces;
24with Interfaces.C;             use Interfaces.C;
25with Interfaces.C.Strings;     use Interfaces.C.Strings;
26
27package body RTEMS.Barrier is
28
29   --
30   -- Barrier Manager
31   --
32
33   procedure Create
34     (Name            : in RTEMS.Name;
35      Attribute_Set   : in RTEMS.Attribute;
36      Maximum_Waiters : in RTEMS.Unsigned32;
37      ID              : out RTEMS.ID;
38      Result          : out RTEMS.Status_Codes)
39   is
40      function Create_Base
41        (Name            : RTEMS.Name;
42         Attribute_Set   : RTEMS.Attribute;
43         Maximum_Waiters : RTEMS.Unsigned32;
44         ID              : access RTEMS.ID)
45         return            RTEMS.Status_Codes;
46      pragma Import (C, Create_Base, "rtems_barrier_create");
47      ID_Base : aliased RTEMS.ID;
48   begin
49
50      Result :=
51         Create_Base
52           (Name,
53            Attribute_Set,
54            Maximum_Waiters,
55            ID_Base'Access);
56      ID     := ID_Base;
57
58   end Create;
59
60   procedure Ident
61     (Name   : in RTEMS.Name;
62      ID     : out RTEMS.ID;
63      Result : out RTEMS.Status_Codes)
64   is
65      function Ident_Base
66        (Name : RTEMS.Name;
67         ID   : access RTEMS.ID)
68         return RTEMS.Status_Codes;
69      pragma Import (C, Ident_Base, "rtems_barrier_ident");
70      ID_Base : aliased RTEMS.ID;
71   begin
72
73      Result := Ident_Base (Name, ID_Base'Access);
74      ID     := ID_Base;
75
76   end Ident;
77
78   procedure Delete
79     (ID     : in RTEMS.ID;
80      Result : out RTEMS.Status_Codes)
81   is
82      function Delete_Base
83        (ID   : RTEMS.ID)
84         return RTEMS.Status_Codes;
85      pragma Import (C, Delete_Base, "rtems_barrier_delete");
86   begin
87
88      Result := Delete_Base (ID);
89
90   end Delete;
91
92   procedure Wait
93     (ID      : in RTEMS.ID;
94      Timeout : in RTEMS.Interval;
95      Result  : out RTEMS.Status_Codes)
96   is
97      function Wait_Base
98        (ID      : RTEMS.ID;
99         Timeout : RTEMS.Interval)
100         return    RTEMS.Status_Codes;
101      pragma Import (C, Wait_Base, "rtems_barrier_wait");
102   begin
103
104      Result := Wait_Base (ID, Timeout);
105
106   end Wait;
107
108   procedure Release
109     (ID       : in RTEMS.ID;
110      Released : out RTEMS.Unsigned32;
111      Result   : out RTEMS.Status_Codes)
112   is
113      function Release_Base
114        (ID       : RTEMS.ID;
115         Released : access RTEMS.Unsigned32)
116         return     RTEMS.Status_Codes;
117      pragma Import (C, Release_Base, "rtems_barrier_release");
118      Released_Base : aliased RTEMS.Unsigned32;
119   begin
120
121      Result   := Release_Base (ID, Released_Base'Access);
122      Released := Released_Base;
123
124   end Release;
125
126end RTEMS.Barrier;
Note: See TracBrowser for help on using the repository browser.