diff options
Diffstat (limited to 'c/src/ada/rtems.adb')
-rw-r--r-- | c/src/ada/rtems.adb | 232 |
1 files changed, 0 insertions, 232 deletions
diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb deleted file mode 100644 index e717f42bab..0000000000 --- a/c/src/ada/rtems.adb +++ /dev/null @@ -1,232 +0,0 @@ --- 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.org/license/LICENSE. --- - -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; |