diff options
Diffstat (limited to 'c/src/ada/rtems.adb')
| -rw-r--r-- | c/src/ada/rtems.adb | 2035 |
1 files changed, 0 insertions, 2035 deletions
diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb deleted file mode 100644 index 9bd7432be1..0000000000 --- a/c/src/ada/rtems.adb +++ /dev/null @@ -1,2035 +0,0 @@ --- --- RTEMS / Body --- DESCRIPTION: --- --- This package provides the interface to the RTEMS API. --- --- --- DEPENDENCIES: --- --- --- --- COPYRIGHT (c) 1997. --- 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.OARcorp.com/rtems/license.html. --- --- $Id$ --- - -with Ada; -with Ada.Unchecked_Conversion; -with System; -with Interfaces; use Interfaces; -with Interfaces.C; - -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; - - 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 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 - -- - - procedure Initialize_Executive ( - Configuration_Table : in RTEMS.Configuration_Table_Pointer; - CPU_Table : in RTEMS.CPU_Table_Pointer - ) is - procedure Initialize_Executive_Base ( - Configuration_Table : in RTEMS.Configuration_Table_Pointer; - CPU_Table : in RTEMS.CPU_Table_Pointer - ); - pragma Import (C, Initialize_Executive_Base, - "rtems_initialize_executive"); - - begin - - Initialize_Executive_Base (Configuration_Table, CPU_Table); - - end Initialize_Executive; - - procedure Initialize_Executive_Early ( - Configuration_Table : in RTEMS.Configuration_Table_Pointer; - CPU_Table : in RTEMS.CPU_Table_Pointer; - Level : out RTEMS.ISR_Level - ) is - function Initialize_Executive_Early_Base ( - Configuration_Table : in RTEMS.Configuration_Table_Pointer; - CPU_Table : in RTEMS.CPU_Table_Pointer - ) return RTEMS.ISR_Level; - pragma Import (C, Initialize_Executive_Early_Base, - "rtems_initialize_executive_early"); - - begin - - Level := Initialize_Executive_Early_Base (Configuration_Table, CPU_Table); - - end Initialize_Executive_Early; - - procedure Initialize_Executive_Late ( - BSP_Level : in RTEMS.ISR_Level - ) is - procedure Initialize_Executive_Late_Base ( - Level : in RTEMS.ISR_Level - ); - pragma Import (C, Initialize_Executive_Late_Base, - "rtems_initialize_executive_late"); - - begin - - Initialize_Executive_Late_Base (BSP_Level); - - end Initialize_Executive_Late; - - procedure Shutdown_Executive ( - Result : in RTEMS.Unsigned32 - ) is - procedure Shutdown_Executive_Base; - pragma Import (C,Shutdown_Executive_Base,"rtems_shutdown_executive"); - begin - - Shutdown_Executive_Base; - - 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 := ID; - begin - Result := Task_Create_Base ( - Name, - Initial_Priority, - Stack_Size, - Initial_Modes, - Attribute_Set, - ID_Base'Unchecked_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 := ID; - - begin - - Result := Task_Ident_Base ( - Name, - Node, - ID_Base'Unchecked_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_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 := Old_Priority; - - begin - - Result := Task_Set_Priority_Base ( - ID, - New_Priority, - Old_Priority_Base'Unchecked_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 := Previous_Mode_Set; - begin - - Result := Task_Mode_Base ( - Mode_Set, - Mask, - Previous_Mode_Set_Base'Unchecked_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 := Note; - begin - - Result := Task_Get_Note_Base ( - ID, - Notepad, - Note_Base'Unchecked_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_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 - -- - - procedure Interrupt_Catch ( - New_ISR_Handler : in RTEMS.Address; - Vector : in RTEMS.Vector_Number; - Old_ISR_Handler : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Interrupt_Catch_Base ( - New_ISR_Handler : RTEMS.Address; - Vector : RTEMS.Vector_Number; - Old_ISR_Handler : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Interrupt_Catch_Base, "rtems_interrupt_catch"); - Old_ISR_Handler_Base : aliased RTEMS.Address := Old_ISR_Handler; - begin - - Result := Interrupt_Catch_Base ( - New_ISR_Handler, - Vector, - OLD_ISR_HANDLER_Base'Unchecked_Access - ); - - Old_ISR_Handler := OLD_ISR_HANDLER_Base; - - end Interrupt_Catch; - - -- XXX - function Interrupt_Disable - return RTEMS.ISR_Level is - begin - return 0; - end Interrupt_Disable; - - procedure Interrupt_Enable ( - Level : in RTEMS.ISR_Level - ) is - begin - Null; - end Interrupt_Enable; - - procedure Interrupt_Flash ( - Level : in RTEMS.ISR_Level - ) is - begin - Null; - end Interrupt_Flash; - - function Interrupt_Is_In_Progress - return RTEMS.Boolean is - begin - return RTEMS.From_Ada_Boolean (Standard.True); - end Interrupt_Is_In_Progress; - - -- - -- Clock Manager - -- - - 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_Set ( - Time_Buffer : in RTEMS.Time_Of_Day; - Result : out RTEMS.Status_Codes - ) is - function Clock_Set_base ( - Time_Buffer : RTEMS.Time_Of_Day - ) return RTEMS.Status_Codes; - pragma Import (C, Clock_Set_base, "rtems_clock_set"); - begin - - Result := Clock_Set_base ( Time_Buffer ); - - end Clock_Set; - - 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 := ID; - begin - - Result := Extension_Create_Base ( - Name, - Table, - ID_Base'Unchecked_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 := ID; - begin - - Result := Extension_Ident_Base ( - Name, - ID_Base'Unchecked_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 := ID; - begin - - Result := Timer_Create_Base ( - Name, - ID_Base'Unchecked_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 := ID; - begin - - Result := Timer_Ident_Base ( - Name, - ID_Base'Unchecked_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_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 ( - ID : RTEMS.ID; - Wall_Time : in RTEMS.Time_Of_Day; - Routine : RTEMS.Timer_Service_Routine; - User_Data : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Fire_When, "rtems_timer_fire_when"); - begin - - Result := Timer_Fire_When ( - ID, - Wall_Time, - Routine, - User_Data - ); - - end Timer_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; - - -- - -- 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 := ID; - begin - - Result := Semaphore_Create_Base ( - Name, - Count, - Attribute_Set, - Priority_Ceiling, - ID_Base'Unchecked_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 := ID; - begin - - Result := Semaphore_Ident_Base ( - Name, - Node, - ID_Base'Unchecked_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; - - -- - -- 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 := ID; - begin - - Result := Message_Queue_Create_Base ( - Name, - Count, - Max_Message_Size, - Attribute_Set, - ID_Base'Unchecked_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 := ID; - begin - - Result := Message_Queue_Ident_Base ( - Name, - Node, - ID_Base'Unchecked_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 := Count; - begin - - Result := Message_Queue_Broadcast_Base ( - ID, - Buffer, - Size, - Count_Base'Unchecked_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 : 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 - - Result := Message_Queue_Receive_Base ( - ID, - Buffer, - Size_Base'Unchecked_Access, - Option_Set, - Timeout - ); - - Size := Size_Base; - - end Message_Queue_Receive; - - 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 := Count; - begin - - Result := Message_Queue_Flush_Base ( - ID, - COUNT_Base'Unchecked_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; -- := Event_Out; - 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 := ID; - begin - - Result := Partition_Create_Base ( - Name, - Starting_Address, - Length, - Buffer_Size, - Attribute_Set, - ID_Base'Unchecked_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 := ID; - begin - - Result := Partition_Ident_Base ( - Name, - Node, - ID_Base'Unchecked_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 := Buffer; - begin - - Result := Partition_Get_Buffer_Base ( - ID, - Buffer_Base'Unchecked_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 := ID; - - begin - - Result := Region_Create_Base ( - Name, - Starting_Address, - Length, - Page_Size, - Attribute_Set, - ID_Base'Unchecked_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 := ID; - begin - - Result := Region_Ident_Base ( - Name, - ID_Base'Unchecked_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 := Segment; - begin - - Result := Region_Get_Segment_Base ( - ID, - Size, - Option_Set, - Timeout, - Segment_Base'Unchecked_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 := Size; - begin - - Result := Region_Get_Segment_Size_Base ( - ID, - Segment, - Size_Base'Unchecked_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; - - - -- - -- 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 := ID; - - begin - - Result := Port_Create_Base ( - Name, - Internal_Start, - External_Start, - Length, - ID_Base'Unchecked_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 := ID; - begin - - Result := Port_Ident_Base ( - Name, - ID_Base'Unchecked_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 := Internal; - begin - - Result := Port_External_To_Internal_Base ( - ID, - External, - Internal_Base'Unchecked_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 := External; - begin - - Result := Port_Internal_To_External_Base ( - ID, - Internal, - External_Base'Unchecked_Access - ); - - External := EXTERNAL_Base; - - end Port_Internal_To_External; - - -- - -- Input/Output Manager - -- - - procedure IO_Initialize ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Return_Value : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function IO_Initialize_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address; - Return_Value : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Initialize_Base, "rtems_io_initialize"); - Return_Value_Base : aliased RTEMS.Unsigned32 := Return_Value; - begin - - Result := IO_Initialize_Base ( - Major, - Minor, - Argument, - Return_Value_Base'Unchecked_Access - ); - - Return_Value := Return_Value_Base; - - end IO_Initialize; - - procedure IO_Register_Name ( - Name : in String; - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Result : out RTEMS.Status_Codes - ) is - function IO_Register_Name_Base ( - Name : Interfaces.C.Char_Array; - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Register_Name_Base, "rtems_io_register_name"); - begin - - Result := IO_Register_Name_Base ( - Interfaces.C.To_C (Name), - Major, - Minor - ); - - end IO_Register_Name; - - procedure IO_Lookup_Name ( - Name : in String; - Device_Info : out RTEMS.Driver_Name_t; - Result : out RTEMS.Status_Codes - ) is - function IO_Lookup_Name_Base ( - Name : Interfaces.C.Char_Array; - Device_Info : access RTEMS.Driver_Name_t - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Lookup_Name_Base, "rtems_io_lookup_name"); - - Device_Info_Base : aliased RTEMS.Driver_Name_t; - begin - - Result := IO_Lookup_Name_Base ( - Interfaces.C.To_C (Name), - Device_Info_Base'Unchecked_Access - ); - - Device_Info := Device_Info_Base; - - end IO_Lookup_Name; - - procedure IO_Open ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function IO_Open_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Open_Base, "rtems_io_open"); - begin - - Result := IO_Open_Base (Major, Minor, Argument); - - end IO_Open; - - procedure IO_Close ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function IO_Close_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Close_Base, "rtems_io_close"); - begin - - Result := IO_Close_Base (Major, Minor, Argument); - - end IO_Close; - - procedure IO_Read ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function IO_Read_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Read_Base, "rtems_io_read"); - begin - - Result := IO_Read_Base (Major, Minor, Argument); - - end IO_Read; - - procedure IO_Write ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function IO_Write_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Write_Base, "rtems_io_write"); - begin - - Result := IO_Write_Base (Major, Minor, Argument); - - end IO_Write; - - procedure IO_Control ( - Major : in RTEMS.Device_Major_Number; - Minor : in RTEMS.Device_Minor_Number; - Argument : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function IO_Control_Base ( - Major : RTEMS.Device_Major_Number; - Minor : RTEMS.Device_Minor_Number; - Argument : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, IO_Control_Base, "rtems_io_control"); - begin - - Result := IO_Control_Base (Major, Minor, Argument); - - end IO_Control; - - - -- - -- 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 := ID; - begin - - Result := Rate_Monotonic_Create_base ( - Name, - ID_Base'Unchecked_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 := ID; - begin - - Result := Rate_Monotonic_Ident_Base ( - Name, - ID_Base'Unchecked_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'Unchecked_Access - ); - - Status := Status_Base; - - - end Rate_Monotonic_Get_Status; - - -- - -- Multiprocessing Manager - -- - - procedure Multiprocessing_Announce is - procedure Multiprocessing_Announce_Base; - pragma Import (C, Multiprocessing_Announce_Base, - "rtems_multiprocessing_announce"); - begin - - Multiprocessing_Announce_Base; - - end Multiprocessing_Announce; - - - -- - -- 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; - - -- HACK - -- function Configuration - -- return RTEMS.Configuration_Table_Pointer is - -- Configuration_base : RTEMS.Configuration_Table_Pointer; - -- pragma Import (C, Configuration_base, "_Configuration_Table"); - -- begin - -- return Configuration_Base; - -- end Configuration; - -end RTEMS; - |