Warning, /cpukit/include/adainclude/rtems-message_queue.adb is written in an unsupported language. File is not indexed.
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 package body RTEMS.Message_Queue is
0041
0042 --
0043 -- Message Queue Manager
0044 --
0045
0046 procedure Create
0047 (Name : in RTEMS.Name;
0048 Count : in RTEMS.Unsigned32;
0049 Max_Message_Size : in RTEMS.Size;
0050 Attribute_Set : in RTEMS.Attribute;
0051 ID : out RTEMS.ID;
0052 Result : out RTEMS.Status_Codes)
0053 is
0054 -- XXX broken
0055 function Create_Base
0056 (Name : RTEMS.Name;
0057 Count : RTEMS.Unsigned32;
0058 Max_Message_Size : RTEMS.Size;
0059 Attribute_Set : RTEMS.Attribute;
0060 ID : access RTEMS.ID)
0061 return RTEMS.Status_Codes;
0062 pragma Import
0063 (C,
0064 Create_Base,
0065 "rtems_message_queue_create");
0066 ID_Base : aliased RTEMS.ID;
0067 begin
0068
0069 Result :=
0070 Create_Base
0071 (Name,
0072 Count,
0073 Max_Message_Size,
0074 Attribute_Set,
0075 ID_Base'Access);
0076 ID := ID_Base;
0077
0078 end Create;
0079
0080 procedure Ident
0081 (Name : in RTEMS.Name;
0082 Node : in RTEMS.Unsigned32;
0083 ID : out RTEMS.ID;
0084 Result : out RTEMS.Status_Codes)
0085 is
0086 function Ident_Base
0087 (Name : RTEMS.Name;
0088 Node : RTEMS.Unsigned32;
0089 ID : access RTEMS.ID)
0090 return RTEMS.Status_Codes;
0091 pragma Import
0092 (C,
0093 Ident_Base,
0094 "rtems_message_queue_ident");
0095 ID_Base : aliased RTEMS.ID;
0096 begin
0097
0098 Result := Ident_Base (Name, Node, ID_Base'Access);
0099 ID := ID_Base;
0100
0101 end Ident;
0102
0103 procedure Delete
0104 (ID : in RTEMS.ID;
0105 Result : out RTEMS.Status_Codes)
0106 is
0107 function Delete_Base
0108 (ID : RTEMS.ID)
0109 return RTEMS.Status_Codes;
0110 pragma Import
0111 (C,
0112 Delete_Base,
0113 "rtems_message_queue_delete");
0114 begin
0115
0116 Result := Delete_Base (ID);
0117
0118 end Delete;
0119
0120 procedure Send
0121 (ID : in RTEMS.ID;
0122 Buffer : in RTEMS.Address;
0123 Size : in RTEMS.Size;
0124 Result : out RTEMS.Status_Codes)
0125 is
0126 function Send_Base
0127 (ID : RTEMS.ID;
0128 Buffer : RTEMS.Address;
0129 Size : RTEMS.Size)
0130 return RTEMS.Status_Codes;
0131 pragma Import (C, Send_Base, "rtems_message_queue_send");
0132 begin
0133
0134 Result := Send_Base (ID, Buffer, Size);
0135
0136 end Send;
0137
0138 procedure Urgent
0139 (ID : in RTEMS.ID;
0140 Buffer : in RTEMS.Address;
0141 Size : in RTEMS.Size;
0142 Result : out RTEMS.Status_Codes)
0143 is
0144 function Urgent_Base
0145 (ID : RTEMS.ID;
0146 Buffer : RTEMS.Address;
0147 Size : RTEMS.Size)
0148 return RTEMS.Status_Codes;
0149 pragma Import
0150 (C,
0151 Urgent_Base,
0152 "rtems_message_queue_urgent");
0153 begin
0154
0155 Result := Urgent_Base (ID, Buffer, Size);
0156
0157 end Urgent;
0158
0159 procedure Broadcast
0160 (ID : in RTEMS.ID;
0161 Buffer : in RTEMS.Address;
0162 Size : in RTEMS.Size;
0163 Count : out RTEMS.Unsigned32;
0164 Result : out RTEMS.Status_Codes)
0165 is
0166 function Broadcast_Base
0167 (ID : RTEMS.ID;
0168 Buffer : RTEMS.Address;
0169 Size : RTEMS.Size;
0170 Count : access RTEMS.Unsigned32)
0171 return RTEMS.Status_Codes;
0172 pragma Import
0173 (C,
0174 Broadcast_Base,
0175 "rtems_message_queue_broadcast");
0176 Count_Base : aliased RTEMS.Unsigned32;
0177 begin
0178
0179 Result :=
0180 Broadcast_Base (ID, Buffer, Size, Count_Base'Access);
0181 Count := Count_Base;
0182
0183 end Broadcast;
0184
0185 procedure Receive
0186 (ID : in RTEMS.ID;
0187 Buffer : in RTEMS.Address;
0188 Option_Set : in RTEMS.Option;
0189 Timeout : in RTEMS.Interval;
0190 Size : in out RTEMS.Size;
0191 Result : out RTEMS.Status_Codes)
0192 is
0193 function Receive_Base
0194 (ID : RTEMS.ID;
0195 Buffer : RTEMS.Address;
0196 Size : access RTEMS.Size;
0197 Option_Set : RTEMS.Option;
0198 Timeout : RTEMS.Interval)
0199 return RTEMS.Status_Codes;
0200 pragma Import
0201 (C,
0202 Receive_Base,
0203 "rtems_message_queue_receive");
0204 Size_Base : aliased RTEMS.Size;
0205 begin
0206
0207 Size_Base := Size;
0208
0209 Result :=
0210 Receive_Base
0211 (ID,
0212 Buffer,
0213 Size_Base'Access,
0214 Option_Set,
0215 Timeout);
0216 Size := Size_Base;
0217
0218 end Receive;
0219
0220 procedure Get_Number_Pending
0221 (ID : in RTEMS.ID;
0222 Count : out RTEMS.Unsigned32;
0223 Result : out RTEMS.Status_Codes)
0224 is
0225 function Get_Number_Pending_Base
0226 (ID : RTEMS.ID;
0227 Count : access RTEMS.Unsigned32)
0228 return RTEMS.Status_Codes;
0229 pragma Import
0230 (C,
0231 Get_Number_Pending_Base,
0232 "rtems_message_queue_get_number_pending");
0233 Count_Base : aliased RTEMS.Unsigned32;
0234 begin
0235
0236 Result := Get_Number_Pending_Base (ID, Count_Base'Access);
0237 Count := Count_Base;
0238
0239 end Get_Number_Pending;
0240
0241 procedure Flush
0242 (ID : in RTEMS.ID;
0243 Count : out RTEMS.Unsigned32;
0244 Result : out RTEMS.Status_Codes)
0245 is
0246 function Flush_Base
0247 (ID : RTEMS.ID;
0248 Count : access RTEMS.Unsigned32)
0249 return RTEMS.Status_Codes;
0250 pragma Import
0251 (C,
0252 Flush_Base,
0253 "rtems_message_queue_flush");
0254 Count_Base : aliased RTEMS.Unsigned32;
0255 begin
0256
0257 Result := Flush_Base (ID, Count_Base'Access);
0258 Count := Count_Base;
0259
0260 end Flush;
0261
0262 end RTEMS.Message_Queue;
