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

2008-03-11 Joel Sherrill <joel.sherrill@oarcorp.com>

Browse Source 
* rtems.adb, rtems.ads: Refactored rtems_clock_get into 5 methods
	which are single purpose and more strongly typed.  They are:
	    rtems_clock_get_tod - Get TOD in Classic API structure
	    rtems_clock_get_tod_timeval - Get TOD in struct timeval
	    rtems_clock_get_seconds_since_epoch - Get TOD as seconds since 1988
	    rtems_clock_get_ticks_since_boot - Get ticks since boot
	    rtems_clock_get_ticks_per_second - Get ticks per second
	Also switch from using 'Unchecked_Access to 'Access.
	Added pragma Convention C as required by gcc > 4.3.
	Changed style of parenthese on subprogram calls to match GNAT.
This commit is contained in:
Joel Sherrill
2008-03-11 20:12:09 +00:00
parent bf6d03d192
commit a2f56a44eb
3 changed files with 363 additions and 248 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
c/src/ada/ChangeLog
View File

@@ -1,3 +1,16 @@
2008-03-11 Joel Sherrill <joel.sherrill@oarcorp.com>
* rtems.adb, rtems.ads: Refactored rtems_clock_get into 5 methods
which are single purpose and more strongly typed. They are:
rtems_clock_get_tod - Get TOD in Classic API structure
rtems_clock_get_tod_timeval - Get TOD in struct timeval
rtems_clock_get_seconds_since_epoch - Get TOD as seconds since 1988
rtems_clock_get_ticks_since_boot - Get ticks since boot
rtems_clock_get_ticks_per_second - Get ticks per second
Also switch from using 'Unchecked_Access to 'Access.
Added pragma Convention C as required by gcc > 4.3.
Changed style of parenthese on subprogram calls to match GNAT.
2008-02-04 Joel Sherrill <joel.sherrill@oarcorp.com> 2008-02-04 Joel Sherrill <joel.sherrill@oarcorp.com>
* rtems.adb, rtems.ads: Correct binding to Object_Get_Name. Now works. * rtems.adb, rtems.ads: Correct binding to Object_Get_Name. Now works.

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

