summaryrefslogtreecommitdiffstats
path: root/c
diff options
context:
space:
mode:
authorJoel Sherrill <joel.sherrill@OARcorp.com>2002-02-01 18:58:21 +0000
committerJoel Sherrill <joel.sherrill@OARcorp.com>2002-02-01 18:58:21 +0000
commit7003847359db0ba1e394d2f3f3782f805c9fbb39 (patch)
treeb043b792966cf513ddcde25ee586b7cdbac36e1c /c
parent569a01fed1adb8c5c125054ab18604663a88ccc2 (diff)
downloadrtems-7003847359db0ba1e394d2f3f3782f805c9fbb39.tar.bz2
2001-02-01 Joel Sherrill <joel@OARcorp.com>
* rtems.ads, rtems.adb: Formatting cleaned up. Task based timer directives added. This is Timer_Initiate_Server, Timer_Server_Fire_After, and Timer_Server_Fire_When.
Diffstat (limited to 'c')
-rw-r--r--c/src/ada/ChangeLog6
-rw-r--r--c/src/ada/rtems-multiprocessing.adb38
-rw-r--r--c/src/ada/rtems-multiprocessing.ads30
-rw-r--r--c/src/ada/rtems.adb408
-rw-r--r--c/src/ada/rtems.ads86
5 files changed, 274 insertions, 294 deletions
diff --git a/c/src/ada/ChangeLog b/c/src/ada/ChangeLog
index 4eeda131ec..9f04eef89f 100644
--- a/c/src/ada/ChangeLog
+++ b/c/src/ada/ChangeLog
@@ -1,4 +1,10 @@
2001-02-01 Joel Sherrill <joel@OARcorp.com>
+ * rtems.ads, rtems.adb: Formatting cleaned up. Task based timer
+ directives added. This is Timer_Initiate_Server,
+ Timer_Server_Fire_After, and Timer_Server_Fire_When.
+
+2001-02-01 Joel Sherrill <joel@OARcorp.com>
+
* ChangeLog: New file.
diff --git a/c/src/ada/rtems-multiprocessing.adb b/c/src/ada/rtems-multiprocessing.adb
new file mode 100644
index 0000000000..9e196f5e8b
--- /dev/null
+++ b/c/src/ada/rtems-multiprocessing.adb
@@ -0,0 +1,38 @@
+--
+-- RTEMS Multiprocessing Manager/ Body
+--
+-- DESCRIPTION:
+--
+-- This package provides the interface to the Multiprocessing Manager
+-- of 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$
+--
+
+package body RTEMS.Multiprocessing is
+
+ --
+ -- Announce
+ --
+
+ procedure Announce is
+ procedure Multiprocessing_Announce_Base;
+ pragma Import (C, Multiprocessing_Announce_Base,
+ "rtems_multiprocessing_announce");
+ begin
+
+ Multiprocessing_Announce_Base;
+
+ end Announce;
+
+end RTEMS.Multiprocessing;
diff --git a/c/src/ada/rtems-multiprocessing.ads b/c/src/ada/rtems-multiprocessing.ads
new file mode 100644
index 0000000000..6a4a63d365
--- /dev/null
+++ b/c/src/ada/rtems-multiprocessing.ads
@@ -0,0 +1,30 @@
+--
+-- RTEMS Multiprocessing Manager/ Specification
+--
+-- DESCRIPTION:
+--
+-- This package provides the interface to the Multiprocessing Manager
+-- of 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$
+--
+
+package RTEMS.Multiprocessing is
+
+ --
+ -- Multiprocessing Manager
+ --
+
+ procedure Announce;
+
+end RTEMS.Multiprocessing;
diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb
index 44cd0838a3..801150e4c1 100644
--- a/c/src/ada/rtems.adb
+++ b/c/src/ada/rtems.adb
@@ -1,5 +1,6 @@
--
-- RTEMS / Body
+--
-- DESCRIPTION:
--
-- This package provides the interface to the RTEMS API.
@@ -160,7 +161,6 @@ package body RTEMS is
end Get_Index;
-
function Are_Statuses_Equal (
Status : in RTEMS.Status_Codes;
Desired : in RTEMS.Status_Codes
@@ -210,7 +210,6 @@ package body RTEMS is
return (To_Unsigned32(Left) = To_Unsigned32(Right));
end Are_Equal;
-
--
--
-- RTEMS API
@@ -281,7 +280,6 @@ package body RTEMS is
end Shutdown_Executive;
-
--
-- Task Manager
--
@@ -303,21 +301,20 @@ package body RTEMS is
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;
+ 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
- );
+ 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;
@@ -335,12 +332,7 @@ package body RTEMS is
begin
- Result := Task_Ident_Base (
- Name,
- Node,
- ID_Base'Unchecked_Access
- );
-
+ Result := Task_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
ID := ID_Base;
end Task_Ident;
@@ -351,21 +343,15 @@ package body RTEMS is
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
- );
+ Result := Task_Start_Base ( ID, Entry_Point, Argument );
end Task_Start;
@@ -381,10 +367,7 @@ package body RTEMS is
pragma Import (C, Task_Restart_Base, "rtems_task_restart");
begin
- Result := Task_Restart_Base (
- ID,
- Argument
- );
+ Result := Task_Restart_Base ( ID, Argument );
end Task_Restart;
@@ -429,21 +412,6 @@ package body RTEMS is
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;
@@ -458,15 +426,13 @@ package body RTEMS is
) 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
- );
-
+ ID,
+ New_Priority,
+ Old_Priority_Base'Unchecked_Access
+ );
Old_Priority := Old_Priority_Base;
end Task_Set_Priority;
@@ -491,7 +457,6 @@ package body RTEMS is
Mask,
Previous_Mode_Set_Base'Unchecked_Access
);
-
Previous_Mode_Set := Previous_Mode_Set_Base;
end Task_Mode;
@@ -511,12 +476,7 @@ package body RTEMS is
Note_Base : aliased RTEMS.Unsigned32 := Note;
begin
- Result := Task_Get_Note_Base (
- ID,
- Notepad,
- Note_Base'Unchecked_Access
- );
-
+ Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access );
Note := NOTE_Base;
end Task_Get_Note;
@@ -591,37 +551,14 @@ package body RTEMS is
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;
+ -- Interrupt_Disable is interfaced in the specification
+ -- Interrupt_Enable is interfaced in the specification
+ -- Interrupt_Flash is interfaced in the specification
+ -- Interrupt_Is_In_Progress is interfaced in the specification
--
-- Clock Manager
@@ -687,12 +624,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Extension_Create_Base (
- Name,
- Table,
- ID_Base'Unchecked_Access
- );
-
+ Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
ID := ID_Base;
end Extension_Create;
@@ -710,11 +642,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Extension_Ident_Base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Extension_Ident;
@@ -750,11 +678,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Timer_Create_Base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Timer_Create;
@@ -772,11 +696,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Timer_Ident_Base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Timer_Ident;
@@ -811,15 +731,34 @@ package body RTEMS is
pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
begin
- Result := Timer_Fire_After_Base (
- ID,
- Ticks,
- Routine,
- User_Data
- );
+ Result := Timer_Fire_After_Base ( ID, Ticks, Routine, User_Data );
end Timer_Fire_After;
+ procedure Timer_Server_Fire_After (
+ ID : in RTEMS.ID;
+ Ticks : in RTEMS.Interval;
+ Routine : in RTEMS.Timer_Service_Routine;
+ User_Data : in RTEMS.Address;
+ Result : out RTEMS.Status_Codes
+ ) is
+ function Timer_Server_Fire_After_Base (
+ ID : RTEMS.ID;
+ Ticks : RTEMS.Interval;
+ Routine : RTEMS.Timer_Service_Routine;
+ User_Data : RTEMS.Address
+ ) return RTEMS.Status_Codes;
+ pragma Import (
+ C,
+ Timer_Server_Fire_After_Base,
+ "rtems_timer_server_fire_after"
+ );
+ begin
+
+ Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data );
+
+ end Timer_Server_Fire_After;
+
procedure Timer_Fire_When (
ID : in RTEMS.ID;
Wall_Time : in RTEMS.Time_Of_Day;
@@ -827,24 +766,43 @@ package body RTEMS is
User_Data : in RTEMS.Address;
Result : out RTEMS.Status_Codes
) is
- function Timer_Fire_When (
+ function Timer_Fire_When_Base (
ID : RTEMS.ID;
- Wall_Time : in RTEMS.Time_Of_Day;
+ Wall_Time : RTEMS.Time_Of_Day;
Routine : RTEMS.Timer_Service_Routine;
User_Data : RTEMS.Address
) return RTEMS.Status_Codes;
- pragma Import (C, Timer_Fire_When, "rtems_timer_fire_when");
+ pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
begin
- Result := Timer_Fire_When (
- ID,
- Wall_Time,
- Routine,
- User_Data
- );
+ Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
end Timer_Fire_When;
+ procedure Timer_Server_Fire_When (
+ ID : in RTEMS.ID;
+ Wall_Time : in RTEMS.Time_Of_Day;
+ Routine : in RTEMS.Timer_Service_Routine;
+ User_Data : in RTEMS.Address;
+ Result : out RTEMS.Status_Codes
+ ) is
+ function Timer_Server_Fire_When_Base (
+ ID : RTEMS.ID;
+ Wall_Time : RTEMS.Time_Of_Day;
+ Routine : RTEMS.Timer_Service_Routine;
+ User_Data : RTEMS.Address
+ ) return RTEMS.Status_Codes;
+ pragma Import (
+ C,
+ Timer_Server_Fire_When_Base,
+ "rtems_timer_server_fire_when"
+ );
+ begin
+
+ Result :=
+ Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
+ end Timer_Server_Fire_When;
+
procedure Timer_Reset (
ID : in RTEMS.ID;
Result : out RTEMS.Status_Codes
@@ -873,6 +831,30 @@ package body RTEMS is
end Timer_Cancel;
+ procedure Timer_Initiate_Server (
+ Server_Priority : in RTEMS.Task_Priority;
+ Stack_Size : in RTEMS.Unsigned32;
+ Attribute_Set : in RTEMS.Attribute;
+ Result : out RTEMS.Status_Codes
+ ) is
+ function Timer_Initiate_Server_Base (
+ Server_Priority : RTEMS.Task_Priority;
+ Stack_Size : RTEMS.Unsigned32;
+ Attribute_Set : RTEMS.Attribute
+ ) return RTEMS.Status_Codes;
+ pragma Import (
+ C,
+ Timer_Initiate_Server_Base,
+ "rtems_timer_initiate_server"
+ );
+ begin
+ Result := Timer_Initiate_Server_Base (
+ Server_Priority,
+ Stack_Size,
+ Attribute_Set
+ );
+ end Timer_Initiate_Server;
+
--
-- Semaphore Manager
--
@@ -903,7 +885,6 @@ package body RTEMS is
Priority_Ceiling,
ID_Base'Unchecked_Access
);
-
ID := ID_Base;
end Semaphore_Create;
@@ -937,12 +918,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Semaphore_Ident_Base (
- Name,
- Node,
- ID_Base'Unchecked_Access
- );
-
+ Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
ID := ID_Base;
end Semaphore_Ident;
@@ -979,20 +955,6 @@ package body RTEMS is
end Semaphore_Release;
- procedure Semaphore_Flush (
- ID : in RTEMS.ID;
- Result : out RTEMS.Status_Codes
- ) is
- function Semaphore_Flush_Base (
- ID : RTEMS.ID
- ) return RTEMS.Status_Codes;
- pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
- begin
-
- Result := Semaphore_Flush_Base ( ID );
-
- end Semaphore_Release;
-
--
-- Message Queue Manager
--
@@ -1025,7 +987,6 @@ package body RTEMS is
Attribute_Set,
ID_Base'Unchecked_Access
);
-
ID := ID_Base;
end Message_Queue_Create;
@@ -1045,12 +1006,8 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Message_Queue_Ident_Base (
- Name,
- Node,
- ID_Base'Unchecked_Access
- );
-
+ Result :=
+ Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
ID := ID_Base;
end Message_Queue_Ident;
@@ -1062,8 +1019,8 @@ package body RTEMS is
function Message_Queue_Delete_Base (
ID : RTEMS.ID
) return RTEMS.Status_Codes;
- pragma Import (C, Message_Queue_Delete_Base,
- "rtems_message_queue_delete");
+ pragma Import (
+ C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
begin
Result := Message_Queue_Delete_Base ( ID );
@@ -1126,12 +1083,11 @@ package body RTEMS is
begin
Result := Message_Queue_Broadcast_Base (
- ID,
- Buffer,
- Size,
- Count_Base'Unchecked_Access
- );
-
+ ID,
+ Buffer,
+ Size,
+ Count_Base'Unchecked_Access
+ );
Count := Count_Base;
end Message_Queue_Broadcast;
@@ -1157,13 +1113,12 @@ package body RTEMS is
begin
Result := Message_Queue_Receive_Base (
- ID,
- Buffer,
- Size_Base'Unchecked_Access,
- Option_Set,
- Timeout
- );
-
+ ID,
+ Buffer,
+ Size_Base'Unchecked_Access,
+ Option_Set,
+ Timeout
+ );
Size := Size_Base;
end Message_Queue_Receive;
@@ -1181,16 +1136,11 @@ package body RTEMS is
COUNT_Base : aliased RTEMS.Unsigned32 := Count;
begin
- Result := Message_Queue_Flush_Base (
- ID,
- COUNT_Base'Unchecked_Access
- );
-
+ Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
Count := COUNT_Base;
end Message_Queue_Flush;
-
--
-- Event Manager
--
@@ -1207,10 +1157,7 @@ package body RTEMS is
pragma Import (C, Event_Send_Base, "rtems_event_send");
begin
- Result := Event_Send_Base (
- ID,
- Event_In
- );
+ Result := Event_Send_Base ( ID, Event_In );
end Event_Send;
@@ -1232,12 +1179,11 @@ package body RTEMS is
begin
Result := Event_Receive_Base (
- Event_In,
- Option_Set,
- Ticks,
- Event_Out_Base'Access
- );
-
+ Event_In,
+ Option_Set,
+ Ticks,
+ Event_Out_Base'Access
+ );
Event_Out := Event_Out_Base;
end Event_Receive;
@@ -1312,7 +1258,6 @@ package body RTEMS is
Attribute_Set,
ID_Base'Unchecked_Access
);
-
ID := ID_Base;
end Partition_Create;
@@ -1332,12 +1277,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Partition_Ident_Base (
- Name,
- Node,
- ID_Base'Unchecked_Access
- );
-
+ Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
ID := ID_Base;
end Partition_Ident;
@@ -1370,11 +1310,7 @@ package body RTEMS is
Buffer_Base : aliased RTEMS.Address := Buffer;
begin
- Result := Partition_Get_Buffer_Base (
- ID,
- Buffer_Base'Unchecked_Access
- );
-
+ Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
Buffer := Buffer_Base;
end Partition_Get_Buffer;
@@ -1419,18 +1355,16 @@ package body RTEMS is
) 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
- );
-
+ Name,
+ Starting_Address,
+ Length,
+ Page_Size,
+ Attribute_Set,
+ ID_Base'Unchecked_Access
+ );
ID := ID_Base;
end Region_Create;
@@ -1448,11 +1382,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Region_Ident_Base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Region_Ident;
@@ -1515,7 +1445,6 @@ package body RTEMS is
Timeout,
Segment_Base'Unchecked_Access
);
-
Segment := SEGMENT_Base;
end Region_Get_Segment;
@@ -1541,7 +1470,6 @@ package body RTEMS is
Segment,
Size_Base'Unchecked_Access
);
-
Size := SIZE_Base;
end Region_Get_Segment_Size;
@@ -1563,7 +1491,6 @@ package body RTEMS is
end Region_Return_Segment;
-
--
-- Dual Ported Memory Manager
--
@@ -1585,17 +1512,15 @@ package body RTEMS is
) 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
- );
-
+ Name,
+ Internal_Start,
+ External_Start,
+ Length,
+ ID_Base'Unchecked_Access
+ );
ID := ID_Base;
end Port_Create;
@@ -1613,11 +1538,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Port_Ident_Base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Port_Ident;
@@ -1657,7 +1578,6 @@ package body RTEMS is
External,
Internal_Base'Unchecked_Access
);
-
Internal := INTERNAL_Base;
end Port_External_To_Internal;
@@ -1683,7 +1603,6 @@ package body RTEMS is
Internal,
External_Base'Unchecked_Access
);
-
External := EXTERNAL_Base;
end Port_Internal_To_External;
@@ -1715,7 +1634,6 @@ package body RTEMS is
Argument,
Return_Value_Base'Unchecked_Access
);
-
Return_Value := Return_Value_Base;
end IO_Initialize;
@@ -1734,11 +1652,8 @@ package body RTEMS is
pragma Import (C, IO_Register_Name_Base, "rtems_io_register_name");
begin
- Result := IO_Register_Name_Base (
- Interfaces.C.To_C (Name),
- Major,
- Minor
- );
+ Result :=
+ IO_Register_Name_Base ( Interfaces.C.To_C (Name), Major, Minor );
end IO_Register_Name;
@@ -1752,7 +1667,6 @@ package body RTEMS is
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
@@ -1760,7 +1674,6 @@ package body RTEMS is
Interfaces.C.To_C (Name),
Device_Info_Base'Unchecked_Access
);
-
Device_Info := Device_Info_Base;
end IO_Lookup_Name;
@@ -1855,7 +1768,6 @@ package body RTEMS is
end IO_Control;
-
--
-- Fatal Error Manager
--
@@ -1871,7 +1783,9 @@ package body RTEMS is
Fatal_Error_Occurred_Base ( The_Error );
- end Fatal_Error_Occurred;
+ end Fatal_Error_Occurred;
+
+
--
-- Rate Monotonic Manager
--
@@ -1889,11 +1803,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Rate_Monotonic_Create_base (
- Name,
- ID_Base'Unchecked_Access
- );
-
+ Result := Rate_Monotonic_Create_base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
end Rate_Monotonic_Create;
@@ -1911,10 +1821,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID := ID;
begin
- Result := Rate_Monotonic_Ident_Base (
- Name,
- ID_Base'Unchecked_Access
- );
+ Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
ID := ID_Base;
@@ -1993,20 +1900,6 @@ package body RTEMS is
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
@@ -2061,4 +1954,3 @@ package body RTEMS is
-- end Configuration;
end RTEMS;
-
diff --git a/c/src/ada/rtems.ads b/c/src/ada/rtems.ads
index 08d8f2a894..cdbadac9a3 100644
--- a/c/src/ada/rtems.ads
+++ b/c/src/ada/rtems.ads
@@ -25,6 +25,7 @@ with Interfaces;
with Interfaces.C;
package RTEMS is
+pragma Elaborate_Body (RTEMS);
Structure_Alignment : constant := 8;
@@ -35,10 +36,12 @@ package RTEMS is
subtype Unsigned8 is Interfaces.Unsigned_8;
subtype Unsigned16 is Interfaces.Unsigned_16;
subtype Unsigned32 is Interfaces.Unsigned_32;
+ subtype Signed32 is Interfaces.Integer_32;
type Unsigned32_Pointer is access all RTEMS.Unsigned32;
type Unsigned16_Pointer is access all RTEMS.Unsigned16;
type Unsigned8_Pointer is access all RTEMS.Unsigned8;
+ type Signed32_Pointer is access all RTEMS.Signed32;
subtype Boolean is RTEMS.Unsigned32;
subtype Address is System.Address;
@@ -235,7 +238,6 @@ package RTEMS is
Level : in RTEMS.Unsigned32
) return RTEMS.Attribute;
pragma Import (C, Interrupt_Level, "rtems_interrupt_level_attribute");
-
Minimum_Stack_Size : RTEMS.Unsigned32;
pragma Import (C, Minimum_Stack_Size, "rtems_minimum_stack_size");
@@ -697,19 +699,18 @@ package RTEMS is
type Configuration_Table is
record
- Work_Space_Start : RTEMS.Address;
- Work_Space_Size : RTEMS.Unsigned32;
- Maximum_Extensions : RTEMS.Unsigned32;
- Microseconds_Per_Tick : RTEMS.Unsigned32;
- Ticks_Per_Timeslice : RTEMS.Unsigned32;
- Maximum_Devices : RTEMS.Unsigned32;
- Number_Of_Device_Drivers : RTEMS.Unsigned32;
- Device_Driver_Table : RTEMS.Driver_Address_Table_Pointer;
- Number_Of_Initial_Extensions : RTEMS.Unsigned32;
- User_Extension_Table : RTEMS.Extensions_Table_Pointer;
- User_Multiprocessing_Table : RTEMS.Multiprocessing_Table_Pointer;
- RTEMS_API_Configuration : RTEMS.API_Configuration_Table_Pointer;
- POSIX_API_Configuration : RTEMS.POSIX_API_Configuration_Table_Pointer;
+ Work_Space_Start : RTEMS.Address;
+ Work_Space_Size : RTEMS.Unsigned32;
+ Maximum_Extensions : RTEMS.Unsigned32;
+ Microseconds_Per_Tick : RTEMS.Unsigned32;
+ Ticks_Per_Timeslice : RTEMS.Unsigned32;
+ Maximum_Devices : RTEMS.Unsigned32;
+ Number_Of_Device_Drivers : RTEMS.Unsigned32;
+ Device_Driver_Table : RTEMS.Driver_Address_Table_Pointer;
+ User_Extension_Table : RTEMS.Extensions_Table_Pointer;
+ User_Multiprocessing_Table : RTEMS.Multiprocessing_Table_Pointer;
+ RTEMS_API_Configuration : RTEMS.API_Configuration_Table_Pointer;
+ POSIX_API_Configuration : RTEMS.POSIX_API_Configuration_Table_Pointer;
end record;
type Configuration_Table_Pointer is access all Configuration_Table;
@@ -864,11 +865,6 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
- procedure Task_Is_Suspended (
- ID : in RTEMS.ID;
- Result : out RTEMS.Status_Codes
- );
-
procedure Task_Set_Priority (
ID : in RTEMS.ID;
New_Priority : in RTEMS.Task_Priority;
@@ -918,19 +914,26 @@ package RTEMS is
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_Name (Interrupt_Disable, "rtems_interrupt_disable");
procedure Interrupt_Enable (
Level : in RTEMS.ISR_Level
);
+ pragma Interface (C, Interrupt_Enable);
+ pragma Interface_Name (Interrupt_Enable, "rtems_interrupt_enable");
procedure Interrupt_Flash (
Level : in RTEMS.ISR_Level
);
+ pragma Interface (C, Interrupt_Flash);
+ pragma Interface_Name (Interrupt_Flash, "rtems_interrupt_flash");
- function Interrupt_Is_In_Progress
- return RTEMS.Boolean;
+ function Interrupt_Is_In_Progress return RTEMS.Boolean;
+ pragma Interface (C, Interrupt_Is_In_Progress);
+ pragma Interface_Name
+ (Interrupt_Is_In_Progress, "rtems_interrupt_is_in_progress");
--
-- Clock Manager
@@ -1003,6 +1006,14 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
+ procedure Timer_Server_Fire_After (
+ ID : in RTEMS.ID;
+ Ticks : in RTEMS.Interval;
+ Routine : in RTEMS.Timer_Service_Routine;
+ User_Data : in RTEMS.Address;
+ Result : out RTEMS.Status_Codes
+ );
+
procedure Timer_Fire_When (
ID : in RTEMS.ID;
Wall_Time : in RTEMS.Time_Of_Day;
@@ -1011,6 +1022,14 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
+ procedure Timer_Server_Fire_When (
+ ID : in RTEMS.ID;
+ Wall_Time : in RTEMS.Time_Of_Day;
+ Routine : in RTEMS.Timer_Service_Routine;
+ User_Data : in RTEMS.Address;
+ Result : out RTEMS.Status_Codes
+ );
+
procedure Timer_Reset (
ID : in RTEMS.ID;
Result : out RTEMS.Status_Codes
@@ -1021,6 +1040,13 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
+ procedure Timer_Initiate_Server (
+ Server_Priority : in RTEMS.Task_Priority;
+ Stack_Size : in Unsigned32;
+ Attribute_Set : in RTEMS.Attribute;
+ Result : out RTEMS.Status_Codes
+ );
+
--
-- Semaphore Manager
--
@@ -1058,10 +1084,6 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
- procedure Semaphore_Flush (
- ID : in RTEMS.ID;
- Result : out RTEMS.Status_Codes
- );
--
-- Message Queue Manager
@@ -1401,12 +1423,6 @@ package RTEMS is
Result : out RTEMS.Status_Codes
);
- --
- -- Multiprocessing Manager
- --
-
- procedure Multiprocessing_Announce;
-
--
-- Debug Manager
@@ -1434,6 +1450,4 @@ package RTEMS is
Configuration : RTEMS.Configuration_Table_Pointer;
pragma Import (C, Configuration, "_Configuration_Table");
-
-private
-end RTEMS;
+end RTEMS; \ No newline at end of file