From d45b4a9802a4ea46af4b111c879bea551573a03e Mon Sep 17 00:00:00 2001 From: Glenn Humphrey Date: Thu, 25 Oct 2007 20:44:31 +0000 Subject: 2007-10-25 Glenn Humphrey * rtems.adb, rtems.ads: Added some more missing bindings. --- c/src/ada/ChangeLog | 4 + c/src/ada/rtems.adb | 222 +++++++++++++++++++++++++++++++++++++++++++++++----- c/src/ada/rtems.ads | 119 ++++++++++++++++++++++++++-- 3 files changed, 321 insertions(+), 24 deletions(-) (limited to 'c/src/ada') diff --git a/c/src/ada/ChangeLog b/c/src/ada/ChangeLog index b65a16d88c..8e10fc740b 100644 --- a/c/src/ada/ChangeLog +++ b/c/src/ada/ChangeLog @@ -1,3 +1,7 @@ +2007-10-25 Glenn Humphrey + + * rtems.adb, rtems.ads: Added some more missing bindings. + 2007-10-18 Glenn Humphrey * rtems.adb, rtems.ads: Added a missing binding. diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb index eec64f2015..a8a4a27682 100644 --- a/c/src/ada/rtems.adb +++ b/c/src/ada/rtems.adb @@ -363,6 +363,20 @@ package body RTEMS is end Task_Resume; + procedure Task_Is_Suspended ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Task_Is_Suspended_Base ( + 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; @@ -556,35 +570,53 @@ package body RTEMS is -- Clock Manager -- + 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_Get ( Option : in RTEMS.Clock_Get_Options; Time_Buffer : in RTEMS.Address; Result : out RTEMS.Status_Codes ) is - function Clock_Get_base ( + 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"); + pragma Import (C, Clock_Get_Base, "rtems_clock_get"); begin - Result := Clock_Get_base ( Option, Time_Buffer ); + 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 + procedure Clock_Get_Uptime ( + Uptime : out RTEMS.Timespec; + Result : out RTEMS.Status_Codes ) is - function Clock_Set_base ( - Time_Buffer : RTEMS.Time_Of_Day + function Clock_Get_Uptime_Base ( + Uptime : access RTEMS.Timespec ) return RTEMS.Status_Codes; - pragma Import (C, Clock_Set_base, "rtems_clock_set"); + pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime"); + Uptime_Base : aliased RTEMS.Timespec; begin - - Result := Clock_Set_base ( Time_Buffer ); - end Clock_Set; + Result := Clock_Get_Uptime_Base ( + Uptime_Base'Unchecked_Access + ); + Uptime := Uptime_Base; + + end Clock_Get_Uptime; procedure Clock_Tick ( Result : out RTEMS.Status_Codes @@ -947,6 +979,20 @@ 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_Flush; + -- -- Message Queue Manager -- @@ -1507,6 +1553,34 @@ package body RTEMS is end Region_Return_Segment; + procedure Region_Resize_Segment ( + ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Old_Size : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ) is + function Region_Resize_Segment_Base ( + ID : RTEMS.ID; + Segment : RTEMS.Address; + Size : RTEMS.Unsigned32; + Old_Size : access RTEMS.Unsigned32 + ) return RTEMS.Status_Codes; + pragma Import (C, Region_Resize_Segment_Base, + "rtems_region_resize_segment"); + Old_Size_Base : aliased RTEMS.Unsigned32; + begin + + Result := Region_Resize_Segment_Base ( + ID, + Segment, + Size, + Old_Size_Base'Unchecked_Access + ); + Old_Size := Old_Size_Base; + + end Region_Resize_Segment; + -- -- Dual Ported Memory Manager -- @@ -1631,7 +1705,7 @@ package body RTEMS is procedure Fatal_Error_Occurred ( The_Error : in RTEMS.Unsigned32 ) is - procedure Fatal_Error_Occurred_base ( + procedure Fatal_Error_Occurred_Base ( The_Error : RTEMS.Unsigned32 ); pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred"); @@ -1651,15 +1725,15 @@ package body RTEMS is ID : out RTEMS.ID; Result : out RTEMS.Status_Codes ) is - function Rate_Monotonic_Create_base ( + 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"); + pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create"); ID_Base : aliased RTEMS.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; @@ -1694,7 +1768,7 @@ package body RTEMS is "rtems_rate_monotonic_delete"); begin - Result := Rate_Monotonic_Delete_base ( ID ); + Result := Rate_Monotonic_Delete_Base ( ID ); end Rate_Monotonic_Delete; @@ -1726,11 +1800,10 @@ package body RTEMS is "rtems_rate_monotonic_period"); begin - Result := Rate_Monotonic_Period_base ( ID, Length ); + 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; @@ -1756,6 +1829,117 @@ package body RTEMS is end Rate_Monotonic_Get_Status; + procedure Rate_Monotonic_Reset_Statistics ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Rate_Monotonic_Reset_Statistics_Base ( + ID : RTEMS.ID + ) return RTEMS.Status_Codes; + pragma Import (C, Rate_Monotonic_Reset_Statistics_Base, + "rtems_rate_monotonic_reset_statistics"); + begin + + Result := Rate_Monotonic_Reset_Statistics_Base ( ID ); + + end Rate_Monotonic_Reset_Statistics; + + + -- + -- Barrier Manager + -- + + procedure Barrier_Create ( + Name : in RTEMS.Name; + Attribute_Set : in RTEMS.Attribute; + Maximum_Waiters : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Barrier_Create_Base ( + Name : RTEMS.Name; + Attribute_Set : RTEMS.Attribute; + Maximum_Waiters : RTEMS.Unsigned32; + ID : access RTEMS.ID + ) return RTEMS.Status_Codes; + pragma Import (C, Barrier_Create_Base, "rtems_barrier_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Barrier_Create_Base ( + Name, + Attribute_Set, + Maximum_Waiters, + ID_Base'Unchecked_Access + ); + ID := ID_Base; + + end Barrier_Create; + + procedure Barrier_Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Barrier_Ident_Base ( + Name : RTEMS.Name; + ID : access RTEMS.ID + ) return RTEMS.Status_Codes; + pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Barrier_Ident_Base ( Name, ID_Base'Unchecked_Access ); + ID := ID_Base; + + end Barrier_Ident; + + procedure Barrier_Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Barrier_Delete_Base ( + ID : RTEMS.ID + ) return RTEMS.Status_Codes; + pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete"); + begin + + Result := Barrier_Delete_Base ( ID ); + + end Barrier_Delete; + + procedure Barrier_Wait ( + ID : in RTEMS.ID; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ) is + function Barrier_Wait_Base ( + ID : RTEMS.ID; + Option_Set : RTEMS.Option; + Timeout : RTEMS.Interval + ) return RTEMS.Status_Codes; + pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait"); + begin + + Result := Barrier_Wait_Base ( ID, Option_Set, Timeout ); + + end Barrier_Wait; + + procedure Barrier_Release ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ) is + function Barrier_Release_Base ( + ID : RTEMS.ID + ) return RTEMS.Status_Codes; + pragma Import (C, Barrier_Release_Base, "rtems_barrier_release"); + begin + + Result := Barrier_Release_Base ( ID ); + + end Barrier_Release; + -- -- Debug Manager diff --git a/c/src/ada/rtems.ads b/c/src/ada/rtems.ads index 6ec65abc49..52ef71456d 100644 --- a/c/src/ada/rtems.ads +++ b/c/src/ada/rtems.ads @@ -138,10 +138,18 @@ pragma Elaborate_Body (RTEMS); Clock_Get_TOD, Clock_Get_Seconds_Since_Epoch, Clock_Get_Ticks_Since_Boot, - Clock_Get_Ticks_Per_Seconds, + Clock_Get_Ticks_Per_Second, Clock_Get_Time_Value ); + type Time_T is new Interfaces.C.Long; + + type Timespec is record + TV_Sec : Time_T; + TV_Nsec : Interfaces.C.Long; + end record; + pragma Convention (C, Timespec); + -- -- Ident Options -- @@ -573,7 +581,7 @@ pragma Elaborate_Body (RTEMS); -- Initialization Manager -- Shutdown Only -- procedure Shutdown_Executive ( - Status : in RTEMS.Unsigned32 + Status : in RTEMS.Unsigned32 ); -- @@ -625,6 +633,11 @@ pragma Elaborate_Body (RTEMS); 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; @@ -716,15 +729,20 @@ pragma Elaborate_Body (RTEMS); -- Clock Manager -- + procedure Clock_Set ( + Time_Buffer : in RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes + ); + procedure Clock_Get ( Option : in RTEMS.Clock_Get_Options; Time_Buffer : in RTEMS.Address; Result : out RTEMS.Status_Codes ); - procedure Clock_Set ( - Time_Buffer : in RTEMS.Time_Of_Day; - Result : out RTEMS.Status_Codes + procedure Clock_Get_Uptime ( + Uptime : out RTEMS.Timespec; + Result : out RTEMS.Status_Codes ); procedure Clock_Tick ( @@ -860,6 +878,11 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); + procedure Semaphore_Flush ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + -- -- Message Queue Manager -- @@ -1054,6 +1077,14 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); + procedure Region_Resize_Segment ( + ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Old_Size : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + -- -- Dual Ported Memory Manager -- @@ -1138,6 +1169,84 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); + procedure Rate_Monotonic_Reset_Statistics ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Rate_Monotonic_Reset_All_Statistics; + pragma Import ( + C, + Rate_Monotonic_Reset_All_Statistics, + "rtems_rate_monotonic_reset_all_statistics" + ); + + procedure Rate_Monotonic_Report_Statistics; + pragma Import ( + C, + Rate_Monotonic_Report_Statistics, + "rtems_rate_monotonic_report_statistics" + ); + + -- + -- Barrier Manager + -- + + procedure Barrier_Create ( + Name : in RTEMS.Name; + Attribute_Set : in RTEMS.Attribute; + Maximum_Waiters : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Barrier_Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Barrier_Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Barrier_Wait ( + ID : in RTEMS.ID; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + + procedure Barrier_Release ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + -- + -- Stack Bounds Checker + -- + + function Stack_Checker_Is_Blown return RTEMS.Boolean; + pragma Interface (C, Stack_Checker_Is_Blown); + pragma Interface_Name + (Interrupt_Is_In_Progress, "rtems_stack_checker_is_blown"); + + procedure Stack_Checker_Report_Usage; + pragma Import ( + C, Stack_Checker_Report_Usage, "rtems_stack_checker_report_usage" + ); + + -- + -- CPU Usage Statistics + -- + + procedure CPU_Usage_Report; + pragma Import (C, CPU_Usage_Report, "rtems_cpu_usage_report"); + + procedure CPU_Usage_Reset; + pragma Import (C, CPU_Usage_Reset, "rtems_cpu_usage_reset"); + -- -- Debug Manager -- -- cgit v1.2.3