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

4.115
Last change on this file since 1987020 was 1987020, checked in by Joel Sherrill <joel.sherrill@…>, on Feb 16, 2011 at 3:52:29 PM

2011-02-16 Joel Sherrill <joel.sherrill@…>

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