rtems/c/src/ada/rtems.adb

--  RTEMS / Body
--
--  DESCRIPTION:
--
--  This package provides the interface to the RTEMS API.
--
--
--  DEPENDENCIES:
--
--
--
--  COPYRIGHT (c) 1997-2011.
--  On-Line Applications Research Corporation (OAR).
--
--  The license and distribution terms for this file may in
--  the file LICENSE in this distribution or at
--  http://www.rtems.com/license/LICENSE.
--
--  $Id$
--

with Ada;
with Ada.Unchecked_Conversion;
with Interfaces;               use Interfaces;
with Interfaces.C;             use Interfaces.C;

package body RTEMS is

   --
   --  Utility Functions
   --

   function From_Ada_Boolean
     (Ada_Boolean : Standard.Boolean)
      return        RTEMS.Boolean
   is
   begin

      if Ada_Boolean then
         return RTEMS.True;
      end if;

      return RTEMS.False;

   end From_Ada_Boolean;

   function To_Ada_Boolean
     (RTEMS_Boolean : RTEMS.Boolean)
      return          Standard.Boolean
   is
   begin

      if RTEMS_Boolean = RTEMS.True then
         return Standard.True;
      end if;

      return Standard.False;

   end To_Ada_Boolean;

   function Milliseconds_To_Microseconds
     (Milliseconds : RTEMS.Unsigned32)
      return         RTEMS.Unsigned32
   is
   begin

      return Milliseconds * 1000;

   end Milliseconds_To_Microseconds;

   function Microseconds_To_Ticks
     (Microseconds : RTEMS.Unsigned32)
      return         RTEMS.Interval
   is
      function Microseconds_Per_Tick return  RTEMS.Unsigned32;
      pragma Import (C, Microseconds_Per_Tick, "_ada_microseconds_per_tick");
   begin

      return Microseconds / Microseconds_Per_Tick;

   end Microseconds_To_Ticks;

   function Milliseconds_To_Ticks
     (Milliseconds : RTEMS.Unsigned32)
      return         RTEMS.Interval
   is
   begin

      return Microseconds_To_Ticks
               (Milliseconds_To_Microseconds (Milliseconds));

   end Milliseconds_To_Ticks;

   procedure Name_To_Characters
     (Name : in RTEMS.Name;
      C1   : out Character;
      C2   : out Character;
      C3   : out Character;
      C4   : out Character)
   is
      C1_Value : RTEMS.Unsigned32;
      C2_Value : RTEMS.Unsigned32;
      C3_Value : RTEMS.Unsigned32;
      C4_Value : RTEMS.Unsigned32;
   begin

      C1_Value := Interfaces.Shift_Right (Name, 24);
      C2_Value := Interfaces.Shift_Right (Name, 16);
      C3_Value := Interfaces.Shift_Right (Name, 8);
      C4_Value := Name;

      C1_Value := C1_Value and 16#00FF#;
      C2_Value := C2_Value and 16#00FF#;
      C3_Value := C3_Value and 16#00FF#;
      C4_Value := C4_Value and 16#00FF#;

      C1 := Character'Val (C1_Value);
      C2 := Character'Val (C2_Value);
      C3 := Character'Val (C3_Value);
      C4 := Character'Val (C4_Value);

   end Name_To_Characters;

   function Get_Node (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
   begin

      -- May not be right
      return Interfaces.Shift_Right (ID, 16);

   end Get_Node;

   function Get_Index (ID : in RTEMS.ID) return RTEMS.Unsigned32 is
   begin

      -- May not be right
      return ID and 16#FFFF#;

   end Get_Index;

   function Are_Statuses_Equal
     (Status  : in RTEMS.Status_Codes;
      Desired : in RTEMS.Status_Codes)
      return    Standard.Boolean
   is
   begin

      if Status = Desired then
         return Standard.True;
      end if;

      return Standard.False;

   end Are_Statuses_Equal;

   function Is_Status_Successful
     (Status : in RTEMS.Status_Codes)
      return   Standard.Boolean
   is
   begin

      if Status = RTEMS.Successful then
         return Standard.True;
      end if;

      return Standard.False;

   end Is_Status_Successful;

   function Subtract
     (Left  : in RTEMS.Address;
      Right : in RTEMS.Address)
      return  RTEMS.Unsigned32
   is
      function To_Unsigned32 is new Ada.Unchecked_Conversion (
         System.Address,
         RTEMS.Unsigned32);

   begin
      return To_Unsigned32 (Left) - To_Unsigned32 (Right);
   end Subtract;

   function Are_Equal
     (Left  : in RTEMS.Address;
      Right : in RTEMS.Address)
      return  Standard.Boolean
   is
      function To_Unsigned32 is new Ada.Unchecked_Conversion (
         System.Address,
         RTEMS.Unsigned32);

   begin
      return (To_Unsigned32 (Left) = To_Unsigned32 (Right));
   end Are_Equal;

   --
   --
   --  RTEMS API
   --

   function Build_Name (
      C1 : in     Character;
      C2 : in     Character;
      C3 : in     Character;
      C4 : in     Character
   ) return RTEMS.Name is
      C1_Value : RTEMS.Unsigned32;
      C2_Value : RTEMS.Unsigned32;
      C3_Value : RTEMS.Unsigned32;
      C4_Value : RTEMS.Unsigned32;
   begin

     C1_Value := Character'Pos( C1 );
     C2_Value := Character'Pos( C2 );
     C3_Value := Character'Pos( C3 );
     C4_Value := Character'Pos( C4 );

     return Interfaces.Shift_Left( C1_Value, 24 ) or
            Interfaces.Shift_Left( C2_Value, 16 ) or
            Interfaces.Shift_Left( C3_Value, 8 )  or
            C4_Value;

   end Build_Name;

   --
   --  Initialization Manager -- Shutdown Only
   --
   procedure Shutdown_Executive (Status : in RTEMS.Unsigned32) is
      procedure Shutdown_Executive_Base (Status : RTEMS.Unsigned32);
      pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
   begin
      Shutdown_Executive_Base (Status);
   end Shutdown_Executive;

end RTEMS;