path: root/c/src/ada/rtems.adb

--
--  RTEMS / Body
--
--  DESCRIPTION:
--
--  This package provides the interface to the RTEMS API.
--
--
--  DEPENDENCIES:
--
--
--
--  COPYRIGHT (c) 1997-2008.
--  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 System;
with Interfaces; use Interfaces;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;

package body RTEMS is

   --
   --  Utility Functions
   --

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

      if Ada_Boolean = Standard.True 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
      Microseconds_Per_Tick : RTEMS.Interval;
      pragma Import (C, Microseconds_Per_Tick, "_TOD_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
   --

   --
   --  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;


   --
   --  Task Manager
   --

   procedure Task_Create (
      Name             : in     RTEMS.Name;
      Initial_Priority : in     RTEMS.Task_Priority;
      Stack_Size       : in     RTEMS.Unsigned32;
      Initial_Modes    : in     RTEMS.Mode;
      Attribute_Set    : in     RTEMS.Attribute;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is
      function Task_Create_Base (
         Name             : RTEMS.Name;
         Initial_Priority : RTEMS.Task_Priority;
         Stack_Size       : RTEMS.Unsigned32;
         Initial_Modes    : RTEMS.Mode;
         Attribute_Set    : RTEMS.Attribute;
         ID               : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Create_Base, "rtems_task_create");
      ID_Base : aliased RTEMS.ID;
   begin
      Result := Task_Create_Base (
        Name,
        Initial_Priority,
        Stack_Size,
        Initial_Modes,
        Attribute_Set,
        ID_Base'Access
      );
      ID := ID_Base;
   end Task_Create;

   procedure Task_Ident (
      Name             : in     RTEMS.Name;
      Node             : in     RTEMS.Node;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is

      function Task_Ident_Base (
         Name             : RTEMS.Name;
         Node             : RTEMS.Node;
         ID               : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Ident_Base, "rtems_task_ident");
      ID_Base     : aliased RTEMS.ID;

   begin

      Result := Task_Ident_Base (Name, Node, ID_Base'Access);
      ID := ID_Base;

   end Task_Ident;

   procedure Task_Start (
      ID          : in     RTEMS.ID;
      Entry_Point : in     RTEMS.Task_Entry;
      Argument    : in     RTEMS.Task_Argument;
      Result      :    out RTEMS.Status_Codes
   ) is
      function Task_Start_Base (
         ID          : RTEMS.ID;
         Entry_Point : RTEMS.Task_Entry;
         Argument    : RTEMS.Task_Argument
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Start_Base, "rtems_task_start");
   begin

      Result := Task_Start_Base (ID, Entry_Point, Argument);

   end Task_Start;

   procedure Task_Restart (
      ID       : in     RTEMS.ID;
      Argument : in     RTEMS.Task_Argument;
      Result   :    out RTEMS.Status_Codes
   ) is
      function Task_Restart_Base (
         ID       : RTEMS.ID;
         Argument : RTEMS.Task_Argument
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Restart_Base, "rtems_task_restart");
   begin

      Result := Task_Restart_Base (ID, Argument);

   end Task_Restart;

   procedure Task_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Task_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Delete_Base, "rtems_task_delete");
   begin

      Result := Task_Delete_Base (ID);

   end Task_Delete;

   procedure Task_Suspend (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Task_Suspend_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
   begin

      Result := Task_Suspend_Base (ID);

   end Task_Suspend;

   procedure Task_Resume (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Task_Resume_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Resume_Base, "rtems_task_resume");
   begin

      Result := Task_Resume_Base (ID);

   end Task_Resume;

   procedure Task_Is_Suspended (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Task_Is_Suspended_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended");
   begin

      Result := Task_Is_Suspended_Base (ID);

   end Task_Is_Suspended;

   procedure Task_Set_Priority (
      ID           : in     RTEMS.ID;
      New_Priority : in     RTEMS.Task_Priority;
      Old_Priority :    out RTEMS.Task_Priority;
      Result       :    out RTEMS.Status_Codes
   ) is
      function Task_Set_Priority_Base (
         ID           : RTEMS.ID;
         New_Priority : RTEMS.Task_Priority;
         Old_Priority : access RTEMS.Task_Priority
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority");
      Old_Priority_Base : aliased RTEMS.Task_Priority;
   begin

      Result := Task_Set_Priority_Base (
         ID,
         New_Priority,
         Old_Priority_Base'Access
      );
      Old_Priority := Old_Priority_Base;

   end Task_Set_Priority;

   procedure Task_Mode (
      Mode_Set          : in     RTEMS.Mode;
      Mask              : in     RTEMS.Mode;
      Previous_Mode_Set :    out RTEMS.Mode;
      Result            :    out RTEMS.Status_Codes
   ) is
      function Task_Mode_Base (
         Mode_Set          : RTEMS.Mode;
         Mask              : RTEMS.Mode;
         Previous_Mode_Set : access RTEMS.Mode
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Mode_Base, "rtems_task_mode");
      Previous_Mode_Set_Base : aliased RTEMS.Mode;
   begin

      Result := Task_Mode_Base (
         Mode_Set,
         Mask,
         Previous_Mode_Set_Base'Access
      );
      Previous_Mode_Set := Previous_Mode_Set_Base;

   end Task_Mode;

   procedure Task_Get_Note (
      ID      : in     RTEMS.ID;
      Notepad : in     RTEMS.Notepad_Index;
      Note    :    out RTEMS.Unsigned32;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Task_Get_Note_Base (
         ID      : RTEMS.ID;
         Notepad : RTEMS.Notepad_Index;
         Note    : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
      Note_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Task_Get_Note_Base (ID, Notepad, Note_Base'Access);
      Note := NOTE_Base;

   end Task_Get_Note;

   procedure Task_Set_Note (
      ID      : in     RTEMS.ID;
      Notepad : in     RTEMS.Notepad_Index;
      Note    : in     RTEMS.Unsigned32;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Task_Set_Note_Base (
         ID      : RTEMS.ID;
         Notepad : RTEMS.Notepad_Index;
         Note    : RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
   begin

      Result := Task_Set_Note_Base (ID, Notepad, Note);

   end Task_Set_Note;

   procedure Task_Variable_Add (
      ID            : in     RTEMS.ID;
      Task_Variable : in     RTEMS.Address;
      Dtor          : in     RTEMS.Task_Variable_Dtor;
      Result        :    out RTEMS.Status_Codes
   ) is
      function Task_Variable_Add_Base (
         ID            : RTEMS.ID;
         Task_Variable : RTEMS.Address;
         Dtor          : RTEMS.Task_Variable_Dtor
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
   begin

      Result := Task_Variable_Add_Base (ID, Task_Variable, Dtor);

   end Task_Variable_Add;

   procedure Task_Variable_Get (
      ID                  : in     RTEMS.ID;
      Task_Variable       :    out RTEMS.Address;
      Task_Variable_Value :    out RTEMS.Address;
      Result              :    out RTEMS.Status_Codes
   ) is
      function Task_Variable_Get_Base (
         ID                  : RTEMS.ID;
         Task_Variable       : access RTEMS.Address;
         Task_Variable_Value : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
      Task_Variable_Base       : aliased RTEMS.Address;
      Task_Variable_Value_Base : aliased RTEMS.Address;
   begin

      Result := Task_Variable_Get_Base (
         ID,
         Task_Variable_Base'Access,
         Task_Variable_Value_Base'Access
      );
      Task_Variable := Task_Variable_Base;
      Task_Variable_Value := Task_Variable_Value_Base;

   end Task_Variable_Get;

   procedure Task_Variable_Delete (
      ID                  : in     RTEMS.ID;
      Task_Variable       :    out RTEMS.Address;
      Result              :    out RTEMS.Status_Codes
   ) is
      function Task_Variable_Delete_Base (
         ID                  : RTEMS.ID;
         Task_Variable       : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (
         C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
      );
      Task_Variable_Base : aliased RTEMS.Address;
   begin

      Result := Task_Variable_Delete_Base (
         ID, Task_Variable_Base'Access
      );
      Task_Variable := Task_Variable_Base;

   end Task_Variable_Delete;

   procedure Task_Wake_When (
      Time_Buffer : in     RTEMS.Time_Of_Day;
      Result      :    out RTEMS.Status_Codes
   ) is
      function Task_Wake_When_Base (
         Time_Buffer : RTEMS.Time_Of_Day
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
   begin

      Result := Task_Wake_When_Base (Time_Buffer);

   end Task_Wake_When;

   procedure Task_Wake_After (
      Ticks  : in     RTEMS.Interval;
      Result :    out RTEMS.Status_Codes
   ) is
      function Task_Wake_After_Base (
         Ticks : RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
   begin

      Result := Task_Wake_After_Base (Ticks);

   end Task_Wake_After;

   --
   -- Interrupt Manager
   --

   -- Interrupt_Disable is interfaced in the specification
   -- Interrupt_Enable is interfaced in the specification
   -- Interrupt_Flash is interfaced in the specification
   -- Interrupt_Is_In_Progress is interfaced in the specification

   --
   -- Clock Manager
   --

   procedure Clock_Set (
      Time_Buffer : in     RTEMS.Time_Of_Day;
      Result      :    out RTEMS.Status_Codes
   ) is
      function Clock_Set_Base (
         Time_Buffer : access RTEMS.Time_Of_Day
      )  return RTEMS.Status_Codes;
      pragma Import (C, Clock_Set_Base, "rtems_clock_set");

      Tmp_Time : aliased RTEMS.Time_Of_Day; 
   begin

      Tmp_Time := Time_Buffer;
      Result := Clock_Set_Base (Tmp_Time'Access);

   end Clock_Set;

   procedure Clock_Get (
      Option      : in     RTEMS.Clock_Get_Options;
      Time_Buffer : in     RTEMS.Address;
      Result      :    out RTEMS.Status_Codes
   ) is
      function Clock_Get_Base (
         Option      : RTEMS.Clock_Get_Options;
         Time_Buffer : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Clock_Get_Base, "rtems_clock_get");
   begin

      Result := Clock_Get_Base (Option, Time_Buffer);

   end Clock_Get;

   procedure Clock_Get_TOD (
      Time    :    out RTEMS.Time_Of_Day;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Clock_Get_TOD_Base (
        Time  : access RTEMS.Time_Of_Day
      )  return RTEMS.Status_Codes;
      pragma Import (C, Clock_Get_TOD_Base, "rtems_clock_get_tod");

      Tmp_Time : aliased RTEMS.Time_Of_Day;
   begin
      Result := Clock_Get_TOD_Base (Tmp_Time'Access);
      Time := Tmp_Time;
   end Clock_Get_TOD;

   procedure Clock_Get_TOD_Time_Value (
      Time   :    out RTEMS.Clock_Time_Value;
      Result :    out RTEMS.Status_Codes
   ) is
      function Clock_Get_TOD_Time_Value_Base (
        Time  : access RTEMS.Clock_Time_Value
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Clock_Get_TOD_Time_Value_Base,
         "rtems_clock_get_tod_timeval"
      );

      Tmp_Time : aliased RTEMS.Clock_Time_Value;
   begin
      Result := Clock_Get_TOD_Time_Value_Base (Tmp_Time'Access);
      Time := Tmp_Time;
   end Clock_Get_TOD_Time_Value;

   procedure Clock_Get_Seconds_Since_Epoch(
      The_Interval :    out RTEMS.Interval;
      Result       :    out RTEMS.Status_Codes
   ) is
      function Clock_Get_Seconds_Since_Epoch_Base (
        The_Interval  : access RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Clock_Get_Seconds_Since_Epoch_Base,
         "rtems_clock_get_seconds_since_epoch"
      );

      Tmp_Interval : aliased RTEMS.Interval;
   begin
      Result := Clock_Get_Seconds_Since_Epoch_Base (Tmp_Interval'Access);
      The_Interval := Tmp_Interval;
   end Clock_Get_Seconds_Since_Epoch;

   -- Clock_Get_Ticks_Per_Second is in rtems.ads

   -- Clock_Get_Ticks_Since_Boot is in rtems.ads

   procedure Clock_Get_Uptime (
      Uptime :    out RTEMS.Timespec;
      Result :    out RTEMS.Status_Codes
   ) is
      function Clock_Get_Uptime_Base (
         Uptime : access RTEMS.Timespec
      )  return RTEMS.Status_Codes;
      pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime");
      Uptime_Base : aliased RTEMS.Timespec;
   begin

      Result := Clock_Get_Uptime_Base (Uptime_Base'Access);
      Uptime := Uptime_Base;

   end Clock_Get_Uptime;

   procedure Clock_Tick (
      Result :    out RTEMS.Status_Codes
   ) is
      function Clock_Tick_Base return RTEMS.Status_Codes;
      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
   begin

      Result := Clock_Tick_Base;

   end Clock_Tick;

   --
   -- Extension Manager
   --

   procedure Extension_Create (
      Name   : in     RTEMS.Name;
      Table  : in     RTEMS.Extensions_Table_Pointer;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Extension_Create_Base (
         Name   : RTEMS.Name;
         Table  : RTEMS.Extensions_Table_Pointer;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Extension_Create_Base (Name, Table, ID_Base'Access);
      ID := ID_Base;

   end Extension_Create;

   procedure Extension_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Extension_Ident_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Extension_Ident_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Extension_Ident;

   procedure Extension_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Extension_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
   begin

      Result := Extension_Delete_Base (ID);

   end Extension_Delete;

   --
   -- Timer Manager
   --

   procedure Timer_Create (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Timer_Create_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Timer_Create_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Timer_Create;

   procedure Timer_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Timer_Ident_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Timer_Ident_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Timer_Ident;

   procedure Timer_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Timer_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
   begin

      Result := Timer_Delete_Base (ID);

   end Timer_Delete;

   procedure Timer_Fire_After (
      ID        : in     RTEMS.ID;
      Ticks     : in     RTEMS.Interval;
      Routine   : in     RTEMS.Timer_Service_Routine;
      User_Data : in     RTEMS.Address;
      Result    :    out RTEMS.Status_Codes
   ) is
      function Timer_Fire_After_Base (
         ID        : RTEMS.ID;
         Ticks     : RTEMS.Interval;
         Routine   : RTEMS.Timer_Service_Routine;
         User_Data : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
   begin

      Result := Timer_Fire_After_Base (ID, Ticks, Routine, User_Data);

   end Timer_Fire_After;

   procedure Timer_Server_Fire_After (
      ID        : in     RTEMS.ID;
      Ticks     : in     RTEMS.Interval;
      Routine   : in     RTEMS.Timer_Service_Routine;
      User_Data : in     RTEMS.Address;
      Result    :    out RTEMS.Status_Codes
   ) is
      function Timer_Server_Fire_After_Base (
         ID        : RTEMS.ID;
         Ticks     : RTEMS.Interval;
         Routine   : RTEMS.Timer_Service_Routine;
         User_Data : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (
        C,
        Timer_Server_Fire_After_Base,
        "rtems_timer_server_fire_after"
      );
   begin

      Result := Timer_Server_Fire_After_Base (ID, Ticks, Routine, User_Data);

   end Timer_Server_Fire_After;

   procedure Timer_Fire_When (
      ID        : in     RTEMS.ID;
      Wall_Time : in     RTEMS.Time_Of_Day;
      Routine   : in     RTEMS.Timer_Service_Routine;
      User_Data : in     RTEMS.Address;
      Result    :    out RTEMS.Status_Codes
   ) is
      function Timer_Fire_When_Base (
         ID        : RTEMS.ID;
         Wall_Time : RTEMS.Time_Of_Day;
         Routine   : RTEMS.Timer_Service_Routine;
         User_Data : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
   begin

      Result := Timer_Fire_When_Base (ID, Wall_Time, Routine, User_Data);

   end Timer_Fire_When;

   procedure Timer_Server_Fire_When (
      ID        : in     RTEMS.ID;
      Wall_Time : in     RTEMS.Time_Of_Day;
      Routine   : in     RTEMS.Timer_Service_Routine;
      User_Data : in     RTEMS.Address;
      Result    :    out RTEMS.Status_Codes
   ) is
      function Timer_Server_Fire_When_Base (
         ID        : RTEMS.ID;
         Wall_Time : RTEMS.Time_Of_Day;
         Routine   : RTEMS.Timer_Service_Routine;
         User_Data : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Timer_Server_Fire_When_Base,
         "rtems_timer_server_fire_when"
      );
   begin

      Result :=
         Timer_Server_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
   end Timer_Server_Fire_When;

   procedure Timer_Reset (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Timer_Reset_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
   begin

      Result := Timer_Reset_Base (ID);

   end Timer_Reset;

   procedure Timer_Cancel (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Timer_Cancel_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
   begin

      Result := Timer_Cancel_Base (ID);

   end Timer_Cancel;

   procedure Timer_Initiate_Server (
      Server_Priority : in     RTEMS.Task_Priority;
      Stack_Size      : in     RTEMS.Unsigned32;
      Attribute_Set   : in     RTEMS.Attribute;
      Result          :    out RTEMS.Status_Codes
   ) is
      function Timer_Initiate_Server_Base (
         Server_Priority : RTEMS.Task_Priority;
         Stack_Size      : RTEMS.Unsigned32;
         Attribute_Set   : RTEMS.Attribute
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Timer_Initiate_Server_Base,
         "rtems_timer_initiate_server"
      );
   begin
      Result := Timer_Initiate_Server_Base (
         Server_Priority,
         Stack_Size,
         Attribute_Set
      );
   end Timer_Initiate_Server;

   --
   -- Semaphore Manager
   --

   procedure Semaphore_Create (
      Name             : in     RTEMS.Name;
      Count            : in     RTEMS.Unsigned32;
      Attribute_Set    : in     RTEMS.Attribute;
      Priority_Ceiling : in     RTEMS.Task_Priority;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Create_Base (
         Name             : RTEMS.Name;
         Count            : RTEMS.Unsigned32;
         Attribute_Set    : RTEMS.Attribute;
         Priority_Ceiling : RTEMS.Task_Priority;
         ID               : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Semaphore_Create_Base (
         Name,
         Count,
         Attribute_Set,
         Priority_Ceiling,
         ID_Base'Access
      );
      ID := ID_Base;

   end Semaphore_Create;

   procedure Semaphore_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
   begin

      Result := Semaphore_Delete_Base (ID);

   end Semaphore_Delete;

   procedure Semaphore_Ident (
      Name   : in     RTEMS.Name;
      Node   : in     RTEMS.Unsigned32;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Ident_Base (
         Name : RTEMS.Name;
         Node : RTEMS.Unsigned32;
         ID   : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Semaphore_Ident_Base (Name, Node, ID_Base'Access);
      ID := ID_Base;

   end Semaphore_Ident;

   procedure Semaphore_Obtain (
      ID         : in     RTEMS.ID;
      Option_Set : in     RTEMS.Option;
      Timeout    : in     RTEMS.Interval;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Obtain_Base (
         ID         : RTEMS.ID;
         Option_Set : RTEMS.Option;
         Timeout    : RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
   begin

      Result := Semaphore_Obtain_Base (ID, Option_Set, Timeout);

   end Semaphore_Obtain;

   procedure Semaphore_Release (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Release_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
   begin

      Result := Semaphore_Release_Base (ID);

   end Semaphore_Release;

   procedure Semaphore_Flush (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Semaphore_Flush_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
   begin

      Result := Semaphore_Flush_Base (ID);

   end Semaphore_Flush;

   --
   -- Message Queue Manager
   --

   procedure Message_Queue_Create (
      Name             : in     RTEMS.Name;
      Count            : in     RTEMS.Unsigned32;
      Max_Message_Size : in     RTEMS.Unsigned32;
      Attribute_Set    : in     RTEMS.Attribute;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is
      --  XXX broken
      function Message_Queue_Create_Base (
         Name             : RTEMS.Name;
         Count            : RTEMS.Unsigned32;
         Max_Message_Size : RTEMS.Unsigned32;
         Attribute_Set    : RTEMS.Attribute;
         ID               : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C,
        Message_Queue_Create_Base, "rtems_message_queue_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Message_Queue_Create_Base (
         Name,
         Count,
         Max_Message_Size,
         Attribute_Set,
         ID_Base'Access
      );
      ID := ID_Base;

   end Message_Queue_Create;

   procedure Message_Queue_Ident (
      Name   : in     RTEMS.Name;
      Node   : in     RTEMS.Unsigned32;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Ident_Base (
         Name : RTEMS.Name;
         Node : RTEMS.Unsigned32;
         ID   : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result :=
         Message_Queue_Ident_Base (Name, Node, ID_Base'Access);
      ID := ID_Base;

   end Message_Queue_Ident;

   procedure Message_Queue_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (
         C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
   begin

      Result := Message_Queue_Delete_Base (ID);

   end Message_Queue_Delete;

   procedure Message_Queue_Send (
      ID     : in     RTEMS.ID;
      Buffer : in     RTEMS.Address;
      Size   : in     RTEMS.Unsigned32;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Send_Base (
         ID     : RTEMS.ID;
         Buffer : RTEMS.Address;
         Size   : RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
   begin

      Result := Message_Queue_Send_Base (ID, Buffer, Size);

   end Message_Queue_Send;

   procedure Message_Queue_Urgent (
      ID     : in     RTEMS.ID;
      Buffer : in     RTEMS.Address;
      Size   : in     RTEMS.Unsigned32;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Urgent_Base (
         ID     : RTEMS.ID;
         Buffer : RTEMS.Address;
         Size   : RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Urgent_Base,
         "rtems_message_queue_urgent");
   begin

      Result := Message_Queue_Urgent_Base (ID, Buffer, Size);

   end Message_Queue_Urgent;

   procedure Message_Queue_Broadcast (
      ID     : in     RTEMS.ID;
      Buffer : in     RTEMS.Address;
      Size   : in     RTEMS.Unsigned32;
      Count  :    out RTEMS.Unsigned32;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Broadcast_Base (
         ID     : RTEMS.ID;
         Buffer : RTEMS.Address;
         Size   : RTEMS.Unsigned32;
         Count  : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Broadcast_Base,
         "rtems_message_queue_broadcast");
      Count_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Message_Queue_Broadcast_Base (
         ID,
         Buffer,
         Size,
         Count_Base'Access
     );
      Count := Count_Base;

   end Message_Queue_Broadcast;

   procedure Message_Queue_Receive (
      ID         : in     RTEMS.ID;
      Buffer     : in     RTEMS.Address;
      Option_Set : in     RTEMS.Option;
      Timeout    : in     RTEMS.Interval;
      Size       : in out RTEMS.Unsigned32;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Receive_Base (
         ID         : RTEMS.ID;
         Buffer     : RTEMS.Address;
         Size       : access RTEMS.Unsigned32;
         Option_Set : RTEMS.Option;
         Timeout    : RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Receive_Base,
         "rtems_message_queue_receive");
      Size_Base : aliased RTEMS.Unsigned32;
   begin

      Size_Base := Size;

      Result := Message_Queue_Receive_Base (
         ID,
         Buffer,
         Size_Base'Access,
         Option_Set,
         Timeout
      );
      Size := Size_Base;

   end Message_Queue_Receive;

   procedure Message_Queue_Get_Number_Pending (
      ID     : in     RTEMS.ID;
      Count  :    out RTEMS.Unsigned32;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Get_Number_Pending_Base (
         ID    : RTEMS.ID;
         Count : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Message_Queue_Get_Number_Pending_Base,
         "rtems_message_queue_get_number_pending"
      );
      COUNT_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Message_Queue_Get_Number_Pending_Base (
         ID, COUNT_Base'Access
      );
      Count := COUNT_Base;

   end Message_Queue_Get_Number_Pending;

   procedure Message_Queue_Flush (
      ID     : in     RTEMS.ID;
      Count  :    out RTEMS.Unsigned32;
      Result :    out RTEMS.Status_Codes
   ) is
      function Message_Queue_Flush_Base (
         ID    : RTEMS.ID;
         Count : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
      COUNT_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Message_Queue_Flush_Base (ID, COUNT_Base'Access);
      Count := COUNT_Base;

   end Message_Queue_Flush;

   --
   -- Event Manager
   --

   procedure Event_Send (
      ID       : in     RTEMS.ID;
      Event_In : in     RTEMS.Event_Set;
      Result   :    out RTEMS.Status_Codes
   ) is
      function Event_Send_Base (
         ID       : RTEMS.ID;
         Event_In : RTEMS.Event_Set
      )  return RTEMS.Status_Codes;
      pragma Import (C, Event_Send_Base, "rtems_event_send");
   begin

      Result := Event_Send_Base (ID, Event_In);

   end Event_Send;

   procedure Event_Receive (
      Event_In   : in     RTEMS.Event_Set;
      Option_Set : in     RTEMS.Option;
      Ticks      : in     RTEMS.Interval;
      Event_Out  :    out RTEMS.Event_Set;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Event_Receive_Base (
         Event_In   : RTEMS.Event_Set;
         Option_Set : RTEMS.Option;
         Ticks      : RTEMS.Interval;
         Event_Out  : access RTEMS.Event_Set
      )  return RTEMS.Status_Codes;
      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
      Event_Out_Base : aliased RTEMS.Event_Set;
   begin

      Result := Event_Receive_Base (
         Event_In,
         Option_Set,
         Ticks,
         Event_Out_Base'Access
      );
      Event_Out := Event_Out_Base;

   end Event_Receive;

   --
   -- Signal Manager
   --

   procedure Signal_Catch (
      ASR_Handler : in     RTEMS.ASR_Handler;
      Mode_Set    : in     RTEMS.Mode;
      Result      :    out RTEMS.Status_Codes
   ) is
      function Signal_Catch_Base (
         ASR_Handler : RTEMS.ASR_Handler;
         Mode_Set    : RTEMS.Mode
      )  return RTEMS.Status_Codes;
      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
   begin

      Result := Signal_Catch_Base (ASR_Handler, Mode_Set);

   end Signal_Catch;

   procedure Signal_Send (
      ID         : in     RTEMS.ID;
      Signal_Set : in     RTEMS.Signal_Set;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Signal_Send_Base (
         ID         : RTEMS.ID;
         Signal_Set : RTEMS.Signal_Set
      )  return RTEMS.Status_Codes;
      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
   begin

      Result := Signal_Send_Base (ID, Signal_Set);

   end Signal_Send;


   --
   -- Partition Manager
   --

   procedure Partition_Create (
      Name             : in     RTEMS.Name;
      Starting_Address : in     RTEMS.Address;
      Length           : in     RTEMS.Unsigned32;
      Buffer_Size      : in     RTEMS.Unsigned32;
      Attribute_Set    : in     RTEMS.Attribute;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is
      function Partition_Create_Base (
         Name             : RTEMS.Name;
         Starting_Address : RTEMS.Address;
         Length           : RTEMS.Unsigned32;
         Buffer_Size      : RTEMS.Unsigned32;
         Attribute_Set    : RTEMS.Attribute;
         ID               : access RTEMS.Event_Set
      )  return RTEMS.Status_Codes;
      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Partition_Create_Base (
         Name,
         Starting_Address,
         Length,
         Buffer_Size,
         Attribute_Set,
         ID_Base'Access
      );
      ID := ID_Base;

   end Partition_Create;

   procedure Partition_Ident (
      Name   : in     RTEMS.Name;
      Node   : in     RTEMS.Unsigned32;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Partition_Ident_Base (
         Name : RTEMS.Name;
         Node : RTEMS.Unsigned32;
         ID   : access RTEMS.Event_Set
      )  return RTEMS.Status_Codes;
      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Partition_Ident_Base (Name, Node, ID_Base'Access);
      ID := ID_Base;

   end Partition_Ident;

   procedure Partition_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Partition_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
   begin

      Result := Partition_Delete_Base (ID);

   end Partition_Delete;

   procedure Partition_Get_Buffer (
      ID     : in     RTEMS.ID;
      Buffer :    out RTEMS.Address;
      Result :    out RTEMS.Status_Codes
   ) is
      function Partition_Get_Buffer_Base (
         ID     : RTEMS.ID;
         Buffer : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Partition_Get_Buffer_Base,
         "rtems_partition_get_buffer");
      Buffer_Base : aliased RTEMS.Address;
   begin

      Result := Partition_Get_Buffer_Base (ID, Buffer_Base'Access);
      Buffer := Buffer_Base;

   end Partition_Get_Buffer;

   procedure Partition_Return_Buffer (
      ID     : in     RTEMS.ID;
      Buffer : in     RTEMS.Address;
      Result :    out RTEMS.Status_Codes
   ) is
      function Partition_Return_Buffer_Base (
         ID     : RTEMS.Name;
         Buffer : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Partition_Return_Buffer_Base,
         "rtems_partition_return_buffer");
   begin

      Result := Partition_Return_Buffer_Base (ID, Buffer);

   end Partition_Return_Buffer;

   --
   -- Region Manager
   --

   procedure Region_Create (
      Name             : in     RTEMS.Name;
      Starting_Address : in     RTEMS.Address;
      Length           : in     RTEMS.Unsigned32;
      Page_Size        : in     RTEMS.Unsigned32;
      Attribute_Set    : in     RTEMS.Attribute;
      ID               :    out RTEMS.ID;
      Result           :    out RTEMS.Status_Codes
   ) is
      function Region_Create_Base (
         Name             : RTEMS.Name;
         Starting_Address : RTEMS.Address;
         Length           : RTEMS.Unsigned32;
         Page_Size        : RTEMS.Unsigned32;
         Attribute_Set    : RTEMS.Attribute;
         ID               : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Create_Base, "rtems_region_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Region_Create_Base (
         Name,
         Starting_Address,
         Length,
         Page_Size,
         Attribute_Set,
         ID_Base'Access
      );
      ID := ID_Base;

   end Region_Create;

   procedure Region_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Region_Ident_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Region_Ident_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Region_Ident;

   procedure Region_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Region_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
   begin

      Result := Region_Delete_Base (ID);

   end Region_Delete;

   procedure Region_Extend (
      ID               : in     RTEMS.ID;
      Starting_Address : in     RTEMS.Address;
      Length           : in     RTEMS.Unsigned32;
      Result           :    out RTEMS.Status_Codes
   ) is
      function Region_Extend_Base (
         ID               : RTEMS.ID;
         Starting_Address : RTEMS.Address;
         Length           : RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
   begin

      Result := Region_Extend_Base (ID, Starting_Address, Length);

   end Region_Extend;

   procedure Region_Get_Segment (
      ID         : in     RTEMS.ID;
      Size       : in     RTEMS.Unsigned32;
      Option_Set : in     RTEMS.Option;
      Timeout    : in     RTEMS.Interval;
      Segment    :    out RTEMS.Address;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Region_Get_Segment_Base (
         ID         : RTEMS.ID;
         Size       : RTEMS.Unsigned32;
         Option_Set : RTEMS.Option;
         Timeout    : RTEMS.Interval;
         Segment    : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
      Segment_Base : aliased RTEMS.Address;
   begin

      Result := Region_Get_Segment_Base (
         ID,
         Size,
         Option_Set,
         Timeout,
         Segment_Base'Access
      );
      Segment := SEGMENT_Base;

   end Region_Get_Segment;

   procedure Region_Get_Segment_Size (
      ID      : in     RTEMS.ID;
      Segment : in     RTEMS.Address;
      Size    :    out RTEMS.Unsigned32;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Region_Get_Segment_Size_Base (
         ID      : RTEMS.ID;
         Segment : RTEMS.Address;
         Size    : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Get_Segment_Size_Base,
         "rtems_region_get_segment_size");
      Size_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Region_Get_Segment_Size_Base (
         ID,
         Segment,
         Size_Base'Access
      );
      Size := SIZE_Base;

   end Region_Get_Segment_Size;

   procedure Region_Return_Segment (
      ID      : in     RTEMS.ID;
      Segment : in     RTEMS.Address;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Region_Return_Segment_Base (
         ID      : RTEMS.ID;
         Segment : RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Return_Segment_Base,
         "rtems_region_return_segment");
   begin

      Result := Region_Return_Segment_Base (ID, Segment);

   end Region_Return_Segment;

   procedure Region_Resize_Segment (
      ID         : in     RTEMS.ID;
      Segment    : in     RTEMS.Address;
      Size       : in     RTEMS.Unsigned32;
      Old_Size   :    out RTEMS.Unsigned32;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Region_Resize_Segment_Base (
         ID       : RTEMS.ID;
         Segment  : RTEMS.Address;
         Size     : RTEMS.Unsigned32;
         Old_Size : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Region_Resize_Segment_Base,
         "rtems_region_resize_segment");
      Old_Size_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Region_Resize_Segment_Base (
         ID,
         Segment,
         Size,
         Old_Size_Base'Access
      );
      Old_Size := Old_Size_Base;

   end Region_Resize_Segment;

   --
   -- Dual Ported Memory Manager
   --

   procedure Port_Create (
      Name           : in     RTEMS.Name;
      Internal_Start : in     RTEMS.Address;
      External_Start : in     RTEMS.Address;
      Length         : in     RTEMS.Unsigned32;
      ID             :    out RTEMS.ID;
      Result         :    out RTEMS.Status_Codes
   ) is
      function Port_Create_Base (
         Name           : RTEMS.Name;
         Internal_Start : RTEMS.Address;
         External_Start : RTEMS.Address;
         Length         : RTEMS.Unsigned32;
         ID             : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Port_Create_Base, "rtems_port_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Port_Create_Base (
         Name,
         Internal_Start,
         External_Start,
         Length,
         ID_Base'Access
      );
      ID := ID_Base;

   end Port_Create;

   procedure Port_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Port_Ident_Base (
         Name : RTEMS.Name;
         ID   : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Port_Ident_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Port_Ident;

   procedure Port_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Port_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
   begin

      Result := Port_Delete_Base (ID);

   end Port_Delete;

   procedure Port_External_To_Internal (
      ID       : in     RTEMS.ID;
      External : in     RTEMS.Address;
      Internal :    out RTEMS.Address;
      Result   :    out RTEMS.Status_Codes
   ) is
      function Port_External_To_Internal_Base (
         ID       : RTEMS.ID;
         External : RTEMS.Address;
         Internal : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Port_External_To_Internal_Base,
         "rtems_port_external_to_internal");
      Internal_Base : aliased RTEMS.Address;
   begin

      Result := Port_External_To_Internal_Base (
         ID,
         External,
         Internal_Base'Access
      );
      Internal := INTERNAL_Base;

   end Port_External_To_Internal;

   procedure Port_Internal_To_External (
      ID       : in     RTEMS.ID;
      Internal : in     RTEMS.Address;
      External :    out RTEMS.Address;
      Result   :    out RTEMS.Status_Codes
   ) is
      function Port_Internal_To_External_Base (
         ID       : RTEMS.ID;
         Internal : RTEMS.Address;
         External : access RTEMS.Address
      )  return RTEMS.Status_Codes;
      pragma Import (C, Port_Internal_To_External_Base,
         "rtems_port_internal_to_external");
      External_Base : aliased RTEMS.Address;
   begin

      Result := Port_Internal_To_External_Base (
         ID,
         Internal,
         External_Base'Access
      );
      External := EXTERNAL_Base;

   end Port_Internal_To_External;


   --
   -- Fatal Error Manager
   --

   procedure Fatal_Error_Occurred (
      The_Error : in     RTEMS.Unsigned32
   ) is
      procedure Fatal_Error_Occurred_Base (
         The_Error : RTEMS.Unsigned32
      );
   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
   begin

      Fatal_Error_Occurred_Base (The_Error);

   end Fatal_Error_Occurred;


   --
   -- Rate Monotonic Manager
   --

   procedure Rate_Monotonic_Create (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Create_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Rate_Monotonic_Create_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Rate_Monotonic_Create;

   procedure Rate_Monotonic_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Ident_Base (
         Name   : RTEMS.Name;
         ID     : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Rate_Monotonic_Ident_Base (Name, ID_Base'Access);

      ID := ID_Base;

   end Rate_Monotonic_Ident;

   procedure Rate_Monotonic_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Delete_Base,
         "rtems_rate_monotonic_delete");
   begin

      Result := Rate_Monotonic_Delete_Base (ID);

   end Rate_Monotonic_Delete;

   procedure Rate_Monotonic_Cancel (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Cancel_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Cancel_Base,
         "rtems_rate_monotonic_cancel");
   begin

      Result := Rate_Monotonic_Cancel_Base (ID);

   end Rate_Monotonic_Cancel;

   procedure Rate_Monotonic_Period (
      ID      : in     RTEMS.ID;
      Length  : in     RTEMS.Interval;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Period_Base (
         ID     : RTEMS.ID;
         Length : RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Period_Base,
         "rtems_rate_monotonic_period");
   begin

      Result := Rate_Monotonic_Period_Base (ID, Length);

   end Rate_Monotonic_Period;

   procedure Rate_Monotonic_Get_Status (
      ID      : in     RTEMS.ID;
      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
      Result  :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Get_Status_Base (
         ID      : RTEMS.ID;
         Status  : access RTEMS.Rate_Monotonic_Period_Status
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Get_Status_Base,
         "rtems_rate_monotonic_get_status");

      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
   begin

      Result := Rate_Monotonic_Get_Status_Base (
         ID,
         Status_Base'Access
      );

      Status := Status_Base;


   end Rate_Monotonic_Get_Status;

   procedure Rate_Monotonic_Reset_Statistics (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Rate_Monotonic_Reset_Statistics_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Rate_Monotonic_Reset_Statistics_Base,
         "rtems_rate_monotonic_reset_statistics");
   begin

      Result := Rate_Monotonic_Reset_Statistics_Base (ID);

   end Rate_Monotonic_Reset_Statistics;


   --
   -- Barrier Manager
   --

   procedure Barrier_Create (
      Name            : in     RTEMS.Name;
      Attribute_Set   : in     RTEMS.Attribute;
      Maximum_Waiters : in     RTEMS.Unsigned32;
      ID              :    out RTEMS.ID;
      Result          :    out RTEMS.Status_Codes
   ) is
      function Barrier_Create_Base (
         Name            : RTEMS.Name;
         Attribute_Set   : RTEMS.Attribute;
         Maximum_Waiters : RTEMS.Unsigned32;
         ID              : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Barrier_Create_Base, "rtems_barrier_create");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Barrier_Create_Base (
         Name,
         Attribute_Set,
         Maximum_Waiters,
         ID_Base'Access
      );
      ID := ID_Base;

   end Barrier_Create;

   procedure Barrier_Ident (
      Name   : in     RTEMS.Name;
      ID     :    out RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Barrier_Ident_Base (
         Name : RTEMS.Name;
         ID   : access RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident");
      ID_Base : aliased RTEMS.ID;
   begin

      Result := Barrier_Ident_Base (Name, ID_Base'Access);
      ID := ID_Base;

   end Barrier_Ident;

   procedure Barrier_Delete (
      ID     : in     RTEMS.ID;
      Result :    out RTEMS.Status_Codes
   ) is
      function Barrier_Delete_Base (
         ID : RTEMS.ID
      )  return RTEMS.Status_Codes;
      pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
   begin

      Result := Barrier_Delete_Base (ID);

   end Barrier_Delete;

   procedure Barrier_Wait (
      ID         : in     RTEMS.ID;
      Timeout    : in     RTEMS.Interval;
      Result     :    out RTEMS.Status_Codes
   ) is
      function Barrier_Wait_Base (
         ID         : RTEMS.ID;
         Timeout    : RTEMS.Interval
      )  return RTEMS.Status_Codes;
      pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
   begin

      Result := Barrier_Wait_Base (ID, Timeout);

   end Barrier_Wait;

   procedure Barrier_Release (
      ID       : in     RTEMS.ID;
      Released :    out RTEMS.Unsigned32;
      Result   :    out RTEMS.Status_Codes
   ) is
      function Barrier_Release_Base (
         ID       : RTEMS.ID;
         Released : access RTEMS.Unsigned32
      )  return RTEMS.Status_Codes;
      pragma Import (C, Barrier_Release_Base, "rtems_barrier_release");
      Released_Base : aliased RTEMS.Unsigned32;
   begin

      Result := Barrier_Release_Base (ID, Released_Base'Access);
      Released := Released_Base;

   end Barrier_Release;


   --
   -- Debug Manager
   --

   procedure Debug_Enable (
      To_Be_Enabled : in     RTEMS.Debug_Set
   ) is
      procedure Debug_Enable_Base (
         To_Be_Enabled : RTEMS.Debug_Set
      );
   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
   begin

      Debug_Enable_Base (To_Be_Enabled);

   end Debug_Enable;

   procedure Debug_Disable (
      To_Be_Disabled : in     RTEMS.Debug_Set
   ) is
      procedure Debug_Disable_Base (
         To_Be_Disabled : RTEMS.Debug_Set
      );
   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
   begin

      Debug_Disable_Base (To_Be_Disabled);

   end Debug_Disable;

   function Debug_Is_Enabled (
      Level : in     RTEMS.Debug_Set
   ) return RTEMS.Boolean is
      function Debug_Is_Enabled_Base (
         Level : RTEMS.Debug_Set
      )  return RTEMS.Boolean;
      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
   begin

      return Debug_Is_Enabled_Base (Level);

   end Debug_Is_Enabled;

   --
   --  Object Services
   --

   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;

   procedure Object_Get_Classic_Name(
      ID     : in     RTEMS.ID;
      Name   :    out RTEMS.Name;
      Result :    out RTEMS.Status_Codes
   ) is
      function Object_Get_Classic_Name_Base (
         ID   : RTEMS.ID;
         Name : access RTEMS.Name
      )  return RTEMS.Status_Codes;
      pragma Import
         (C, Object_Get_Classic_Name_Base, "rtems_object_get_classic_name");
      Tmp_Name : aliased RTEMS.Name;
   begin
      Result := Object_Get_Classic_Name_Base (ID, Tmp_Name'Access);
      Name := Tmp_Name;
   end Object_Get_Classic_Name;


   procedure Object_Get_Name(
      ID     : in     RTEMS.ID;
      Name   :    out String;
      Result :    out RTEMS.Address
   ) is
      function Object_Get_Name_Base (
         ID     : RTEMS.ID;
         Length : RTEMS.Unsigned32;
         Name   : RTEMS.Address
      )  return RTEMS.Address;
      pragma Import (C, Object_Get_Name_Base, "rtems_object_get_name");
   begin
      Name := (others => ASCII.Nul);
      Result := Object_Get_Name_Base (
         Id,
         Name'Length,
         Name(Name'First)'Address
      );
   end Object_Get_Name;

   procedure Object_Set_Name(
      ID     : in     RTEMS.ID;
      Name   : in     String;
      Result :    out RTEMS.Status_Codes
   ) is
      function Object_Set_Name_Base (
         ID     : RTEMS.ID;
         Name   : chars_ptr
      )  return RTEMS.Status_Codes;
      pragma Import (C, Object_Set_Name_Base, "rtems_object_set_name");
      NameAsCString : chars_ptr := New_String(Name);
   begin
      Result := Object_Set_Name_Base (ID, NameAsCString);
   end Object_Set_Name;

   procedure Object_Id_Get_API(
      ID  : in     RTEMS.ID;
      API :    out RTEMS.Unsigned32
   ) is
      function Object_Id_Get_API_Base (
         ID     : RTEMS.ID
      )  return RTEMS.Unsigned32;
      pragma Import (C, Object_Id_Get_API_Base, "rtems_object_id_get_api");
   begin
      API := Object_Id_Get_API_Base (ID);
   end Object_Id_Get_API;

   procedure Object_Id_Get_Class(
      ID        : in     RTEMS.ID;
      The_Class :    out RTEMS.Unsigned32
   ) is
      function Object_Id_Get_Class_Base (
         ID : RTEMS.ID
      )  return RTEMS.Unsigned32;
      pragma Import (C, Object_Id_Get_Class_Base, "rtems_object_id_get_class");
   begin
      The_Class := Object_Id_Get_Class_Base (ID);
   end Object_Id_Get_Class;

   procedure Object_Id_Get_Node(
      ID   : in     RTEMS.ID;
      Node :    out RTEMS.Unsigned32
   ) is
      function Object_Id_Get_Node_Base (
         ID     : RTEMS.ID
      )  return RTEMS.Unsigned32;
      pragma Import (C, Object_Id_Get_Node_Base, "rtems_object_id_get_node");
   begin
      Node := Object_Id_Get_Node_Base (ID);
   end Object_Id_Get_Node;

   procedure Object_Id_Get_Index(
      ID    : in     RTEMS.ID;
      Index :    out RTEMS.Unsigned32
   ) is
      function Object_Id_Get_Index_Base (
         ID     : RTEMS.ID
      )  return RTEMS.Unsigned32;
      pragma Import (C, Object_Id_Get_Index_Base, "rtems_object_id_get_index");
   begin
      Index := Object_Id_Get_Index_Base (ID);
   end Object_Id_Get_Index;

   function Build_Id(
      The_API   : in     RTEMS.Unsigned32;
      The_Class : in     RTEMS.Unsigned32;
      The_Node  : in     RTEMS.Unsigned32;
      The_Index : in     RTEMS.Unsigned32
   ) return RTEMS.Id is
      function Build_Id_Base (
        The_API   : RTEMS.Unsigned32;
        The_Class : RTEMS.Unsigned32;
        The_Node  : RTEMS.Unsigned32;
        The_Index : RTEMS.Unsigned32
      )  return RTEMS.Id;
      pragma Import (C, Build_Id_Base, "rtems_build_id");
   begin
      return Build_Id_Base (The_API, The_Class, The_Node, The_Index);
   end Build_Id;

   function Object_Id_API_Minimum
   return RTEMS.Unsigned32 is
      function Object_Id_API_Minimum_Base return RTEMS.Unsigned32;
      pragma Import
         (C, Object_Id_API_Minimum_Base, "rtems_object_id_api_minimum");
   begin
      return Object_Id_API_Minimum_Base;
   end Object_Id_API_Minimum;

   function Object_Id_API_Maximum
   return RTEMS.Unsigned32 is
      function Object_Id_API_Maximum_Base return RTEMS.Unsigned32;
      pragma Import
         (C, Object_Id_API_Maximum_Base, "rtems_object_id_api_maximum");
   begin
      return Object_Id_API_Maximum_Base;
   end Object_Id_API_Maximum;

   procedure Object_API_Minimum_Class(
      API     : in     RTEMS.Unsigned32;
      Minimum :    out RTEMS.Unsigned32
   ) is
      function  Object_API_Minimum_Class_Base (
         API : RTEMS.Unsigned32
      )  return RTEMS.Unsigned32;
      pragma Import
         (C, Object_API_Minimum_Class_Base, "rtems_object_api_minimum_class");
   begin
      Minimum := Object_API_Minimum_Class_Base (API);
   end Object_API_Minimum_Class;

   procedure Object_API_Maximum_Class(
      API     : in     RTEMS.Unsigned32;
      Maximum :    out RTEMS.Unsigned32
   ) is
      function  Object_API_Maximum_Class_Base (
         API : RTEMS.Unsigned32
      )  return RTEMS.Unsigned32;
      pragma Import
         (C, Object_API_Maximum_Class_Base, "rtems_object_api_maximum_class");
   begin
      Maximum := Object_API_Maximum_Class_Base (API);
   end Object_API_Maximum_Class;

   -- Translate S from a C-style char* into an Ada String.
   -- If S is Null_Ptr, return "", don't raise an exception.
   -- Copied from Lovelace Tutorial
   function Value_Without_Exception(S : chars_ptr) return String is
   begin
     if S = Null_Ptr then return "";
      else return Value(S);
     end if;
   end Value_Without_Exception;
   pragma Inline(Value_Without_Exception);

   procedure Object_Get_API_Name(
      API  : in     RTEMS.Unsigned32;
      Name :    out String
   ) is
      function  Object_Get_API_Name_Base (
	API : RTEMS.Unsigned32
      )  return chars_ptr;
      pragma Import (C, Object_Get_API_Name_Base, "rtems_object_get_api_name");
      Result : chars_ptr := Object_Get_API_Name_Base (API);
      APIName : String :=  Value_Without_Exception (Result);
   begin
      Name := APIName;
   end Object_Get_API_Name;

   procedure Object_Get_API_Class_Name(
      The_API   : in     RTEMS.Unsigned32;
      The_Class : in     RTEMS.Unsigned32;
      Name      :    out String
   ) is
      function  Object_Get_API_Class_Name_Base (
	API   : RTEMS.Unsigned32;
	Class : RTEMS.Unsigned32
      )  return chars_ptr;
      pragma Import
         (C, Object_Get_API_Class_Name_Base, "rtems_object_get_api_class_name");
      Result : chars_ptr := Object_Get_API_Class_Name_Base (The_API, The_Class);
      ClassName : String :=  Value_Without_Exception (Result);
   begin
      Name := ClassName;
   end Object_Get_API_Class_Name;

   procedure Object_Get_Class_Information(
      The_API   : in     RTEMS.Unsigned32;
      The_Class : in     RTEMS.Unsigned32;
      Info      :    out RTEMS.Object_API_Class_Information;
      Result    :    out RTEMS.Status_Codes
   ) is
      function  Object_Get_Class_Information_Base (
	The_API   : RTEMS.Unsigned32;
	The_Class : RTEMS.Unsigned32;
	Info      : access RTEMS.Object_API_Class_Information
      )  return RTEMS.Status_Codes;
      pragma Import (
         C,
         Object_Get_Class_Information_Base,
         "rtems_object_get_class_information"
      );
      TmpInfo : aliased RTEMS.Object_API_Class_Information;
   begin
      Result :=  Object_Get_Class_Information_Base
         (The_API, The_Class, TmpInfo'Access);
      Info := TmpInfo;
   end Object_Get_Class_Information;

end RTEMS;