source: rtems/c/src/ada/rtems-message_queue.adb @ 32c8960

4.115
Last change on this file since 32c8960 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: 5.8 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.Message_Queue is
22
23   --
24   -- Message Queue Manager
25   --
26
27   procedure Create
28     (Name             : in RTEMS.Name;
29      Count            : in RTEMS.Unsigned32;
30      Max_Message_Size : in RTEMS.Unsigned32;
31      Attribute_Set    : in RTEMS.Attribute;
32      ID               : out RTEMS.ID;
33      Result           : out RTEMS.Status_Codes)
34   is
35      --  XXX broken
36      function Create_Base
37        (Name             : RTEMS.Name;
38         Count            : RTEMS.Unsigned32;
39         Max_Message_Size : RTEMS.Unsigned32;
40         Attribute_Set    : RTEMS.Attribute;
41         ID               : access RTEMS.ID)
42         return             RTEMS.Status_Codes;
43      pragma Import
44        (C,
45         Create_Base,
46         "rtems_message_queue_create");
47      ID_Base : aliased RTEMS.ID;
48   begin
49
50      Result :=
51         Create_Base
52           (Name,
53            Count,
54            Max_Message_Size,
55            Attribute_Set,
56            ID_Base'Access);
57      ID     := ID_Base;
58
59   end Create;
60
61   procedure Ident
62     (Name   : in RTEMS.Name;
63      Node   : in RTEMS.Unsigned32;
64      ID     : out RTEMS.ID;
65      Result : out RTEMS.Status_Codes)
66   is
67      function Ident_Base
68        (Name : RTEMS.Name;
69         Node : RTEMS.Unsigned32;
70         ID   : access RTEMS.ID)
71         return RTEMS.Status_Codes;
72      pragma Import
73        (C,
74         Ident_Base,
75         "rtems_message_queue_ident");
76      ID_Base : aliased RTEMS.ID;
77   begin
78
79      Result := Ident_Base (Name, Node, ID_Base'Access);
80      ID     := ID_Base;
81
82   end Ident;
83
84   procedure Delete
85     (ID     : in RTEMS.ID;
86      Result : out RTEMS.Status_Codes)
87   is
88      function Delete_Base
89        (ID   : RTEMS.ID)
90         return RTEMS.Status_Codes;
91      pragma Import
92        (C,
93         Delete_Base,
94         "rtems_message_queue_delete");
95   begin
96
97      Result := Delete_Base (ID);
98
99   end Delete;
100
101   procedure Send
102     (ID     : in RTEMS.ID;
103      Buffer : in RTEMS.Address;
104      Size   : in RTEMS.Unsigned32;
105      Result : out RTEMS.Status_Codes)
106   is
107      function Send_Base
108        (ID     : RTEMS.ID;
109         Buffer : RTEMS.Address;
110         Size   : RTEMS.Unsigned32)
111         return   RTEMS.Status_Codes;
112      pragma Import (C, Send_Base, "rtems_message_queue_send");
113   begin
114
115      Result := Send_Base (ID, Buffer, Size);
116
117   end Send;
118
119   procedure Urgent
120     (ID     : in RTEMS.ID;
121      Buffer : in RTEMS.Address;
122      Size   : in RTEMS.Unsigned32;
123      Result : out RTEMS.Status_Codes)
124   is
125      function Urgent_Base
126        (ID     : RTEMS.ID;
127         Buffer : RTEMS.Address;
128         Size   : RTEMS.Unsigned32)
129         return   RTEMS.Status_Codes;
130      pragma Import
131        (C,
132         Urgent_Base,
133         "rtems_message_queue_urgent");
134   begin
135
136      Result := Urgent_Base (ID, Buffer, Size);
137
138   end Urgent;
139
140   procedure Broadcast
141     (ID     : in RTEMS.ID;
142      Buffer : in RTEMS.Address;
143      Size   : in RTEMS.Unsigned32;
144      Count  : out RTEMS.Unsigned32;
145      Result : out RTEMS.Status_Codes)
146   is
147      function Broadcast_Base
148        (ID     : RTEMS.ID;
149         Buffer : RTEMS.Address;
150         Size   : RTEMS.Unsigned32;
151         Count  : access RTEMS.Unsigned32)
152         return   RTEMS.Status_Codes;
153      pragma Import
154        (C,
155         Broadcast_Base,
156         "rtems_message_queue_broadcast");
157      Count_Base : aliased RTEMS.Unsigned32;
158   begin
159
160      Result :=
161         Broadcast_Base (ID, Buffer, Size, Count_Base'Access);
162      Count  := Count_Base;
163
164   end Broadcast;
165
166   procedure Receive
167     (ID         : in RTEMS.ID;
168      Buffer     : in RTEMS.Address;
169      Option_Set : in RTEMS.Option;
170      Timeout    : in RTEMS.Interval;
171      Size       : in out RTEMS.Unsigned32;
172      Result     : out RTEMS.Status_Codes)
173   is
174      function Receive_Base
175        (ID         : RTEMS.ID;
176         Buffer     : RTEMS.Address;
177         Size       : access RTEMS.Unsigned32;
178         Option_Set : RTEMS.Option;
179         Timeout    : RTEMS.Interval)
180         return       RTEMS.Status_Codes;
181      pragma Import
182        (C,
183         Receive_Base,
184         "rtems_message_queue_receive");
185      Size_Base : aliased RTEMS.Unsigned32;
186   begin
187
188      Size_Base := Size;
189
190      Result :=
191         Receive_Base
192           (ID,
193            Buffer,
194            Size_Base'Access,
195            Option_Set,
196            Timeout);
197      Size   := Size_Base;
198
199   end Receive;
200
201   procedure Get_Number_Pending
202     (ID     : in RTEMS.ID;
203      Count  : out RTEMS.Unsigned32;
204      Result : out RTEMS.Status_Codes)
205   is
206      function Get_Number_Pending_Base
207        (ID    : RTEMS.ID;
208         Count : access RTEMS.Unsigned32)
209         return  RTEMS.Status_Codes;
210      pragma Import
211        (C,
212         Get_Number_Pending_Base,
213         "rtems_message_queue_get_number_pending");
214      Count_Base : aliased RTEMS.Unsigned32;
215   begin
216
217      Result := Get_Number_Pending_Base (ID, Count_Base'Access);
218      Count  := Count_Base;
219
220   end Get_Number_Pending;
221
222   procedure Flush
223     (ID     : in RTEMS.ID;
224      Count  : out RTEMS.Unsigned32;
225      Result : out RTEMS.Status_Codes)
226   is
227      function Flush_Base
228        (ID    : RTEMS.ID;
229         Count : access RTEMS.Unsigned32)
230         return  RTEMS.Status_Codes;
231      pragma Import
232        (C,
233         Flush_Base,
234         "rtems_message_queue_flush");
235      Count_Base : aliased RTEMS.Unsigned32;
236   begin
237
238      Result := Flush_Base (ID, Count_Base'Access);
239      Count  := Count_Base;
240
241   end Flush;
242
243end RTEMS.Message_Queue;
Note: See TracBrowser for help on using the repository browser.