@@ -237,7 +237,7 @@ package body RTEMS is
Stack_Size, Stack_Size,
Initial_Modes, Initial_Modes,
Attribute_Set, Attribute_Set,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
end Task_Create; end Task_Create;
@@ -259,7 +259,7 @@ package body RTEMS is
begin begin
Result := Task_Ident_Base ( Name, Node, ID_Base'Unchecked_Access ); Result := Task_Ident_Base (Name, Node, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Task_Ident; end Task_Ident;
@@ -278,7 +278,7 @@ package body RTEMS is
pragma Import (C, Task_Start_Base, "rtems_task_start"); pragma Import (C, Task_Start_Base, "rtems_task_start");
begin begin
Result := Task_Start_Base ( ID, Entry_Point, Argument ); Result := Task_Start_Base (ID, Entry_Point, Argument);
end Task_Start; end Task_Start;
@@ -294,7 +294,7 @@ package body RTEMS is
pragma Import (C, Task_Restart_Base, "rtems_task_restart"); pragma Import (C, Task_Restart_Base, "rtems_task_restart");
begin begin
Result := Task_Restart_Base ( ID, Argument ); Result := Task_Restart_Base (ID, Argument);
end Task_Restart; end Task_Restart;
@@ -308,7 +308,7 @@ package body RTEMS is
pragma Import (C, Task_Delete_Base, "rtems_task_delete"); pragma Import (C, Task_Delete_Base, "rtems_task_delete");
begin begin
Result := Task_Delete_Base ( ID ); Result := Task_Delete_Base (ID);
end Task_Delete; end Task_Delete;
@@ -322,7 +322,7 @@ package body RTEMS is
pragma Import (C, Task_Suspend_Base, "rtems_task_suspend"); pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
begin begin
Result := Task_Suspend_Base ( ID ); Result := Task_Suspend_Base (ID);
end Task_Suspend; end Task_Suspend;
@@ -336,7 +336,7 @@ package body RTEMS is
pragma Import (C, Task_Resume_Base, "rtems_task_resume"); pragma Import (C, Task_Resume_Base, "rtems_task_resume");
begin begin
Result := Task_Resume_Base ( ID ); Result := Task_Resume_Base (ID);
end Task_Resume; end Task_Resume;
@@ -350,7 +350,7 @@ package body RTEMS is
pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended"); pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended");
begin begin
Result := Task_Is_Suspended_Base ( ID ); Result := Task_Is_Suspended_Base (ID);
end Task_Is_Suspended; end Task_Is_Suspended;
@@ -372,7 +372,7 @@ package body RTEMS is
Result := Task_Set_Priority_Base ( Result := Task_Set_Priority_Base (
ID, ID,
New_Priority, New_Priority,
Old_Priority_Base'Unchecked_Access Old_Priority_Base'Access
); );
Old_Priority := Old_Priority_Base; Old_Priority := Old_Priority_Base;
@@ -396,7 +396,7 @@ package body RTEMS is
Result := Task_Mode_Base ( Result := Task_Mode_Base (
Mode_Set, Mode_Set,
Mask, Mask,
Previous_Mode_Set_Base'Unchecked_Access Previous_Mode_Set_Base'Access
); );
Previous_Mode_Set := Previous_Mode_Set_Base; Previous_Mode_Set := Previous_Mode_Set_Base;
@@ -417,7 +417,7 @@ package body RTEMS is
Note_Base : aliased RTEMS.Unsigned32; Note_Base : aliased RTEMS.Unsigned32;
begin begin
Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access ); Result := Task_Get_Note_Base (ID, Notepad, Note_Base'Access);
Note := NOTE_Base; Note := NOTE_Base;
end Task_Get_Note; end Task_Get_Note;
@@ -436,7 +436,7 @@ package body RTEMS is
pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note"); pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
begin begin
Result := Task_Set_Note_Base ( ID, Notepad, Note ); Result := Task_Set_Note_Base (ID, Notepad, Note);
end Task_Set_Note; end Task_Set_Note;
@@ -454,7 +454,7 @@ package body RTEMS is
pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add"); pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
begin begin
Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor ); Result := Task_Variable_Add_Base (ID, Task_Variable, Dtor);
end Task_Variable_Add; end Task_Variable_Add;
@@ -476,8 +476,8 @@ package body RTEMS is
Result := Task_Variable_Get_Base ( Result := Task_Variable_Get_Base (
ID, ID,
Task_Variable_Base'Unchecked_Access, Task_Variable_Base'Access,
Task_Variable_Value_Base'Unchecked_Access Task_Variable_Value_Base'Access
); );
Task_Variable := Task_Variable_Base; Task_Variable := Task_Variable_Base;
Task_Variable_Value := Task_Variable_Value_Base; Task_Variable_Value := Task_Variable_Value_Base;
@@ -500,7 +500,7 @@ package body RTEMS is
begin begin
Result := Task_Variable_Delete_Base ( Result := Task_Variable_Delete_Base (
ID, Task_Variable_Base'Unchecked_Access ID, Task_Variable_Base'Access
); );
Task_Variable := Task_Variable_Base; Task_Variable := Task_Variable_Base;
@@ -516,7 +516,7 @@ package body RTEMS is
pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when"); pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
begin begin
Result := Task_Wake_When_Base ( Time_Buffer ); Result := Task_Wake_When_Base (Time_Buffer);
end Task_Wake_When; end Task_Wake_When;
@@ -530,7 +530,7 @@ package body RTEMS is
pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after"); pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
begin begin
Result := Task_Wake_After_Base ( Ticks ); Result := Task_Wake_After_Base (Ticks);
end Task_Wake_After; end Task_Wake_After;
@@ -552,12 +552,15 @@ package body RTEMS is
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
) is ) is
function Clock_Set_Base ( function Clock_Set_Base (
Time_Buffer : RTEMS.Time_Of_Day Time_Buffer : access RTEMS.Time_Of_Day
) return RTEMS.Status_Codes; ) return RTEMS.Status_Codes;
pragma Import (C, Clock_Set_Base, "rtems_clock_set"); pragma Import (C, Clock_Set_Base, "rtems_clock_set");
Tmp_Time : aliased RTEMS.Time_Of_Day;
begin begin
Result := Clock_Set_Base ( Time_Buffer ); Tmp_Time := Time_Buffer;
Result := Clock_Set_Base (Tmp_Time'Access);
end Clock_Set; end Clock_Set;
@@ -573,10 +576,67 @@ package body RTEMS is
pragma Import (C, Clock_Get_Base, "rtems_clock_get"); pragma Import (C, Clock_Get_Base, "rtems_clock_get");
begin begin
Result := Clock_Get_Base ( Option, Time_Buffer ); Result := Clock_Get_Base (Option, Time_Buffer);
end Clock_Get; end Clock_Get;
procedure Clock_Get_TOD (
Time : out RTEMS.Time_Of_Day;
Result : out RTEMS.Status_Codes
) is
function Clock_Get_TOD_Base (
Time : access RTEMS.Time_Of_Day
) return RTEMS.Status_Codes;
pragma Import (C, Clock_Get_TOD_Base, "rtems_clock_get_tod");
Tmp_Time : aliased RTEMS.Time_Of_Day;
begin
Result := Clock_Get_TOD_Base (Tmp_Time'Access);
Time := Tmp_Time;
end Clock_Get_TOD;
procedure Clock_Get_TOD_Time_Value (
Time : out RTEMS.Clock_Time_Value;
Result : out RTEMS.Status_Codes
) is
function Clock_Get_TOD_Time_Value_Base (
Time : access RTEMS.Clock_Time_Value
) return RTEMS.Status_Codes;
pragma Import (
C,
Clock_Get_TOD_Time_Value_Base,
"rtems_clock_get_tod_timeval"
);
Tmp_Time : aliased RTEMS.Clock_Time_Value;
begin
Result := Clock_Get_TOD_Time_Value_Base (Tmp_Time'Access);
Time := Tmp_Time;
end Clock_Get_TOD_Time_Value;
procedure Clock_Get_Seconds_Since_Epoch(
The_Interval : out RTEMS.Interval;
Result : out RTEMS.Status_Codes
) is
function Clock_Get_Seconds_Since_Epoch_Base (
The_Interval : access RTEMS.Interval
) return RTEMS.Status_Codes;
pragma Import (
C,
Clock_Get_Seconds_Since_Epoch_Base,
"rtems_clock_get_seconds_since_epoch"
);
Tmp_Interval : aliased RTEMS.Interval;
begin
Result := Clock_Get_Seconds_Since_Epoch_Base (Tmp_Interval'Access);
The_Interval := Tmp_Interval;
end Clock_Get_Seconds_Since_Epoch;
-- Clock_Get_Ticks_Per_Second is in rtems.ads
-- Clock_Get_Ticks_Since_Boot is in rtems.ads
procedure Clock_Get_Uptime ( procedure Clock_Get_Uptime (
Uptime : out RTEMS.Timespec; Uptime : out RTEMS.Timespec;
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
@@ -588,9 +648,7 @@ package body RTEMS is
Uptime_Base : aliased RTEMS.Timespec; Uptime_Base : aliased RTEMS.Timespec;
begin begin
Result := Clock_Get_Uptime_Base ( Result := Clock_Get_Uptime_Base (Uptime_Base'Access);
Uptime_Base'Unchecked_Access
);
Uptime := Uptime_Base; Uptime := Uptime_Base;
end Clock_Get_Uptime; end Clock_Get_Uptime;
@@ -625,7 +683,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access ); Result := Extension_Create_Base (Name, Table, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Extension_Create; end Extension_Create;
@@ -643,7 +701,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Extension_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Extension_Ident; end Extension_Ident;
@@ -658,7 +716,7 @@ package body RTEMS is
pragma Import (C, Extension_Delete_Base, "rtems_extension_delete"); pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
begin begin
Result := Extension_Delete_Base ( ID ); Result := Extension_Delete_Base (ID);
end Extension_Delete; end Extension_Delete;
@@ -679,7 +737,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access ); Result := Timer_Create_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Timer_Create; end Timer_Create;
@@ -697,7 +755,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Timer_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Timer_Ident; end Timer_Ident;
@@ -712,7 +770,7 @@ package body RTEMS is
pragma Import (C, Timer_Delete_Base, "rtems_timer_delete"); pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
begin begin
Result := Timer_Delete_Base ( ID ); Result := Timer_Delete_Base (ID);
end Timer_Delete; end Timer_Delete;
@@ -732,7 +790,7 @@ package body RTEMS is
pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after"); pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
begin 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; end Timer_Fire_After;
@@ -756,7 +814,7 @@ package body RTEMS is
); );
begin begin
Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data ); Result := Timer_Server_Fire_After_Base (ID, Ticks, Routine, User_Data);
end Timer_Server_Fire_After; end Timer_Server_Fire_After;
@@ -776,7 +834,7 @@ package body RTEMS is
pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when"); pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
begin begin
Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data ); Result := Timer_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
end Timer_Fire_When; end Timer_Fire_When;
@@ -801,7 +859,7 @@ package body RTEMS is
begin begin
Result := Result :=
Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data ); Timer_Server_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
end Timer_Server_Fire_When; end Timer_Server_Fire_When;
procedure Timer_Reset ( procedure Timer_Reset (
@@ -814,7 +872,7 @@ package body RTEMS is
pragma Import (C, Timer_Reset_Base, "rtems_timer_reset"); pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
begin begin
Result := Timer_Reset_Base ( ID ); Result := Timer_Reset_Base (ID);
end Timer_Reset; end Timer_Reset;
@@ -828,7 +886,7 @@ package body RTEMS is
pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel"); pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
begin begin
Result := Timer_Cancel_Base ( ID ); Result := Timer_Cancel_Base (ID);
end Timer_Cancel; end Timer_Cancel;
@@ -884,7 +942,7 @@ package body RTEMS is
Count, Count,
Attribute_Set, Attribute_Set,
Priority_Ceiling, Priority_Ceiling,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -900,7 +958,7 @@ package body RTEMS is
pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete"); pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
begin begin
Result := Semaphore_Delete_Base ( ID ); Result := Semaphore_Delete_Base (ID);
end Semaphore_Delete; end Semaphore_Delete;
@@ -919,7 +977,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access ); Result := Semaphore_Ident_Base (Name, Node, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Semaphore_Ident; end Semaphore_Ident;
@@ -938,7 +996,7 @@ package body RTEMS is
pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain"); pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
begin begin
Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout ); Result := Semaphore_Obtain_Base (ID, Option_Set, Timeout);
end Semaphore_Obtain; end Semaphore_Obtain;
@@ -952,7 +1010,7 @@ package body RTEMS is
pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release"); pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
begin begin
Result := Semaphore_Release_Base ( ID ); Result := Semaphore_Release_Base (ID);
end Semaphore_Release; end Semaphore_Release;
@@ -966,7 +1024,7 @@ package body RTEMS is
pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush"); pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
begin begin
Result := Semaphore_Flush_Base ( ID ); Result := Semaphore_Flush_Base (ID);
end Semaphore_Flush; end Semaphore_Flush;
@@ -1000,7 +1058,7 @@ package body RTEMS is
Count, Count,
Max_Message_Size, Max_Message_Size,
Attribute_Set, Attribute_Set,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -1022,7 +1080,7 @@ package body RTEMS is
begin begin
Result := Result :=
Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access ); Message_Queue_Ident_Base (Name, Node, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Message_Queue_Ident; end Message_Queue_Ident;
@@ -1038,7 +1096,7 @@ package body RTEMS is
C, Message_Queue_Delete_Base, "rtems_message_queue_delete"); C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
begin begin
Result := Message_Queue_Delete_Base ( ID ); Result := Message_Queue_Delete_Base (ID);
end Message_Queue_Delete; end Message_Queue_Delete;
@@ -1056,7 +1114,7 @@ package body RTEMS is
pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send"); pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
begin begin
Result := Message_Queue_Send_Base ( ID, Buffer, Size ); Result := Message_Queue_Send_Base (ID, Buffer, Size);
end Message_Queue_Send; end Message_Queue_Send;
@@ -1075,7 +1133,7 @@ package body RTEMS is
"rtems_message_queue_urgent"); "rtems_message_queue_urgent");
begin begin
Result := Message_Queue_Urgent_Base ( ID, Buffer, Size ); Result := Message_Queue_Urgent_Base (ID, Buffer, Size);
end Message_Queue_Urgent; end Message_Queue_Urgent;
@@ -1101,8 +1159,8 @@ package body RTEMS is
ID, ID,
Buffer, Buffer,
Size, Size,
Count_Base'Unchecked_Access Count_Base'Access
); );
Count := Count_Base; Count := Count_Base;
end Message_Queue_Broadcast; end Message_Queue_Broadcast;
@@ -1130,7 +1188,7 @@ package body RTEMS is
Result := Message_Queue_Receive_Base ( Result := Message_Queue_Receive_Base (
ID, ID,
Buffer, Buffer,
Size_Base'Unchecked_Access, Size_Base'Access,
Option_Set, Option_Set,
Timeout Timeout
); );
@@ -1156,7 +1214,7 @@ package body RTEMS is
begin begin
Result := Message_Queue_Get_Number_Pending_Base ( Result := Message_Queue_Get_Number_Pending_Base (
ID, COUNT_Base'Unchecked_Access ID, COUNT_Base'Access
); );
Count := COUNT_Base; Count := COUNT_Base;
@@ -1175,7 +1233,7 @@ package body RTEMS is
COUNT_Base : aliased RTEMS.Unsigned32; COUNT_Base : aliased RTEMS.Unsigned32;
begin begin
Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access ); Result := Message_Queue_Flush_Base (ID, COUNT_Base'Access);
Count := COUNT_Base; Count := COUNT_Base;
end Message_Queue_Flush; end Message_Queue_Flush;
@@ -1196,7 +1254,7 @@ package body RTEMS is
pragma Import (C, Event_Send_Base, "rtems_event_send"); pragma Import (C, Event_Send_Base, "rtems_event_send");
begin begin
Result := Event_Send_Base ( ID, Event_In ); Result := Event_Send_Base (ID, Event_In);
end Event_Send; end Event_Send;
@@ -1243,7 +1301,7 @@ package body RTEMS is
pragma Import (C, Signal_Catch_Base, "rtems_signal_catch"); pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
begin begin
Result := Signal_Catch_Base ( ASR_Handler, Mode_Set ); Result := Signal_Catch_Base (ASR_Handler, Mode_Set);
end Signal_Catch; end Signal_Catch;
@@ -1259,7 +1317,7 @@ package body RTEMS is
pragma Import (C, Signal_Send_Base, "rtems_signal_send"); pragma Import (C, Signal_Send_Base, "rtems_signal_send");
begin begin
Result := Signal_Send_Base ( ID, Signal_Set ); Result := Signal_Send_Base (ID, Signal_Set);
end Signal_Send; end Signal_Send;
@@ -1295,7 +1353,7 @@ package body RTEMS is
Length, Length,
Buffer_Size, Buffer_Size,
Attribute_Set, Attribute_Set,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -1316,7 +1374,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access ); Result := Partition_Ident_Base (Name, Node, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Partition_Ident; end Partition_Ident;
@@ -1331,7 +1389,7 @@ package body RTEMS is
pragma Import (C, Partition_Delete_Base, "rtems_partition_delete"); pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
begin begin
Result := Partition_Delete_Base ( ID ); Result := Partition_Delete_Base (ID);
end Partition_Delete; end Partition_Delete;
@@ -1349,7 +1407,7 @@ package body RTEMS is
Buffer_Base : aliased RTEMS.Address; Buffer_Base : aliased RTEMS.Address;
begin begin
Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access ); Result := Partition_Get_Buffer_Base (ID, Buffer_Base'Access);
Buffer := Buffer_Base; Buffer := Buffer_Base;
end Partition_Get_Buffer; end Partition_Get_Buffer;
@@ -1367,7 +1425,7 @@ package body RTEMS is
"rtems_partition_return_buffer"); "rtems_partition_return_buffer");
begin begin
Result := Partition_Return_Buffer_Base ( ID, Buffer ); Result := Partition_Return_Buffer_Base (ID, Buffer);
end Partition_Return_Buffer; end Partition_Return_Buffer;
@@ -1402,7 +1460,7 @@ package body RTEMS is
Length, Length,
Page_Size, Page_Size,
Attribute_Set, Attribute_Set,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -1421,7 +1479,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Region_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Region_Ident; end Region_Ident;
@@ -1436,7 +1494,7 @@ package body RTEMS is
pragma Import (C, Region_Delete_Base, "rtems_region_delete"); pragma Import (C, Region_Delete_Base, "rtems_region_delete");
begin begin
Result := Region_Delete_Base ( ID ); Result := Region_Delete_Base (ID);
end Region_Delete; end Region_Delete;
@@ -1454,7 +1512,7 @@ package body RTEMS is
pragma Import (C, Region_Extend_Base, "rtems_region_extend"); pragma Import (C, Region_Extend_Base, "rtems_region_extend");
begin begin
Result := Region_Extend_Base ( ID, Starting_Address, Length ); Result := Region_Extend_Base (ID, Starting_Address, Length);
end Region_Extend; end Region_Extend;
@@ -1482,7 +1540,7 @@ package body RTEMS is
Size, Size,
Option_Set, Option_Set,
Timeout, Timeout,
Segment_Base'Unchecked_Access Segment_Base'Access
); );
Segment := SEGMENT_Base; Segment := SEGMENT_Base;
@@ -1507,7 +1565,7 @@ package body RTEMS is
Result := Region_Get_Segment_Size_Base ( Result := Region_Get_Segment_Size_Base (
ID, ID,
Segment, Segment,
Size_Base'Unchecked_Access Size_Base'Access
); );
Size := SIZE_Base; Size := SIZE_Base;
@@ -1526,7 +1584,7 @@ package body RTEMS is
"rtems_region_return_segment"); "rtems_region_return_segment");
begin begin
Result := Region_Return_Segment_Base ( ID, Segment ); Result := Region_Return_Segment_Base (ID, Segment);
end Region_Return_Segment; end Region_Return_Segment;
@@ -1552,7 +1610,7 @@ package body RTEMS is
ID, ID,
Segment, Segment,
Size, Size,
Old_Size_Base'Unchecked_Access Old_Size_Base'Access
); );
Old_Size := Old_Size_Base; Old_Size := Old_Size_Base;
@@ -1586,7 +1644,7 @@ package body RTEMS is
Internal_Start, Internal_Start,
External_Start, External_Start,
Length, Length,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -1605,7 +1663,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Port_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Port_Ident; end Port_Ident;
@@ -1620,7 +1678,7 @@ package body RTEMS is
pragma Import (C, Port_Delete_Base, "rtems_port_delete"); pragma Import (C, Port_Delete_Base, "rtems_port_delete");
begin begin
Result := Port_Delete_Base ( ID ); Result := Port_Delete_Base (ID);
end Port_Delete; end Port_Delete;
@@ -1643,7 +1701,7 @@ package body RTEMS is
Result := Port_External_To_Internal_Base ( Result := Port_External_To_Internal_Base (
ID, ID,
External, External,
Internal_Base'Unchecked_Access Internal_Base'Access
); );
Internal := INTERNAL_Base; Internal := INTERNAL_Base;
@@ -1668,7 +1726,7 @@ package body RTEMS is
Result := Port_Internal_To_External_Base ( Result := Port_Internal_To_External_Base (
ID, ID,
Internal, Internal,
External_Base'Unchecked_Access External_Base'Access
); );
External := EXTERNAL_Base; External := EXTERNAL_Base;
@@ -1688,7 +1746,7 @@ package body RTEMS is
pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred"); pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
begin begin
Fatal_Error_Occurred_Base ( The_Error ); Fatal_Error_Occurred_Base (The_Error);
end Fatal_Error_Occurred; end Fatal_Error_Occurred;
@@ -1710,7 +1768,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Rate_Monotonic_Create_Base ( Name, ID_Base'Unchecked_Access ); Result := Rate_Monotonic_Create_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Rate_Monotonic_Create; end Rate_Monotonic_Create;
@@ -1728,7 +1786,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Rate_Monotonic_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
@@ -1745,7 +1803,7 @@ package body RTEMS is
"rtems_rate_monotonic_delete"); "rtems_rate_monotonic_delete");
begin begin
Result := Rate_Monotonic_Delete_Base ( ID ); Result := Rate_Monotonic_Delete_Base (ID);
end Rate_Monotonic_Delete; end Rate_Monotonic_Delete;
@@ -1760,7 +1818,7 @@ package body RTEMS is
"rtems_rate_monotonic_cancel"); "rtems_rate_monotonic_cancel");
begin begin
Result := Rate_Monotonic_Cancel_Base ( ID ); Result := Rate_Monotonic_Cancel_Base (ID);
end Rate_Monotonic_Cancel; end Rate_Monotonic_Cancel;
@@ -1777,7 +1835,7 @@ package body RTEMS is
"rtems_rate_monotonic_period"); "rtems_rate_monotonic_period");
begin begin
Result := Rate_Monotonic_Period_Base ( ID, Length ); Result := Rate_Monotonic_Period_Base (ID, Length);
end Rate_Monotonic_Period; end Rate_Monotonic_Period;
@@ -1798,7 +1856,7 @@ package body RTEMS is
Result := Rate_Monotonic_Get_Status_Base ( Result := Rate_Monotonic_Get_Status_Base (
ID, ID,
Status_Base'Unchecked_Access Status_Base'Access
); );
Status := Status_Base; Status := Status_Base;
@@ -1817,7 +1875,7 @@ package body RTEMS is
"rtems_rate_monotonic_reset_statistics"); "rtems_rate_monotonic_reset_statistics");
begin begin
Result := Rate_Monotonic_Reset_Statistics_Base ( ID ); Result := Rate_Monotonic_Reset_Statistics_Base (ID);
end Rate_Monotonic_Reset_Statistics; end Rate_Monotonic_Reset_Statistics;
@@ -1847,7 +1905,7 @@ package body RTEMS is
Name, Name,
Attribute_Set, Attribute_Set,
Maximum_Waiters, Maximum_Waiters,
ID_Base'Unchecked_Access ID_Base'Access
); );
ID := ID_Base; ID := ID_Base;
@@ -1866,7 +1924,7 @@ package body RTEMS is
ID_Base : aliased RTEMS.ID; ID_Base : aliased RTEMS.ID;
begin begin
Result := Barrier_Ident_Base ( Name, ID_Base'Unchecked_Access ); Result := Barrier_Ident_Base (Name, ID_Base'Access);
ID := ID_Base; ID := ID_Base;
end Barrier_Ident; end Barrier_Ident;
@@ -1881,7 +1939,7 @@ package body RTEMS is
pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete"); pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
begin begin
Result := Barrier_Delete_Base ( ID ); Result := Barrier_Delete_Base (ID);
end Barrier_Delete; end Barrier_Delete;
@@ -1897,7 +1955,7 @@ package body RTEMS is
pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait"); pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
begin begin
Result := Barrier_Wait_Base ( ID, Timeout ); Result := Barrier_Wait_Base (ID, Timeout);
end Barrier_Wait; end Barrier_Wait;
@@ -1914,7 +1972,7 @@ package body RTEMS is
Released_Base : aliased RTEMS.Unsigned32; Released_Base : aliased RTEMS.Unsigned32;
begin begin
Result := Barrier_Release_Base ( ID, Released_Base'Unchecked_Access ); Result := Barrier_Release_Base (ID, Released_Base'Access);
Released := Released_Base; Released := Released_Base;
end Barrier_Release; end Barrier_Release;
@@ -1933,7 +1991,7 @@ package body RTEMS is
pragma Import (C, Debug_Enable_Base, "rtems_debug_enable"); pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
begin begin
Debug_Enable_Base ( To_Be_Enabled ); Debug_Enable_Base (To_Be_Enabled);
end Debug_Enable; end Debug_Enable;
@@ -1946,7 +2004,7 @@ package body RTEMS is
pragma Import (C, Debug_Disable_Base, "rtems_debug_disable"); pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
begin begin
Debug_Disable_Base ( To_Be_Disabled ); Debug_Disable_Base (To_Be_Disabled);
end Debug_Disable; end Debug_Disable;
@@ -1959,7 +2017,7 @@ package body RTEMS is
pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled"); pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
begin begin
return Debug_Is_Enabled_Base ( Level ); return Debug_Is_Enabled_Base (Level);
end Debug_Is_Enabled; end Debug_Is_Enabled;

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

