include/adainclude/rtems.adb

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --  RTEMS / Body
0004 --
0005 --  DESCRIPTION:
0006 --
0007 --  This package provides the interface to the RTEMS API.
0008 --
0009 --
0010 --  DEPENDENCIES:
0011 --
0012 --
0013 --
0014 --  COPYRIGHT (c) 1997-2011.
0015 --  On-Line Applications Research Corporation (OAR).
0016 --
0017 --  Redistribution and use in source and binary forms, with or without
0018 --  modification, are permitted provided that the following conditions
0019 --  are met:
0020 --  1. Redistributions of source code must retain the above copyright
0021 --     notice, this list of conditions and the following disclaimer.
0022 --  2. Redistributions in binary form must reproduce the above copyright
0023 --     notice, this list of conditions and the following disclaimer in the
0024 --     documentation and/or other materials provided with the distribution.
0025 --
0026 --  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0027 --  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0028 --  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0029 --  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0030 --  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0031 --  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0032 --  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0033 --  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0034 --  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0035 --  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0036 --  POSSIBILITY OF SUCH DAMAGE.
0037 --
0038
0039 with Ada;
0040 with Ada.Unchecked_Conversion;
0041 with Interfaces;               use Interfaces;
0042 with Interfaces.C;             use Interfaces.C;
0043
0044 package body RTEMS is
0045
0046    --
0047    --  Utility Functions
0048    --
0049
0050    function From_Ada_Boolean
0051      (Ada_Boolean : Standard.Boolean)
0052       return        RTEMS.Boolean
0053    is
0054    begin
0055
0056       if Ada_Boolean then
0057          return RTEMS.True;
0058       end if;
0059
0060       return RTEMS.False;
0061
0062    end From_Ada_Boolean;
0063
0064    function To_Ada_Boolean
0065      (RTEMS_Boolean : RTEMS.Boolean)
0066       return          Standard.Boolean
0067    is
0068    begin
0069
0070       if RTEMS_Boolean = RTEMS.True then
0071          return Standard.True;
0072       end if;
0073
0074       return Standard.False;
0075
0076    end To_Ada_Boolean;
0077
0078    function Milliseconds_To_Microseconds
0079      (Milliseconds : RTEMS.Unsigned32)
0080       return         RTEMS.Unsigned32
0081    is
0082    begin
0083
0084       return Milliseconds * 1000;
0085
0086    end Milliseconds_To_Microseconds;
0087
0088    function Microseconds_To_Ticks
0089      (Microseconds : RTEMS.Unsigned32)
0090       return         RTEMS.Interval
0091    is
0092       function Microseconds_Per_Tick return  RTEMS.Unsigned32;
0093       pragma Import (C, Microseconds_Per_Tick, "_ada_microseconds_per_tick");
0094    begin
0095
0096       return Microseconds / Microseconds_Per_Tick;
0097
0098    end Microseconds_To_Ticks;
0099
0100    function Milliseconds_To_Ticks
0101      (Milliseconds : RTEMS.Unsigned32)
0102       return         RTEMS.Interval
0103    is
0104    begin
0105
0106       return Microseconds_To_Ticks
0107                (Milliseconds_To_Microseconds (Milliseconds));
0108
0109    end Milliseconds_To_Ticks;
0110
0111    procedure Name_To_Characters
0112      (Name : in RTEMS.Name;
0113       C1   : out Character;
0114       C2   : out Character;
0115       C3   : out Character;
0116       C4   : out Character)
0117    is
0118       C1_Value : RTEMS.Unsigned32;
0119       C2_Value : RTEMS.Unsigned32;
0120       C3_Value : RTEMS.Unsigned32;
0121       C4_Value : RTEMS.Unsigned32;
0122    begin
0123
0124       C1_Value := Interfaces.Shift_Right (Name, 24);
0125       C2_Value := Interfaces.Shift_Right (Name, 16);
0126       C3_Value := Interfaces.Shift_Right (Name, 8);
0127       C4_Value := Name;
0128
0129       C1_Value := C1_Value and 16#00FF#;
0130       C2_Value := C2_Value and 16#00FF#;
0131       C3_Value := C3_Value and 16#00FF#;
0132       C4_Value := C4_Value and 16#00FF#;
0133
0134       C1 := Character'Val (C1_Value);
0135       C2 := Character'Val (C2_Value);
0136       C3 := Character'Val (C3_Value);
0137       C4 := Character'Val (C4_Value);
0138
0139    end Name_To_Characters;
0140
0141    function Get_Node (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
0142    begin
0143
0144       -- May not be right
0145       return Interfaces.Shift_Right (ID, 16);
0146
0147    end Get_Node;
0148
0149    function Get_Index (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
0150    begin
0151
0152       -- May not be right
0153       return ID and 16#FFFF#;
0154
0155    end Get_Index;
0156
0157    function Are_Statuses_Equal
0158      (Status  : in RTEMS.Status_Codes;
0159       Desired : in RTEMS.Status_Codes)
0160       return    Standard.Boolean
0161    is
0162    begin
0163
0164       if Status = Desired then
0165          return Standard.True;
0166       end if;
0167
0168       return Standard.False;
0169
0170    end Are_Statuses_Equal;
0171
0172    function Is_Status_Successful
0173      (Status : in RTEMS.Status_Codes)
0174       return   Standard.Boolean
0175    is
0176    begin
0177
0178       if Status = RTEMS.Successful then
0179          return Standard.True;
0180       end if;
0181
0182       return Standard.False;
0183
0184    end Is_Status_Successful;
0185
0186    function Subtract
0187      (Left  : in RTEMS.Address;
0188       Right : in RTEMS.Address)
0189       return  RTEMS.Unsigned32
0190    is
0191       function To_Unsigned32 is new Ada.Unchecked_Conversion (
0192          System.Address,
0193          RTEMS.Unsigned32);
0194
0195    begin
0196       return To_Unsigned32 (Left) - To_Unsigned32 (Right);
0197    end Subtract;
0198
0199    function Are_Equal
0200      (Left  : in RTEMS.Address;
0201       Right : in RTEMS.Address)
0202       return  Standard.Boolean
0203    is
0204       function To_Unsigned32 is new Ada.Unchecked_Conversion (
0205          System.Address,
0206          RTEMS.Unsigned32);
0207
0208    begin
0209       return (To_Unsigned32 (Left) = To_Unsigned32 (Right));
0210    end Are_Equal;
0211
0212    --
0213    --
0214    --  RTEMS API
0215    --
0216
0217    function Build_Name (
0218       C1 : in     Character;
0219       C2 : in     Character;
0220       C3 : in     Character;
0221       C4 : in     Character
0222    ) return RTEMS.Name is
0223       C1_Value : RTEMS.Unsigned32;
0224       C2_Value : RTEMS.Unsigned32;
0225       C3_Value : RTEMS.Unsigned32;
0226       C4_Value : RTEMS.Unsigned32;
0227    begin
0228
0229      C1_Value := Character'Pos( C1 );
0230      C2_Value := Character'Pos( C2 );
0231      C3_Value := Character'Pos( C3 );
0232      C4_Value := Character'Pos( C4 );
0233
0234      return Interfaces.Shift_Left( C1_Value, 24 ) or
0235             Interfaces.Shift_Left( C2_Value, 16 ) or
0236             Interfaces.Shift_Left( C3_Value, 8 )  or
0237             C4_Value;
0238
0239    end Build_Name;
0240
0241    --
0242    --  Initialization Manager -- Shutdown Only
0243    --
0244    procedure Shutdown_Executive (Status : in RTEMS.Unsigned32) is
0245       procedure Shutdown_Executive_Base (Status : RTEMS.Unsigned32);
0246       pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
0247    begin
0248       Shutdown_Executive_Base (Status);
0249    end Shutdown_Executive;
0250
0251    function Minimum_Stack_Size return RTEMS.Size is
0252       size : RTEMS.Unsigned32;
0253       pragma Import (C, size, "rtems_minimum_stack_size");
0254    begin
0255       return RTEMS.Size (size);
0256    end Minimum_Stack_Size;
0257
0258 end RTEMS;