--
-- 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_Is_Suspended (
ID : in RTEMS.ID;
Result : out RTEMS.Status_Codes
) is
function Task_Is_Suspended (
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 := 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;