@@ -109,6 +109,7 @@ pragma Elaborate_Body (RTEMS);
type Task_Entry is access procedure ( type Task_Entry is access procedure (
Argument : RTEMS.Unsigned32 Argument : RTEMS.Unsigned32
); );
pragma Convention (C, Task_Entry);
subtype TCB is RTEMS.Unsigned32; subtype TCB is RTEMS.Unsigned32;
type TCB_Pointer is access all RTEMS.TCB; type TCB_Pointer is access all RTEMS.TCB;
@@ -259,42 +260,51 @@ pragma Elaborate_Body (RTEMS);
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; ) return RTEMS.Boolean;
pragma Convention (C, Thread_Create_Extension);
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;
Started_Task : in RTEMS.TCB_Pointer Started_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Start_Extension);
type Thread_Restart_Extension is access procedure ( type Thread_Restart_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer; Current_Task : in RTEMS.TCB_Pointer;
Restarted_Task : in RTEMS.TCB_Pointer Restarted_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Restart_Extension);
type Thread_Delete_Extension is access procedure ( type Thread_Delete_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer; Current_Task : in RTEMS.TCB_Pointer;
Deleted_Task : in RTEMS.TCB_Pointer Deleted_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Delete_Extension);
type Thread_Switch_Extension is access procedure ( type Thread_Switch_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer; Current_Task : in RTEMS.TCB_Pointer;
Heir_Task : in RTEMS.TCB_Pointer Heir_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Switch_Extension);
type Thread_Post_Switch_Extension is access procedure ( type Thread_Post_Switch_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer Current_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Post_Switch_Extension);
type Thread_Begin_Extension is access procedure ( type Thread_Begin_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer Current_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Begin_Extension);
type Thread_Exitted_Extension is access procedure ( type Thread_Exitted_Extension is access procedure (
Current_Task : in RTEMS.TCB_Pointer Current_Task : in RTEMS.TCB_Pointer
); );
pragma Convention (C, Thread_Exitted_Extension);
type Fatal_Error_Extension is access procedure ( type Fatal_Error_Extension is access procedure (
Error : in RTEMS.Unsigned32 Error : in RTEMS.Unsigned32
); );
pragma Convention (C, Fatal_Error_Extension);
type Extensions_Table is type Extensions_Table is
record record
@@ -319,6 +329,7 @@ pragma Elaborate_Body (RTEMS);
ID : in RTEMS.ID; ID : in RTEMS.ID;
User_Data : in RTEMS.Address User_Data : in RTEMS.Address
); );
pragma Convention (C, Timer_Service_Routine);
-- --
-- The following type define a pointer to a signal service routine. -- The following type define a pointer to a signal service routine.
@@ -327,6 +338,7 @@ pragma Elaborate_Body (RTEMS);
type ASR_Handler is access procedure ( type ASR_Handler is access procedure (
Signals : in RTEMS.Signal_Set Signals : in RTEMS.Signal_Set
); );
pragma Convention (C, ASR_Handler);
-- --
-- The following type defines the status information returned -- The following type defines the status information returned
@@ -663,6 +675,7 @@ pragma Elaborate_Body (RTEMS);
type Task_Variable_Dtor is access procedure ( type Task_Variable_Dtor is access procedure (
Argument : in RTEMS.Address Argument : in RTEMS.Address
); );
pragma Convention (C, Task_Variable_Dtor);
procedure Task_Variable_Add ( procedure Task_Variable_Add (
ID : in RTEMS.ID; ID : in RTEMS.ID;
@@ -734,6 +747,37 @@ pragma Elaborate_Body (RTEMS);
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes
); );
procedure Clock_Get_TOD (
Time : out RTEMS.Time_Of_Day;
Result : out RTEMS.Status_Codes
);
procedure Clock_Get_TOD_Time_Value (
Time : out RTEMS.Clock_Time_Value;
Result : out RTEMS.Status_Codes
);
procedure Clock_Get_Seconds_Since_Epoch(
The_Interval : out RTEMS.Interval;
Result : out RTEMS.Status_Codes
);
function Clock_Get_Ticks_Per_Second
return RTEMS.Interval;
pragma Import (
C,
Clock_Get_Ticks_Per_Second,
"rtems_clock_get_ticks_per_second"
);
function Clock_Get_Ticks_Since_Boot
return RTEMS.Interval;
pragma Import (
C,
Clock_Get_Ticks_Since_Boot,
"rtems_clock_get_ticks_since_boot"
);
procedure Clock_Get_Uptime ( procedure Clock_Get_Uptime (
Uptime : out RTEMS.Timespec; Uptime : out RTEMS.Timespec;
Result : out RTEMS.Status_Codes Result : out RTEMS.Status_Codes