From 8294a5d9f660865776742c5f9f418bab7a99170b Mon Sep 17 00:00:00 2001 From: Glenn Humphrey Date: Fri, 26 Oct 2007 21:37:07 +0000 Subject: 2007-10-26 Glenn Humphrey * rtems.adb, rtems.ads: Merge binding updates from CVS head. Bindings should now be reasonably in sync with C Classic API. --- c/src/ada/ChangeLog | 5 + c/src/ada/rtems.adb | 488 +++++++++++++++++++++++++++++++++------------------- c/src/ada/rtems.ads | 291 ++++++++++++++++--------------- 3 files changed, 464 insertions(+), 320 deletions(-) (limited to 'c') diff --git a/c/src/ada/ChangeLog b/c/src/ada/ChangeLog index 7bdd480ca8..5c6510d09e 100644 --- a/c/src/ada/ChangeLog +++ b/c/src/ada/ChangeLog @@ -1,3 +1,8 @@ +2007-10-26 Glenn Humphrey + + * rtems.adb, rtems.ads: Merge binding updates from CVS head. Bindings + should now be reasonably in sync with C Classic API. + 2007-09-05 Joel Sherrill * rtems.adb: Fix warnings. diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb index 7680258ce5..a8a4a27682 100644 --- a/c/src/ada/rtems.adb +++ b/c/src/ada/rtems.adb @@ -17,7 +17,7 @@ -- the file LICENSE in this distribution or at -- http://www.rtems.com/license/LICENSE. -- --- rtems.adb,v 1.13.2.2 2003/09/04 18:46:47 joel Exp +-- $Id$ -- with Ada; @@ -215,6 +215,21 @@ package body RTEMS is -- RTEMS API -- + -- + -- Initialization Manager -- Shutdown Only + -- + procedure Shutdown_Executive ( + Status : in RTEMS.Unsigned32 + ) is + procedure Shutdown_Executive_Base ( + Status : RTEMS.Unsigned32 + ); + pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive"); + begin + Shutdown_Executive_Base (Status); + end Shutdown_Executive; + + -- -- Task Manager -- @@ -348,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; @@ -434,6 +463,72 @@ package body RTEMS is 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 ( Time_Buffer : in RTEMS.Time_Of_Day; Result : out RTEMS.Status_Codes @@ -466,30 +561,6 @@ package body RTEMS is -- 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_Enable is interfaced in the specification -- Interrupt_Flash is interfaced in the specification @@ -499,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 @@ -539,7 +628,7 @@ package body RTEMS is Result := Clock_Tick_Base; end Clock_Tick; - + -- -- Extension Manager -- @@ -890,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 -- @@ -1058,6 +1161,30 @@ package body RTEMS is end Message_Queue_Receive; + procedure Message_Queue_Get_Number_Pending ( + ID : in RTEMS.ID; + Count : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ) is + function Message_Queue_Get_Number_Pending_Base ( + ID : RTEMS.ID; + Count : access RTEMS.Unsigned32 + ) return RTEMS.Status_Codes; + pragma Import ( + C, + Message_Queue_Get_Number_Pending_Base, + "rtems_message_queue_get_number_pending" + ); + COUNT_Base : aliased RTEMS.Unsigned32; + begin + + Result := Message_Queue_Get_Number_Pending_Base ( + ID, COUNT_Base'Unchecked_Access + ); + Count := COUNT_Base; + + end Message_Queue_Get_Number_Pending; + procedure Message_Queue_Flush ( ID : in RTEMS.ID; Count : out RTEMS.Unsigned32; @@ -1426,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 -- @@ -1542,139 +1697,6 @@ package body RTEMS is 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 @@ -1683,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"); @@ -1703,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; @@ -1746,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; @@ -1778,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; @@ -1808,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 9bff212fef..52ef71456d 100644 --- a/c/src/ada/rtems.ads +++ b/c/src/ada/rtems.ads @@ -18,7 +18,7 @@ -- the file LICENSE in this distribution or at -- http://www.rtems.com/license/LICENSE. -- --- rtems.ads,v 1.19.2.2 2003/11/25 14:07:32 joel Exp +-- $Id$ -- with System; @@ -77,6 +77,7 @@ pragma Elaborate_Body (RTEMS); True : constant RTEMS.Boolean := 1; False : constant RTEMS.Boolean := 0; + -- -- More Types -- @@ -94,27 +95,24 @@ pragma Elaborate_Body (RTEMS); subtype Debug_Set is RTEMS.Unsigned32; subtype Device_Major_Number is RTEMS.Unsigned32; subtype Device_Minor_Number is RTEMS.Unsigned32; - subtype Vector_Number is RTEMS.Unsigned32; subtype ISR_Level is RTEMS.Unsigned32; subtype Node is RTEMS.Unsigned32; -- -- Task Related Types - -- XXXX fix this + -- + subtype Task_Argument is RTEMS.Unsigned32; 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 ( Argument : RTEMS.Unsigned32 ); + subtype TCB is RTEMS.Unsigned32; + type TCB_Pointer is access all RTEMS.TCB; + -- -- Clock and Time of Day Types -- @@ -140,45 +138,17 @@ 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 ); - -- - -- 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 Time_T is new Interfaces.C.Long; - 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; + type Timespec is record + TV_Sec : Time_T; + TV_Nsec : Interfaces.C.Long; + end record; + pragma Convention (C, Timespec); -- -- Ident Options @@ -249,7 +219,6 @@ pragma Elaborate_Body (RTEMS); Minimum_Stack_Size : RTEMS.Unsigned32; pragma Import (C, Minimum_Stack_Size, "rtems_minimum_stack_size"); - -- -- Notepad index constants -- @@ -282,15 +251,14 @@ pragma Elaborate_Body (RTEMS); Current_Priority : constant RTEMS.Task_Priority := 0; No_Priority : constant RTEMS.Task_Priority := 0; - -- -- Extension Callouts and Table -- - type Thread_Create_Extension is access procedure ( + type Thread_Create_Extension is access function ( Current_Task : in RTEMS.TCB_Pointer; New_Task : in RTEMS.TCB_Pointer - ); + ) return RTEMS.Boolean; type Thread_Start_Extension is access procedure ( Current_Task : in RTEMS.TCB_Pointer; @@ -538,15 +506,6 @@ pragma Elaborate_Body (RTEMS); Signal_30 : constant RTEMS.Signal_Set := 16#40000000#; 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 -- @@ -612,10 +571,19 @@ pragma Elaborate_Body (RTEMS); Left : in RTEMS.Address; Right : in RTEMS.Address ) return Standard.Boolean; + + -- -- RTEMS API -- + -- + -- Initialization Manager -- Shutdown Only + -- + procedure Shutdown_Executive ( + Status : in RTEMS.Unsigned32 + ); + -- -- Task Manager -- @@ -665,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; @@ -697,25 +670,25 @@ pragma Elaborate_Body (RTEMS); Argument : in RTEMS.Address ); --- procedure Task_Variable_Add ( --- ID : in RTEMS.ID; --- Task_Variable : in RTEMS.Address; --- Dtor : in RTEMS.Task_Variable_Dtor; --- Result : out RTEMS.Status_Codes --- ); + procedure Task_Variable_Add ( + ID : in RTEMS.ID; + Task_Variable : in RTEMS.Address; + Dtor : in RTEMS.Task_Variable_Dtor; + Result : out RTEMS.Status_Codes + ); --- procedure Task_Variable_Get ( --- ID : in RTEMS.ID; --- Task_Variable : out RTEMS.Address; --- Task_Variable_Value : out RTEMS.Address; --- Result : out RTEMS.Status_Codes --- ); + procedure Task_Variable_Get ( + ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Task_Variable_Value : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); --- procedure Task_Variable_Delete ( --- ID : in RTEMS.ID; --- Task_Variable : out RTEMS.Address; --- Result : out RTEMS.Status_Codes --- ); + procedure Task_Variable_Delete ( + ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); procedure Task_Wake_When ( Time_Buffer : in RTEMS.Time_Of_Day; @@ -731,13 +704,6 @@ pragma Elaborate_Body (RTEMS); -- 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; pragma Interface (C, Interrupt_Disable); pragma Interface_Name (Interrupt_Disable, "rtems_interrupt_disable"); @@ -763,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 ( @@ -800,7 +771,6 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); - -- -- Timer Manager -- @@ -908,6 +878,10 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); + procedure Semaphore_Flush ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); -- -- Message Queue Manager @@ -965,12 +939,17 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); - procedure Message_Queue_Flush ( + procedure Message_Queue_Get_Number_Pending ( ID : in RTEMS.ID; Count : out RTEMS.Unsigned32; Result : out RTEMS.Status_Codes ); + procedure Message_Queue_Flush ( + ID : in RTEMS.ID; + Count : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); -- -- Event Manager @@ -1006,7 +985,6 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); - -- -- Partition Manager -- @@ -1045,7 +1023,6 @@ pragma Elaborate_Body (RTEMS); Result : out RTEMS.Status_Codes ); - -- -- Region Manager -- @@ -1100,6 +1077,13 @@ 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 @@ -1139,59 +1123,6 @@ pragma Elaborate_Body (RTEMS); 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 -- @@ -1200,7 +1131,6 @@ pragma Elaborate_Body (RTEMS); The_Error : in RTEMS.Unsigned32 ); - -- -- Rate Monotonic Manager -- @@ -1239,6 +1169,83 @@ 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