source: rtems/c/src/ada/rtems.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: 5.2 KB
Line 
1--  RTEMS / Body
2--
3--  DESCRIPTION:
4--
5--  This package provides the interface to the RTEMS API.
6--
7--
8--  DEPENDENCIES:
9--
10--
11--
12--  COPYRIGHT (c) 1997-2011.
13--  On-Line Applications Research Corporation (OAR).
14--
15--  The license and distribution terms for this file may in
16--  the file LICENSE in this distribution or at
17--  http://www.rtems.org/license/LICENSE.
18--
19
20with Ada;
21with Ada.Unchecked_Conversion;
22with Interfaces;               use Interfaces;
23with Interfaces.C;             use Interfaces.C;
24
25package body RTEMS is
26
27   --
28   --  Utility Functions
29   --
30
31   function From_Ada_Boolean
32     (Ada_Boolean : Standard.Boolean)
33      return        RTEMS.Boolean
34   is
35   begin
36
37      if Ada_Boolean then
38         return RTEMS.True;
39      end if;
40
41      return RTEMS.False;
42
43   end From_Ada_Boolean;
44
45   function To_Ada_Boolean
46     (RTEMS_Boolean : RTEMS.Boolean)
47      return          Standard.Boolean
48   is
49   begin
50
51      if RTEMS_Boolean = RTEMS.True then
52         return Standard.True;
53      end if;
54
55      return Standard.False;
56
57   end To_Ada_Boolean;
58
59   function Milliseconds_To_Microseconds
60     (Milliseconds : RTEMS.Unsigned32)
61      return         RTEMS.Unsigned32
62   is
63   begin
64
65      return Milliseconds * 1000;
66
67   end Milliseconds_To_Microseconds;
68
69   function Microseconds_To_Ticks
70     (Microseconds : RTEMS.Unsigned32)
71      return         RTEMS.Interval
72   is
73      function Microseconds_Per_Tick return  RTEMS.Unsigned32;
74      pragma Import (C, Microseconds_Per_Tick, "_ada_microseconds_per_tick");
75   begin
76
77      return Microseconds / Microseconds_Per_Tick;
78
79   end Microseconds_To_Ticks;
80
81   function Milliseconds_To_Ticks
82     (Milliseconds : RTEMS.Unsigned32)
83      return         RTEMS.Interval
84   is
85   begin
86
87      return Microseconds_To_Ticks
88               (Milliseconds_To_Microseconds (Milliseconds));
89
90   end Milliseconds_To_Ticks;
91
92   procedure Name_To_Characters
93     (Name : in RTEMS.Name;
94      C1   : out Character;
95      C2   : out Character;
96      C3   : out Character;
97      C4   : out Character)
98   is
99      C1_Value : RTEMS.Unsigned32;
100      C2_Value : RTEMS.Unsigned32;
101      C3_Value : RTEMS.Unsigned32;
102      C4_Value : RTEMS.Unsigned32;
103   begin
104
105      C1_Value := Interfaces.Shift_Right (Name, 24);
106      C2_Value := Interfaces.Shift_Right (Name, 16);
107      C3_Value := Interfaces.Shift_Right (Name, 8);
108      C4_Value := Name;
109
110      C1_Value := C1_Value and 16#00FF#;
111      C2_Value := C2_Value and 16#00FF#;
112      C3_Value := C3_Value and 16#00FF#;
113      C4_Value := C4_Value and 16#00FF#;
114
115      C1 := Character'Val (C1_Value);
116      C2 := Character'Val (C2_Value);
117      C3 := Character'Val (C3_Value);
118      C4 := Character'Val (C4_Value);
119
120   end Name_To_Characters;
121
122   function Get_Node (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
123   begin
124
125      -- May not be right
126      return Interfaces.Shift_Right (ID, 16);
127
128   end Get_Node;
129
130   function Get_Index (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
131   begin
132
133      -- May not be right
134      return ID and 16#FFFF#;
135
136   end Get_Index;
137
138   function Are_Statuses_Equal
139     (Status  : in RTEMS.Status_Codes;
140      Desired : in RTEMS.Status_Codes)
141      return    Standard.Boolean
142   is
143   begin
144
145      if Status = Desired then
146         return Standard.True;
147      end if;
148
149      return Standard.False;
150
151   end Are_Statuses_Equal;
152
153   function Is_Status_Successful
154     (Status : in RTEMS.Status_Codes)
155      return   Standard.Boolean
156   is
157   begin
158
159      if Status = RTEMS.Successful then
160         return Standard.True;
161      end if;
162
163      return Standard.False;
164
165   end Is_Status_Successful;
166
167   function Subtract
168     (Left  : in RTEMS.Address;
169      Right : in RTEMS.Address)
170      return  RTEMS.Unsigned32
171   is
172      function To_Unsigned32 is new Ada.Unchecked_Conversion (
173         System.Address,
174         RTEMS.Unsigned32);
175
176   begin
177      return To_Unsigned32 (Left) - To_Unsigned32 (Right);
178   end Subtract;
179
180   function Are_Equal
181     (Left  : in RTEMS.Address;
182      Right : in RTEMS.Address)
183      return  Standard.Boolean
184   is
185      function To_Unsigned32 is new Ada.Unchecked_Conversion (
186         System.Address,
187         RTEMS.Unsigned32);
188
189   begin
190      return (To_Unsigned32 (Left) = To_Unsigned32 (Right));
191   end Are_Equal;
192
193   --
194   --
195   --  RTEMS API
196   --
197
198   function Build_Name (
199      C1 : in     Character;
200      C2 : in     Character;
201      C3 : in     Character;
202      C4 : in     Character
203   ) return RTEMS.Name is
204      C1_Value : RTEMS.Unsigned32;
205      C2_Value : RTEMS.Unsigned32;
206      C3_Value : RTEMS.Unsigned32;
207      C4_Value : RTEMS.Unsigned32;
208   begin
209
210     C1_Value := Character'Pos( C1 );
211     C2_Value := Character'Pos( C2 );
212     C3_Value := Character'Pos( C3 );
213     C4_Value := Character'Pos( C4 );
214
215     return Interfaces.Shift_Left( C1_Value, 24 ) or
216            Interfaces.Shift_Left( C2_Value, 16 ) or
217            Interfaces.Shift_Left( C3_Value, 8 )  or
218            C4_Value;
219
220   end Build_Name;
221
222   --
223   --  Initialization Manager -- Shutdown Only
224   --
225   procedure Shutdown_Executive (Status : in RTEMS.Unsigned32) is
226      procedure Shutdown_Executive_Base (Status : RTEMS.Unsigned32);
227      pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
228   begin
229      Shutdown_Executive_Base (Status);
230   end Shutdown_Executive;
231
232end RTEMS;
Note: See TracBrowser for help on using the repository browser.