source: rtems/c/src/ada/rtems-semaphore.adb @ a36094f

4.115
Last change on this file since a36094f was c499856, checked in by Chris Johns <chrisj@…>, on 03/20/14 at 21:10:47

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

  • Property mode set to 100644
File size: 3.2 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
21package body RTEMS.Semaphore is
22
23   --
24   -- Semaphore Manager
25   --
26
27   procedure Create
28     (Name             : in RTEMS.Name;
29      Count            : in RTEMS.Unsigned32;
30      Attribute_Set    : in RTEMS.Attribute;
31      Priority_Ceiling : in RTEMS.Tasks.Priority;
32      ID               : out RTEMS.ID;
33      Result           : out RTEMS.Status_Codes)
34   is
35      function Create_Base
36        (Name             : RTEMS.Name;
37         Count            : RTEMS.Unsigned32;
38         Attribute_Set    : RTEMS.Attribute;
39         Priority_Ceiling : RTEMS.Tasks.Priority;
40         ID               : access RTEMS.ID)
41         return             RTEMS.Status_Codes;
42      pragma Import (C, Create_Base, "rtems_semaphore_create");
43      ID_Base : aliased RTEMS.ID;
44   begin
45
46      Result :=
47         Create_Base
48           (Name,
49            Count,
50            Attribute_Set,
51            Priority_Ceiling,
52            ID_Base'Access);
53      ID     := ID_Base;
54
55   end Create;
56
57   procedure Delete
58     (ID     : in RTEMS.ID;
59      Result : out RTEMS.Status_Codes)
60   is
61      function Delete_Base
62        (ID   : RTEMS.ID)
63         return RTEMS.Status_Codes;
64      pragma Import (C, Delete_Base, "rtems_semaphore_delete");
65   begin
66
67      Result := Delete_Base (ID);
68
69   end Delete;
70
71   procedure Ident
72     (Name   : in RTEMS.Name;
73      Node   : in RTEMS.Unsigned32;
74      ID     : out RTEMS.ID;
75      Result : out RTEMS.Status_Codes)
76   is
77      function Ident_Base
78        (Name : RTEMS.Name;
79         Node : RTEMS.Unsigned32;
80         ID   : access RTEMS.ID)
81         return RTEMS.Status_Codes;
82      pragma Import (C, Ident_Base, "rtems_semaphore_ident");
83      ID_Base : aliased RTEMS.ID;
84   begin
85
86      Result := Ident_Base (Name, Node, ID_Base'Access);
87      ID     := ID_Base;
88
89   end Ident;
90
91   procedure Obtain
92     (ID         : in RTEMS.ID;
93      Option_Set : in RTEMS.Option;
94      Timeout    : in RTEMS.Interval;
95      Result     : out RTEMS.Status_Codes)
96   is
97      function Obtain_Base
98        (ID         : RTEMS.ID;
99         Option_Set : RTEMS.Option;
100         Timeout    : RTEMS.Interval)
101         return       RTEMS.Status_Codes;
102      pragma Import (C, Obtain_Base, "rtems_semaphore_obtain");
103   begin
104
105      Result := Obtain_Base (ID, Option_Set, Timeout);
106
107   end Obtain;
108
109   procedure Release
110     (ID     : in RTEMS.ID;
111      Result : out RTEMS.Status_Codes)
112   is
113      function Release_Base
114        (ID   : RTEMS.ID)
115         return RTEMS.Status_Codes;
116      pragma Import (C, Release_Base, "rtems_semaphore_release");
117   begin
118
119      Result := Release_Base (ID);
120
121   end Release;
122
123   procedure Flush
124     (ID     : in RTEMS.ID;
125      Result : out RTEMS.Status_Codes)
126   is
127      function Flush_Base
128        (ID   : RTEMS.ID)
129         return RTEMS.Status_Codes;
130      pragma Import (C, Flush_Base, "rtems_semaphore_flush");
131   begin
132
133      Result := Flush_Base (ID);
134
135   end Flush;
136
137end RTEMS.Semaphore;
Note: See TracBrowser for help on using the repository browser.