RTOS/rtems
1
0
Fork 0
forked from Imagelibrary/rtems
Code Pull Requests Activity

2007-10-10 Glenn Humphrey <glenn.humphrey@OARcorp.com>

Browse Source 
* rtems.adb, rtems.ads: Cleaned up binding and removed bindings for
	things that are not reasonable to do in Ada.
This commit is contained in:
Glenn Humphrey
2007-10-10 20:46:33 +00:00
parent 5a9f3725d7
commit d14963bf94
3 changed files with 98 additions and 299 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
c/src/ada/ChangeLog
View File

@@ -1,3 +1,8 @@
2007-10-10 Glenn Humphrey <glenn.humphrey@OARcorp.com>
* rtems.adb, rtems.ads: Cleaned up binding and removed bindings for
things that are not reasonable to do in Ada.
2007-10-01 Joel Sherrill <joel.sherrill@OARcorp.com> 2007-10-01 Joel Sherrill <joel.sherrill@OARcorp.com>
* rtems.adb, rtems.ads: Most of single processor Ada tests now build. * rtems.adb, rtems.ads: Most of single processor Ada tests now build.

223
c/src/ada/rtems.adb
View File

@@ -449,6 +449,72 @@ package body RTEMS is
end Task_Set_Note; end Task_Set_Note;
procedure Task_Variable_Add (
ID : in RTEMS.ID;
Task_Variable : in RTEMS.Address;
Dtor : in RTEMS.Task_Variable_Dtor;
Result : out RTEMS.Status_Codes
) is
function Task_Variable_Add_Base (
ID : RTEMS.ID;
Task_Variable : RTEMS.Address;
Dtor : RTEMS.Task_Variable_Dtor
) return RTEMS.Status_Codes;
pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
begin
Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
end Task_Variable_Add;
procedure Task_Variable_Get (
ID : in RTEMS.ID;
Task_Variable : out RTEMS.Address;
Task_Variable_Value : out RTEMS.Address;
Result : out RTEMS.Status_Codes
) is
function Task_Variable_Get_Base (
ID : RTEMS.ID;
Task_Variable : access RTEMS.Address;
Task_Variable_Value : access RTEMS.Address
) return RTEMS.Status_Codes;
pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
Task_Variable_Base : aliased RTEMS.Address;
Task_Variable_Value_Base : aliased RTEMS.Address;
begin
Result := Task_Variable_Get_Base (
ID,
Task_Variable_Base'Unchecked_Access,
Task_Variable_Value_Base'Unchecked_Access
);
Task_Variable := Task_Variable_Base;
Task_Variable_Value := Task_Variable_Value_Base;
end Task_Variable_Get;
procedure Task_Variable_Delete (
ID : in RTEMS.ID;
Task_Variable : out RTEMS.Address;
Result : out RTEMS.Status_Codes
) is
function Task_Variable_Delete_Base (
ID : RTEMS.ID;
Task_Variable : access RTEMS.Address
) return RTEMS.Status_Codes;
pragma Import (
C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
);
Task_Variable_Base : aliased RTEMS.Address;
begin
Result := Task_Variable_Delete_Base (
ID, Task_Variable_Base'Unchecked_Access
);
Task_Variable := Task_Variable_Base;
end Task_Variable_Delete;
procedure Task_Wake_When ( procedure Task_Wake_When (
Time_Buffer : in RTEMS.Time_Of_Day; Time_Buffer : in RTEMS.Time_Of_Day;
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
@@ -481,30 +547,6 @@ package body RTEMS is
-- Interrupt Manager -- 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;
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;
-- Interrupt_Disable is interfaced in the specification -- Interrupt_Disable is interfaced in the specification
-- Interrupt_Enable is interfaced in the specification -- Interrupt_Enable is interfaced in the specification
-- Interrupt_Flash is interfaced in the specification -- Interrupt_Flash is interfaced in the specification
@@ -1557,139 +1599,6 @@ package body RTEMS is
end Port_Internal_To_External; end Port_Internal_To_External;
--
-- Input/Output Manager
--
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 : in RTEMS.Driver_Name_t_Pointer;
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.All := 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 -- Fatal Error Manager

169
c/src/ada/rtems.ads
View File

@@ -77,6 +77,7 @@ pragma Elaborate_Body (RTEMS);
True : constant RTEMS.Boolean := 1; True : constant RTEMS.Boolean := 1;
False : constant RTEMS.Boolean := 0; False : constant RTEMS.Boolean := 0;
--
-- More Types -- More Types
-- --
@@ -94,27 +95,24 @@ pragma Elaborate_Body (RTEMS);
subtype Debug_Set is RTEMS.Unsigned32; subtype Debug_Set is RTEMS.Unsigned32;
subtype Device_Major_Number is RTEMS.Unsigned32; subtype Device_Major_Number is RTEMS.Unsigned32;
subtype Device_Minor_Number is RTEMS.Unsigned32; subtype Device_Minor_Number is RTEMS.Unsigned32;
subtype Vector_Number is RTEMS.Unsigned32;
subtype ISR_Level is RTEMS.Unsigned32; subtype ISR_Level is RTEMS.Unsigned32;
subtype Node is RTEMS.Unsigned32; subtype Node is RTEMS.Unsigned32;
-- --
-- Task Related Types -- Task Related Types
-- XXXX fix this --
subtype Task_Argument is RTEMS.Unsigned32; subtype Task_Argument is RTEMS.Unsigned32;
type Task_Argument_PTR is access all Task_Argument; type Task_Argument_PTR is access all Task_Argument;
-- XXXX fix this
subtype TCB is RTEMS.Unsigned32;
type TCB_Pointer is access all RTEMS.TCB;
subtype Task_States is RTEMS.Unsigned32;
type Task_Entry is access procedure ( type Task_Entry is access procedure (
Argument : RTEMS.Unsigned32 Argument : RTEMS.Unsigned32
); );
subtype TCB is RTEMS.Unsigned32;
type TCB_Pointer is access all RTEMS.TCB;
-- --
-- Clock and Time of Day Types -- Clock and Time of Day Types
-- --
@@ -144,42 +142,6 @@ pragma Elaborate_Body (RTEMS);
Clock_Get_Time_Value Clock_Get_Time_Value
); );
--
-- Device Driver Entry Prototype
--
type Device_Driver_Entry is access function (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Major_Number;
Argument : in RTEMS.Unsigned32;
ID : in RTEMS.Unsigned32
) return RTEMS.Unsigned32;
type Driver_Address_Table_Entry is
record
Initialization : RTEMS.Device_Driver_Entry;
Open : RTEMS.Device_Driver_Entry;
Close : RTEMS.Device_Driver_Entry;
Read : RTEMS.Device_Driver_Entry;
Write : RTEMS.Device_Driver_Entry;
Control : RTEMS.Device_Driver_Entry;
end record;
type Driver_Address_Table is array ( RTEMS.Unsigned32
range 1 .. RTEMS.Unsigned32'Last ) of RTEMS.Driver_Address_Table_Entry;
type Driver_Address_Table_Pointer is access all Driver_Address_Table;
type Driver_Name_t is
record
Device_Name : RTEMS.Address;
Device_Name_Length : RTEMS.Unsigned32;
Major : RTEMS.Device_Major_Number;
Minor : RTEMS.Device_Minor_Number;
end record;
type Driver_Name_t_Pointer is access all Driver_Name_t;
-- --
-- Ident Options -- Ident Options
-- --
@@ -249,7 +211,6 @@ pragma Elaborate_Body (RTEMS);
Minimum_Stack_Size : RTEMS.Unsigned32; Minimum_Stack_Size : RTEMS.Unsigned32;
pragma Import (C, Minimum_Stack_Size, "rtems_minimum_stack_size"); pragma Import (C, Minimum_Stack_Size, "rtems_minimum_stack_size");
-- --
-- Notepad index constants -- Notepad index constants
-- --
@@ -282,15 +243,14 @@ pragma Elaborate_Body (RTEMS);
Current_Priority : constant RTEMS.Task_Priority := 0; Current_Priority : constant RTEMS.Task_Priority := 0;
No_Priority : constant RTEMS.Task_Priority := 0; No_Priority : constant RTEMS.Task_Priority := 0;
-- --
-- Extension Callouts and Table -- Extension Callouts and Table
-- --
type Thread_Create_Extension is access procedure ( type Thread_Create_Extension is access function (
Current_Task : in RTEMS.TCB_Pointer; Current_Task : in RTEMS.TCB_Pointer;
New_Task : in RTEMS.TCB_Pointer New_Task : in RTEMS.TCB_Pointer
); ) return RTEMS.Boolean;
type Thread_Start_Extension is access procedure ( type Thread_Start_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer; Current_Task : in RTEMS.TCB_Pointer;
@@ -538,15 +498,6 @@ pragma Elaborate_Body (RTEMS);
Signal_30 : constant RTEMS.Signal_Set := 16#40000000#; Signal_30 : constant RTEMS.Signal_Set := 16#40000000#;
Signal_31 : constant RTEMS.Signal_Set := 16#80000000#; Signal_31 : constant RTEMS.Signal_Set := 16#80000000#;
--
-- For now, do not provide access to the CPU Table from Ada.
-- When this type is provided, a CPU dependent file must
-- define it.
--
subtype CPU_Table is RTEMS.Address;
type CPU_Table_Pointer is access all CPU_Table;
-- --
-- Utility Functions -- Utility Functions
-- --
@@ -612,6 +563,8 @@ pragma Elaborate_Body (RTEMS);
Left : in RTEMS.Address; Left : in RTEMS.Address;
Right : in RTEMS.Address Right : in RTEMS.Address
) return Standard.Boolean; ) return Standard.Boolean;
-- --
-- RTEMS API -- RTEMS API
-- --
@@ -704,25 +657,25 @@ pragma Elaborate_Body (RTEMS);
Argument : in RTEMS.Address Argument : in RTEMS.Address
); );
-- procedure Task_Variable_Add ( procedure Task_Variable_Add (
-- ID : in RTEMS.ID; ID : in RTEMS.ID;
-- Task_Variable : in RTEMS.Address; Task_Variable : in RTEMS.Address;
-- Dtor : in RTEMS.Task_Variable_Dtor; Dtor : in RTEMS.Task_Variable_Dtor;
-- Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
-- ); );
-- procedure Task_Variable_Get ( procedure Task_Variable_Get (
-- ID : in RTEMS.ID; ID : in RTEMS.ID;
-- Task_Variable : out RTEMS.Address; Task_Variable : out RTEMS.Address;
-- Task_Variable_Value : out RTEMS.Address; Task_Variable_Value : out RTEMS.Address;
-- Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
-- ); );
-- procedure Task_Variable_Delete ( procedure Task_Variable_Delete (
-- ID : in RTEMS.ID; ID : in RTEMS.ID;
-- Task_Variable : out RTEMS.Address; Task_Variable : out RTEMS.Address;
-- Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
-- ); );
procedure Task_Wake_When ( procedure Task_Wake_When (
Time_Buffer : in RTEMS.Time_Of_Day; Time_Buffer : in RTEMS.Time_Of_Day;
@@ -738,13 +691,6 @@ pragma Elaborate_Body (RTEMS);
-- Interrupt Manager -- 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
);
function Interrupt_Disable return RTEMS.ISR_Level; function Interrupt_Disable return RTEMS.ISR_Level;
pragma Interface (C, Interrupt_Disable); pragma Interface (C, Interrupt_Disable);
pragma Interface_Name (Interrupt_Disable, "rtems_interrupt_disable"); pragma Interface_Name (Interrupt_Disable, "rtems_interrupt_disable");
@@ -807,7 +753,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Timer Manager -- Timer Manager
-- --
@@ -915,7 +860,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Message Queue Manager -- Message Queue Manager
-- --
@@ -978,7 +922,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Event Manager -- Event Manager
-- --
@@ -1013,7 +956,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Partition Manager -- Partition Manager
-- --
@@ -1052,7 +994,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Region Manager -- Region Manager
-- --
@@ -1107,7 +1048,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Dual Ported Memory Manager -- Dual Ported Memory Manager
-- --
@@ -1146,59 +1086,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
--
-- Input/Output Manager
--
procedure IO_Register_Name (
Name : in String;
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Result : out RTEMS.Status_Codes
);
procedure IO_Lookup_Name (
Name : in String;
Device_Info : In RTEMS.Driver_Name_t_Pointer;
Result : out RTEMS.Status_Codes
);
procedure IO_Open (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Argument : in RTEMS.Address;
Result : out RTEMS.Status_Codes
);
procedure IO_Close (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Argument : in RTEMS.Address;
Result : out RTEMS.Status_Codes
);
procedure IO_Read (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Argument : in RTEMS.Address;
Result : out RTEMS.Status_Codes
);
procedure IO_Write (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Argument : in RTEMS.Address;
Result : out RTEMS.Status_Codes
);
procedure IO_Control (
Major : in RTEMS.Device_Major_Number;
Minor : in RTEMS.Device_Minor_Number;
Argument : in RTEMS.Address;
Result : out RTEMS.Status_Codes
);
-- --
-- Fatal Error Manager -- Fatal Error Manager
-- --
@@ -1207,7 +1094,6 @@ pragma Elaborate_Body (RTEMS);
The_Error : in RTEMS.Unsigned32 The_Error : in RTEMS.Unsigned32
); );
-- --
-- Rate Monotonic Manager -- Rate Monotonic Manager
-- --
@@ -1246,7 +1132,6 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
-- --
-- Debug Manager -- Debug Manager
-- --