diff options
| author | Joel Sherrill <joel.sherrill@OARcorp.com> | 2011-02-16 15:52:29 +0000 |
|---|---|---|
| committer | Joel Sherrill <joel.sherrill@OARcorp.com> | 2011-02-16 15:52:29 +0000 |
| commit | 19870208342778aecf570dfe008aa2747c46110e (patch) | |
| tree | 48f0cc573732a4e8dddca3bdf91c3488d0b13649 /c | |
| parent | 2011-02-16 Sebastian Huber <sebastian.huber@embedded-brains.de> (diff) | |
| download | rtems-19870208342778aecf570dfe008aa2747c46110e.tar.bz2 | |
2011-02-16 Joel Sherrill <joel.sherrill@oarcorp.com>
* ada/Makefile.am, ada/preinstall.am, ada/rtems.adb, ada/rtems.ads:
Split RTEMS Ada95 binding into a master package and a child package
per Manager. This is better Ada style.
* ada/rtems-barrier.adb, ada/rtems-barrier.ads, ada/rtems-clock.adb,
ada/rtems-clock.ads, ada/rtems-cpu_usage.ads, ada/rtems-debug.adb,
ada/rtems-debug.ads, ada/rtems-event.adb, ada/rtems-event.ads,
ada/rtems-extension.adb, ada/rtems-extension.ads,
ada/rtems-fatal.adb, ada/rtems-fatal.ads, ada/rtems-interrupt.ads,
ada/rtems-io.adb, ada/rtems-io.ads, ada/rtems-message_queue.adb,
ada/rtems-message_queue.ads, ada/rtems-object.adb,
ada/rtems-object.ads, ada/rtems-partition.adb,
ada/rtems-partition.ads, ada/rtems-port.adb, ada/rtems-port.ads,
ada/rtems-rate_monotonic.adb, ada/rtems-rate_monotonic.ads,
ada/rtems-region.adb, ada/rtems-region.ads, ada/rtems-semaphore.adb,
ada/rtems-semaphore.ads, ada/rtems-signal.adb, ada/rtems-signal.ads,
ada/rtems-stack_checker.ads, ada/rtems-tasks.adb,
ada/rtems-tasks.ads, ada/rtems-timer.adb, ada/rtems-timer.ads: New
files.
Diffstat (limited to 'c')
42 files changed, 4442 insertions, 3212 deletions
diff --git a/c/src/ChangeLog b/c/src/ChangeLog index 5800049150..eb8f4b15a3 100644 --- a/c/src/ChangeLog +++ b/c/src/ChangeLog @@ -1,3 +1,24 @@ +2011-02-16 Joel Sherrill <joel.sherrill@oarcorp.com> + + * ada/Makefile.am, ada/preinstall.am, ada/rtems.adb, ada/rtems.ads: + Split RTEMS Ada95 binding into a master package and a child package + per Manager. This is better Ada style. + * ada/rtems-barrier.adb, ada/rtems-barrier.ads, ada/rtems-clock.adb, + ada/rtems-clock.ads, ada/rtems-cpu_usage.ads, ada/rtems-debug.adb, + ada/rtems-debug.ads, ada/rtems-event.adb, ada/rtems-event.ads, + ada/rtems-extension.adb, ada/rtems-extension.ads, + ada/rtems-fatal.adb, ada/rtems-fatal.ads, ada/rtems-interrupt.ads, + ada/rtems-io.adb, ada/rtems-io.ads, ada/rtems-message_queue.adb, + ada/rtems-message_queue.ads, ada/rtems-object.adb, + ada/rtems-object.ads, ada/rtems-partition.adb, + ada/rtems-partition.ads, ada/rtems-port.adb, ada/rtems-port.ads, + ada/rtems-rate_monotonic.adb, ada/rtems-rate_monotonic.ads, + ada/rtems-region.adb, ada/rtems-region.ads, ada/rtems-semaphore.adb, + ada/rtems-semaphore.ads, ada/rtems-signal.adb, ada/rtems-signal.ads, + ada/rtems-stack_checker.ads, ada/rtems-tasks.adb, + ada/rtems-tasks.ads, ada/rtems-timer.adb, ada/rtems-timer.ads: New + files. + 2011-02-16 Sebastian Huber <sebastian.huber@embedded-brains.de> * libchip/serial/ns16550.c: Revert previous commit and extend existing diff --git a/c/src/ada/Makefile.am b/c/src/ada/Makefile.am index 7037537097..7a7c2155f0 100644 --- a/c/src/ada/Makefile.am +++ b/c/src/ada/Makefile.am @@ -5,7 +5,28 @@ if RTEMS_ADA include_adadir = $(includedir)/adainclude include_ada_HEADERS = rtems.adb rtems.ads -include_ada_HEADERS += rtems-multiprocessing.adb rtems-multiprocessing.ads +include_ada_HEADERS += \ + rtems-barrier.adb rtems-barrier.ads \ + rtems-clock.adb rtems-clock.ads \ + rtems-cpu_usage.ads \ + rtems-debug.adb rtems-debug.ads \ + rtems-event.adb rtems-event.ads \ + rtems-extension.adb rtems-extension.ads \ + rtems-fatal.adb rtems-fatal.ads \ + rtems-interrupt.ads \ + rtems-io.adb rtems-io.ads \ + rtems-message_queue.adb rtems-message_queue.ads \ + rtems-multiprocessing.adb rtems-multiprocessing.ads \ + rtems-object.adb rtems-object.ads \ + rtems-partition.adb rtems-partition.ads \ + rtems-port.adb rtems-port.ads \ + rtems-rate_monotonic.adb rtems-rate_monotonic.ads \ + rtems-region.adb rtems-region.ads \ + rtems-semaphore.adb rtems-semaphore.ads \ + rtems-signal.adb rtems-signal.ads \ + rtems-stack_checker.ads \ + rtems-tasks.adb rtems-tasks.ads \ + rtems-timer.adb rtems-timer.ads endif include $(srcdir)/preinstall.am diff --git a/c/src/ada/preinstall.am b/c/src/ada/preinstall.am index b7b27d3a9e..405c77a5dd 100644 --- a/c/src/ada/preinstall.am +++ b/c/src/ada/preinstall.am @@ -27,6 +27,78 @@ $(PROJECT_INCLUDE)/adainclude/rtems.ads: rtems.ads $(PROJECT_INCLUDE)/adainclude $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems.ads PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems.ads +$(PROJECT_INCLUDE)/adainclude/rtems-barrier.adb: rtems-barrier.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-barrier.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-barrier.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-barrier.ads: rtems-barrier.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-barrier.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-barrier.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-clock.adb: rtems-clock.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-clock.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-clock.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-clock.ads: rtems-clock.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-clock.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-clock.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-cpu_usage.ads: rtems-cpu_usage.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-cpu_usage.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-cpu_usage.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-debug.adb: rtems-debug.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-debug.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-debug.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-debug.ads: rtems-debug.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-debug.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-debug.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-event.adb: rtems-event.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-event.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-event.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-event.ads: rtems-event.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-event.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-event.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-extension.adb: rtems-extension.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-extension.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-extension.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-extension.ads: rtems-extension.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-extension.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-extension.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-fatal.adb: rtems-fatal.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-fatal.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-fatal.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-fatal.ads: rtems-fatal.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-fatal.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-fatal.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-interrupt.ads: rtems-interrupt.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-interrupt.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-interrupt.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-io.adb: rtems-io.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-io.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-io.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-io.ads: rtems-io.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-io.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-io.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-message_queue.adb: rtems-message_queue.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-message_queue.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-message_queue.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-message_queue.ads: rtems-message_queue.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-message_queue.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-message_queue.ads + $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.adb: rtems-multiprocessing.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.adb PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.adb @@ -34,4 +106,80 @@ PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.adb $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.ads: rtems-multiprocessing.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.ads PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-multiprocessing.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-object.adb: rtems-object.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-object.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-object.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-object.ads: rtems-object.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-object.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-object.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-partition.adb: rtems-partition.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-partition.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-partition.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-partition.ads: rtems-partition.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-partition.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-partition.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-port.adb: rtems-port.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-port.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-port.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-port.ads: rtems-port.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-port.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-port.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.adb: rtems-rate_monotonic.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.ads: rtems-rate_monotonic.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-rate_monotonic.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-region.adb: rtems-region.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-region.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-region.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-region.ads: rtems-region.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-region.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-region.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-semaphore.adb: rtems-semaphore.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-semaphore.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-semaphore.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-semaphore.ads: rtems-semaphore.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-semaphore.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-semaphore.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-signal.adb: rtems-signal.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-signal.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-signal.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-signal.ads: rtems-signal.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-signal.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-signal.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-stack_checker.ads: rtems-stack_checker.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-stack_checker.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-stack_checker.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-tasks.adb: rtems-tasks.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-tasks.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-tasks.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-tasks.ads: rtems-tasks.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-tasks.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-tasks.ads + +$(PROJECT_INCLUDE)/adainclude/rtems-timer.adb: rtems-timer.adb $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-timer.adb +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-timer.adb + +$(PROJECT_INCLUDE)/adainclude/rtems-timer.ads: rtems-timer.ads $(PROJECT_INCLUDE)/adainclude/$(dirstamp) + $(INSTALL_DATA) $< $(PROJECT_INCLUDE)/adainclude/rtems-timer.ads +PREINSTALL_FILES += $(PROJECT_INCLUDE)/adainclude/rtems-timer.ads endif diff --git a/c/src/ada/rtems-barrier.adb b/c/src/ada/rtems-barrier.adb new file mode 100644 index 0000000000..8b5ec60177 --- /dev/null +++ b/c/src/ada/rtems-barrier.adb @@ -0,0 +1,128 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with Ada; +with Ada.Unchecked_Conversion; +with Interfaces; use Interfaces; +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; + +package body RTEMS.Barrier is + + -- + -- Barrier Manager + -- + + procedure 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 Create_Base + (Name : RTEMS.Name; + Attribute_Set : RTEMS.Attribute; + Maximum_Waiters : RTEMS.Unsigned32; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_barrier_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := + Create_Base + (Name, + Attribute_Set, + Maximum_Waiters, + ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_barrier_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_barrier_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Wait + (ID : in RTEMS.ID; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes) + is + function Wait_Base + (ID : RTEMS.ID; + Timeout : RTEMS.Interval) + return RTEMS.Status_Codes; + pragma Import (C, Wait_Base, "rtems_barrier_wait"); + begin + + Result := Wait_Base (ID, Timeout); + + end Wait; + + procedure Release + (ID : in RTEMS.ID; + Released : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes) + is + function Release_Base + (ID : RTEMS.ID; + Released : access RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import (C, Release_Base, "rtems_barrier_release"); + Released_Base : aliased RTEMS.Unsigned32; + begin + + Result := Release_Base (ID, Released_Base'Access); + Released := Released_Base; + + end Release; + +end RTEMS.Barrier; diff --git a/c/src/ada/rtems-barrier.ads b/c/src/ada/rtems-barrier.ads new file mode 100644 index 0000000000..6873d1ab10 --- /dev/null +++ b/c/src/ada/rtems-barrier.ads @@ -0,0 +1,67 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with System; +with System.Storage_Elements; use System.Storage_Elements; +with Interfaces; +with Interfaces.C; + +package RTEMS.Barrier is + + -- + -- 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; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + + procedure Barrier_Release ( + ID : in RTEMS.ID; + Released : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Barrier; + diff --git a/c/src/ada/rtems-clock.adb b/c/src/ada/rtems-clock.adb new file mode 100644 index 0000000000..94ae656a62 --- /dev/null +++ b/c/src/ada/rtems-clock.adb @@ -0,0 +1,143 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Clock is + + -- + -- Clock Manager + -- + + procedure Set + (Time_Buffer : in RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes) + is + function Set_Base + (Time_Buffer : access RTEMS.Time_Of_Day) + return RTEMS.Status_Codes; + pragma Import (C, Set_Base, "rtems_clock_set"); + + Tmp_Time : aliased RTEMS.Time_Of_Day; + begin + + Tmp_Time := Time_Buffer; + Result := Set_Base (Tmp_Time'Access); + + end Set; + + procedure Get + (Option : in RTEMS.Clock.Get_Options; + Time_Buffer : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Get_Base + (Option : RTEMS.Clock.Get_Options; + Time_Buffer : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Get_Base, "rtems_clock_get"); + begin + + Result := Get_Base (Option, Time_Buffer); + + end Get; + + procedure Get_TOD + (Time : out RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes) + is + function Get_TOD_Base + (Time : access RTEMS.Time_Of_Day) + return RTEMS.Status_Codes; + pragma Import (C, Get_TOD_Base, "rtems_clock_get_tod"); + + Tmp_Time : aliased RTEMS.Time_Of_Day; + begin + Result := Get_TOD_Base (Tmp_Time'Access); + Time := Tmp_Time; + end Get_TOD; + + procedure Get_TOD_Time_Value + (Time : out RTEMS.Time_Value; + Result : out RTEMS.Status_Codes) + is + function Get_TOD_Time_Value_Base + (Time : access RTEMS.Time_Value) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_TOD_Time_Value_Base, + "rtems_clock_get_tod_timeval"); + + Tmp_Time : aliased RTEMS.Time_Value; + begin + Result := Get_TOD_Time_Value_Base (Tmp_Time'Access); + Time := Tmp_Time; + end Get_TOD_Time_Value; + + procedure Get_Seconds_Since_Epoch + (The_Interval : out RTEMS.Interval; + Result : out RTEMS.Status_Codes) + is + function Get_Seconds_Since_Epoch_Base + (The_Interval : access RTEMS.Interval) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Seconds_Since_Epoch_Base, + "rtems_clock_get_seconds_since_epoch"); + + Tmp_Interval : aliased RTEMS.Interval; + begin + Result := + Get_Seconds_Since_Epoch_Base (Tmp_Interval'Access); + The_Interval := Tmp_Interval; + end Get_Seconds_Since_Epoch; + + -- Get_Ticks_Per_Second is in rtems.ads + + -- Get_Ticks_Since_Boot is in rtems.ads + + procedure Get_Uptime + (Uptime : out RTEMS.Timespec; + Result : out RTEMS.Status_Codes) + is + function Get_Uptime_Base + (Uptime : access RTEMS.Timespec) + return RTEMS.Status_Codes; + pragma Import (C, Get_Uptime_Base, "rtems_clock_get_uptime"); + Uptime_Base : aliased RTEMS.Timespec; + begin + + Result := Get_Uptime_Base (Uptime_Base'Access); + Uptime := Uptime_Base; + + end Get_Uptime; + + procedure Tick (Result : out RTEMS.Status_Codes) is + function Tick_Base return RTEMS.Status_Codes; + pragma Import (C, Tick_Base, "rtems_clock_tick"); + begin + + Result := Tick_Base; + + end Tick; + +end RTEMS.Clock; diff --git a/c/src/ada/rtems-clock.ads b/c/src/ada/rtems-clock.ads new file mode 100644 index 0000000000..34dbcb4a79 --- /dev/null +++ b/c/src/ada/rtems-clock.ads @@ -0,0 +1,109 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + + +package RTEMS.Clock is + + -- + -- Clock Types + -- + + type Time_Value is + record + Seconds : RTEMS.Unsigned32; + Microseconds : RTEMS.Unsigned32; + end record; + + type Clock_Get_Options is ( + Clock_Get_TOD, + Clock_Get_Seconds_Since_Epoch, + Clock_Get_Ticks_Since_Boot, + Clock_Get_Ticks_Per_Second, + Clock_Get_Time_Value + ); + + type Get_Options is ( + Get_TOD, + Get_Seconds_Since_Epoch, + Get_Ticks_Since_Boot, + Get_Ticks_Per_Second, + Get_Time_Value + ); + + -- + -- Clock Manager + -- + + procedure Set ( + Time_Buffer : in RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes + ); + + procedure Get ( + Option : in RTEMS.Clock.Get_Options; + Time_Buffer : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Get_TOD ( + Time : out RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes + ); + + procedure Get_TOD_Time_Value ( + Time : out RTEMS.Time_Value; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Seconds_Since_Epoch( + The_Interval : out RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + + function Get_Ticks_Per_Second + return RTEMS.Interval; + pragma Import ( + C, + Get_Ticks_Per_Second, + "rtems_clock_get_ticks_per_second" + ); + + function Get_Ticks_Since_Boot + return RTEMS.Interval; + pragma Import ( + C, + Get_Ticks_Since_Boot, + "rtems_clock_get_ticks_since_boot" + ); + + procedure Get_Uptime ( + Uptime : out RTEMS.Timespec; + Result : out RTEMS.Status_Codes + ); + + procedure Tick ( + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Clock; + diff --git a/c/src/ada/rtems-cpu_usage.ads b/c/src/ada/rtems-cpu_usage.ads new file mode 100644 index 0000000000..9aa7488ee3 --- /dev/null +++ b/c/src/ada/rtems-cpu_usage.ads @@ -0,0 +1,42 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with System; +with System.Storage_Elements; use System.Storage_Elements; +with Interfaces; +with Interfaces.C; + +package RTEMS.CPU_Usage is + + -- + -- CPU Usage Statistics + -- + + procedure Report; + pragma Import (C, Report, "rtems_cpu_usage_report"); + + procedure Reset; + pragma Import (C, Reset, "rtems_cpu_usage_reset"); + +end RTEMS.CPU_Usage; + diff --git a/c/src/ada/rtems-debug.adb b/c/src/ada/rtems-debug.adb new file mode 100644 index 0000000000..fbf639ecb6 --- /dev/null +++ b/c/src/ada/rtems-debug.adb @@ -0,0 +1,61 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Debug is + + -- + -- Debug Manager + -- + + procedure Enable (To_Be_Enabled : in Set) is + procedure Enable_Base (To_Be_Enabled : Set); + pragma Import (C, Enable_Base, "rtems_debug_enable"); + begin + + Enable_Base (To_Be_Enabled); + + end Enable; + + procedure Disable (To_Be_Disabled : in Set) is + procedure Disable_Base (To_Be_Disabled : Set); + pragma Import (C, Disable_Base, "rtems_debug_disable"); + begin + + Disable_Base (To_Be_Disabled); + + end Disable; + + function Is_Enabled + (Level : in Set) + return RTEMS.Boolean + is + function Is_Enabled_Base + (Level : Set) + return RTEMS.Boolean; + pragma Import (C, Is_Enabled_Base, "rtems_debug_is_enabled"); + begin + + return Is_Enabled_Base (Level); + + end Is_Enabled; + +end RTEMS.Debug; diff --git a/c/src/ada/rtems-debug.ads b/c/src/ada/rtems-debug.ads new file mode 100644 index 0000000000..7df71ac3e8 --- /dev/null +++ b/c/src/ada/rtems-debug.ads @@ -0,0 +1,47 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Debug is + + subtype Set is RTEMS.Unsigned32; + + -- + -- Debug Manager + -- + + All_Mask : constant Set := 16#ffffffff#; + Region : constant Set := 16#00000001#; + + procedure Enable ( + To_Be_Enabled : in Set + ); + + procedure Disable ( + To_Be_Disabled : in Set + ); + + function Is_Enabled ( + Level : in Set + ) return RTEMS.Boolean; + +end RTEMS.Debug; diff --git a/c/src/ada/rtems-event.adb b/c/src/ada/rtems-event.adb new file mode 100644 index 0000000000..49be8600bd --- /dev/null +++ b/c/src/ada/rtems-event.adb @@ -0,0 +1,72 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Event is + + -- + -- Event Manager + -- + + procedure Send + (ID : in RTEMS.ID; + Event_In : in RTEMS.Event_Set; + Result : out RTEMS.Status_Codes) + is + function Send_Base + (ID : RTEMS.ID; + Event_In : RTEMS.Event_Set) + return RTEMS.Status_Codes; + pragma Import (C, Send_Base, "rtems_event_send"); + begin + + Result := Send_Base (ID, Event_In); + + end Send; + + procedure Receive + (Event_In : in RTEMS.Event_Set; + Option_Set : in RTEMS.Option; + Ticks : in RTEMS.Interval; + Event_Out : out RTEMS.Event_Set; + Result : out RTEMS.Status_Codes) + is + function Receive_Base + (Event_In : RTEMS.Event_Set; + Option_Set : RTEMS.Option; + Ticks : RTEMS.Interval; + Event_Out : access RTEMS.Event_Set) + return RTEMS.Status_Codes; + pragma Import (C, Receive_Base, "rtems_event_receive"); + Event_Out_Base : aliased RTEMS.Event_Set; + begin + + Result := + Receive_Base + (Event_In, + Option_Set, + Ticks, + Event_Out_Base'Access); + Event_Out := Event_Out_Base; + + end Receive; + +end RTEMS.Event; diff --git a/c/src/ada/rtems-event.ads b/c/src/ada/rtems-event.ads new file mode 100644 index 0000000000..fa07f9a8ef --- /dev/null +++ b/c/src/ada/rtems-event.ads @@ -0,0 +1,45 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Event is + + -- + -- Event Manager + -- + + procedure Send ( + ID : in RTEMS.ID; + Event_In : in RTEMS.Event_Set; + Result : out RTEMS.Status_Codes + ); + + procedure Receive ( + Event_In : in RTEMS.Event_Set; + Option_Set : in RTEMS.Option; + Ticks : in RTEMS.Interval; + Event_Out : out RTEMS.Event_Set; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Event; + diff --git a/c/src/ada/rtems-extension.adb b/c/src/ada/rtems-extension.adb new file mode 100644 index 0000000000..acc630f27b --- /dev/null +++ b/c/src/ada/rtems-extension.adb @@ -0,0 +1,81 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Extension is + + -- + -- Extension Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Table : in RTEMS.Extensions_Table_Pointer; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Table : RTEMS.Extensions_Table_Pointer; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_extension_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Create_Base (Name, Table, ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_extension_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_extension_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + +end RTEMS.Extension; diff --git a/c/src/ada/rtems-extension.ads b/c/src/ada/rtems-extension.ads new file mode 100644 index 0000000000..502d25da9a --- /dev/null +++ b/c/src/ada/rtems-extension.ads @@ -0,0 +1,49 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Extension is + + -- + -- Extension Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Table : in RTEMS.Extensions_Table_Pointer; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Extension; + diff --git a/c/src/ada/rtems-fatal.adb b/c/src/ada/rtems-fatal.adb new file mode 100644 index 0000000000..558af7c108 --- /dev/null +++ b/c/src/ada/rtems-fatal.adb @@ -0,0 +1,38 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Fatal is + + -- + -- Fatal Error Manager + -- + + procedure Error_Occurred (The_Error : in RTEMS.Unsigned32) is + procedure Error_Occurred_Base (The_Error : RTEMS.Unsigned32); + pragma Import (C, Error_Occurred_Base, "rtems_fatal_error_occurred"); + begin + + Error_Occurred_Base (The_Error); + + end Error_Occurred; + +end RTEMS.Fatal; diff --git a/c/src/ada/rtems-fatal.ads b/c/src/ada/rtems-fatal.ads new file mode 100644 index 0000000000..c9fcb1d004 --- /dev/null +++ b/c/src/ada/rtems-fatal.ads @@ -0,0 +1,35 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Fatal is + + -- + -- Fatal Error Manager + -- + + procedure Error_Occurred ( + The_Error : in RTEMS.Unsigned32 + ); + +end RTEMS.Fatal; + diff --git a/c/src/ada/rtems-interrupt.ads b/c/src/ada/rtems-interrupt.ads new file mode 100644 index 0000000000..75d4768bc2 --- /dev/null +++ b/c/src/ada/rtems-interrupt.ads @@ -0,0 +1,51 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Interrupt is + + -- + -- Interrupt Manager + -- + + function Disable return RTEMS.ISR_Level; + pragma Interface (C, Disable); + pragma Interface_Name (Disable, "rtems_interrupt_disable"); + + procedure Enable ( + Level : in RTEMS.ISR_Level + ); + pragma Interface (C, Enable); + pragma Interface_Name (Enable, "rtems_interrupt_enable"); + + procedure Flash ( + Level : in RTEMS.ISR_Level + ); + pragma Interface (C, Flash); + pragma Interface_Name (Flash, "rtems_interrupt_flash"); + + function Is_In_Progress return RTEMS.Boolean; + pragma Interface (C, Is_In_Progress); + pragma Interface_Name (Is_In_Progress, "rtems_interrupt_is_in_progress"); + +end RTEMS.Interrupt; + diff --git a/c/src/ada/rtems-io.adb b/c/src/ada/rtems-io.adb new file mode 100644 index 0000000000..b11623cb99 --- /dev/null +++ b/c/src/ada/rtems-io.adb @@ -0,0 +1,169 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with Ada; +with Ada.Unchecked_Conversion; +with Interfaces; use Interfaces; +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; + +package body RTEMS.IO is + + -- + -- Input/Output Manager + -- + + procedure Register_Name + (Name : in String; + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Result : out RTEMS.Status_Codes) + is + function 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, Register_Name_Base, "rtems_io_register_name"); + begin + + Result := Register_Name_Base (Interfaces.C.To_C (Name), Major, Minor); + + end Register_Name; + + procedure Lookup_Name + (Name : in String; + Device_Info : out RTEMS.Driver_Name_t; + Result : out RTEMS.Status_Codes) + is + function Lookup_Name_Base + (Name : Interfaces.C.char_array; + Device_Info : access RTEMS.Driver_Name_t) + return RTEMS.Status_Codes; + pragma Import (C, Lookup_Name_Base, "rtems_io_lookup_name"); + Device_Info_Base : aliased RTEMS.Driver_Name_t; + begin + + Result := + Lookup_Name_Base + (Interfaces.C.To_C (Name), + Device_Info_Base'Unchecked_Access); + Device_Info := Device_Info_Base; + + end Lookup_Name; + + procedure Open + (Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Open_Base + (Major : RTEMS.Device_Major_Number; + Minor : RTEMS.Device_Minor_Number; + Argument : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Open_Base, "rtems_io_open"); + begin + + Result := Open_Base (Major, Minor, Argument); + + end Open; + pragma Inline (Open); + + procedure Close + (Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Close_Base + (Major : RTEMS.Device_Major_Number; + Minor : RTEMS.Device_Minor_Number; + Argument : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Close_Base, "rtems_io_close"); + begin + + Result := Close_Base (Major, Minor, Argument); + + end Close; + pragma Inline (Close); + + procedure Read + (Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Read_Base + (Major : RTEMS.Device_Major_Number; + Minor : RTEMS.Device_Minor_Number; + Argument : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Read_Base, "rtems_io_read"); + begin + + Result := Read_Base (Major, Minor, Argument); + + end Read; + pragma Inline (Read); + + procedure Write + (Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Write_Base + (Major : RTEMS.Device_Major_Number; + Minor : RTEMS.Device_Minor_Number; + Argument : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Write_Base, "rtems_io_write"); + begin + + Result := Write_Base (Major, Minor, Argument); + + end Write; + pragma Inline (Write); + + procedure Control + (Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Control_Base + (Major : RTEMS.Device_Major_Number; + Minor : RTEMS.Device_Minor_Number; + Argument : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Control_Base, "rtems_io_control"); + begin + + Result := Control_Base (Major, Minor, Argument); + + end Control; + pragma Inline (Control); + +end RTEMS.IO; diff --git a/c/src/ada/rtems-io.ads b/c/src/ada/rtems-io.ads new file mode 100644 index 0000000000..9329d14ce7 --- /dev/null +++ b/c/src/ada/rtems-io.ads @@ -0,0 +1,89 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with System; +with System.Storage_Elements; use System.Storage_Elements; +with Interfaces; +with Interfaces.C; + +package RTEMS.IO is + + -- + -- Input/Output Manager + -- + + procedure Register_Name ( + Name : in String; + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Result : out RTEMS.Status_Codes + ); + + procedure Lookup_Name ( + Name : in String; + Device_Info : out RTEMS.Driver_Name_t; + Result : out RTEMS.Status_Codes + ); + + procedure Open ( + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + pragma Inline (Open); + + procedure Close ( + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + pragma Inline (Close); + + procedure Read ( + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + pragma Inline (Read); + + procedure Write ( + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + pragma Inline (Write); + + procedure Control ( + Major : in RTEMS.Device_Major_Number; + Minor : in RTEMS.Device_Minor_Number; + Argument : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + pragma Inline (Control); + +end RTEMS.IO; + diff --git a/c/src/ada/rtems-message_queue.adb b/c/src/ada/rtems-message_queue.adb new file mode 100644 index 0000000000..8d911ee7da --- /dev/null +++ b/c/src/ada/rtems-message_queue.adb @@ -0,0 +1,245 @@ +--
+-- RTEMS / Body
+--
+-- DESCRIPTION:
+--
+-- This package provides the interface to the RTEMS API.
+--
+--
+-- DEPENDENCIES:
+--
+--
+--
+-- COPYRIGHT (c) 1997-2011.
+-- 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.rtems.com/license/LICENSE.
+--
+-- $Id$
+--
+
+package body RTEMS.Message_Queue is
+
+ --
+ -- Message Queue Manager
+ --
+
+ procedure Create
+ (Name : in RTEMS.Name;
+ Count : in RTEMS.Unsigned32;
+ Max_Message_Size : in RTEMS.Unsigned32;
+ Attribute_Set : in RTEMS.Attribute;
+ ID : out RTEMS.ID;
+ Result : out RTEMS.Status_Codes)
+ is
+ -- XXX broken
+ function Create_Base
+ (Name : RTEMS.Name;
+ Count : RTEMS.Unsigned32;
+ Max_Message_Size : RTEMS.Unsigned32;
+ Attribute_Set : RTEMS.Attribute;
+ ID : access RTEMS.ID)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Create_Base,
+ "rtems_message_queue_create");
+ ID_Base : aliased RTEMS.ID;
+ begin
+
+ Result :=
+ Create_Base
+ (Name,
+ Count,
+ Max_Message_Size,
+ Attribute_Set,
+ ID_Base'Access);
+ ID := ID_Base;
+
+ end Create;
+
+ procedure Ident
+ (Name : in RTEMS.Name;
+ Node : in RTEMS.Unsigned32;
+ ID : out RTEMS.ID;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Ident_Base
+ (Name : RTEMS.Name;
+ Node : RTEMS.Unsigned32;
+ ID : access RTEMS.ID)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Ident_Base,
+ "rtems_message_queue_ident");
+ ID_Base : aliased RTEMS.ID;
+ begin
+
+ Result := Ident_Base (Name, Node, ID_Base'Access);
+ ID := ID_Base;
+
+ end Ident;
+
+ procedure Delete
+ (ID : in RTEMS.ID;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Delete_Base
+ (ID : RTEMS.ID)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Delete_Base,
+ "rtems_message_queue_delete");
+ begin
+
+ Result := Delete_Base (ID);
+
+ end Delete;
+
+ procedure Send
+ (ID : in RTEMS.ID;
+ Buffer : in RTEMS.Address;
+ Size : in RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Send_Base
+ (ID : RTEMS.ID;
+ Buffer : RTEMS.Address;
+ Size : RTEMS.Unsigned32)
+ return RTEMS.Status_Codes;
+ pragma Import (C, Send_Base, "rtems_message_queue_send");
+ begin
+
+ Result := Send_Base (ID, Buffer, Size);
+
+ end Send;
+
+ procedure Urgent
+ (ID : in RTEMS.ID;
+ Buffer : in RTEMS.Address;
+ Size : in RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Urgent_Base
+ (ID : RTEMS.ID;
+ Buffer : RTEMS.Address;
+ Size : RTEMS.Unsigned32)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Urgent_Base,
+ "rtems_message_queue_urgent");
+ begin
+
+ Result := Urgent_Base (ID, Buffer, Size);
+
+ end Urgent;
+
+ procedure Broadcast
+ (ID : in RTEMS.ID;
+ Buffer : in RTEMS.Address;
+ Size : in RTEMS.Unsigned32;
+ Count : out RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Broadcast_Base
+ (ID : RTEMS.ID;
+ Buffer : RTEMS.Address;
+ Size : RTEMS.Unsigned32;
+ Count : access RTEMS.Unsigned32)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Broadcast_Base,
+ "rtems_message_queue_broadcast");
+ Count_Base : aliased RTEMS.Unsigned32;
+ begin
+
+ Result :=
+ Broadcast_Base (ID, Buffer, Size, Count_Base'Access);
+ Count := Count_Base;
+
+ end Broadcast;
+
+ procedure Receive
+ (ID : in RTEMS.ID;
+ Buffer : in RTEMS.Address;
+ Option_Set : in RTEMS.Option;
+ Timeout : in RTEMS.Interval;
+ Size : in out RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Receive_Base
+ (ID : RTEMS.ID;
+ Buffer : RTEMS.Address;
+ Size : access RTEMS.Unsigned32;
+ Option_Set : RTEMS.Option;
+ Timeout : RTEMS.Interval)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Receive_Base,
+ "rtems_message_queue_receive");
+ Size_Base : aliased RTEMS.Unsigned32;
+ begin
+
+ Size_Base := Size;
+
+ Result :=
+ Receive_Base
+ (ID,
+ Buffer,
+ Size_Base'Access,
+ Option_Set,
+ Timeout);
+ Size := Size_Base;
+
+ end Receive;
+
+ procedure Get_Number_Pending
+ (ID : in RTEMS.ID;
+ Count : out RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Get_Number_Pending_Base
+ (ID : RTEMS.ID;
+ Count : access RTEMS.Unsigned32)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Get_Number_Pending_Base,
+ "rtems_message_queue_get_number_pending");
+ COUNT_Base : aliased RTEMS.Unsigned32;
+ begin
+
+ Result := Get_Number_Pending_Base (ID, COUNT_Base'Access);
+ Count := COUNT_Base;
+
+ end Get_Number_Pending;
+
+ procedure Flush
+ (ID : in RTEMS.ID;
+ Count : out RTEMS.Unsigned32;
+ Result : out RTEMS.Status_Codes)
+ is
+ function Flush_Base
+ (ID : RTEMS.ID;
+ Count : access RTEMS.Unsigned32)
+ return RTEMS.Status_Codes;
+ pragma Import
+ (C,
+ Flush_Base,
+ "rtems_message_queue_flush");
+ COUNT_Base : aliased RTEMS.Unsigned32;
+ begin
+
+ Result := Flush_Base (ID, COUNT_Base'Access);
+ Count := COUNT_Base;
+
+ end Flush;
+
+end RTEMS.Message_Queue;
diff --git a/c/src/ada/rtems-message_queue.ads b/c/src/ada/rtems-message_queue.ads new file mode 100644 index 0000000000..426128a909 --- /dev/null +++ b/c/src/ada/rtems-message_queue.ads @@ -0,0 +1,95 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Message_Queue is + + -- + -- Message Queue Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Count : in RTEMS.Unsigned32; + Max_Message_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + Node : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Send ( + ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Urgent ( + ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Broadcast ( + ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Count : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Receive ( + ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Size : in out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Number_Pending ( + ID : in RTEMS.ID; + Count : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Flush ( + ID : in RTEMS.ID; + Count : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Message_Queue; + diff --git a/c/src/ada/rtems-object.adb b/c/src/ada/rtems-object.adb new file mode 100644 index 0000000000..8e9a16404b --- /dev/null +++ b/c/src/ada/rtems-object.adb @@ -0,0 +1,305 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with Interfaces; use Interfaces; +with Interfaces.C.Strings; use Interfaces.C.Strings; + +package body RTEMS.Object is + + -- + -- Object Services + -- + + function Build_Name + (C1 : in Character; + C2 : in Character; + C3 : in Character; + C4 : in Character) + return RTEMS.Name + is + C1_Value : RTEMS.Unsigned32; + C2_Value : RTEMS.Unsigned32; + C3_Value : RTEMS.Unsigned32; + C4_Value : RTEMS.Unsigned32; + begin + + C1_Value := Character'Pos (C1); + C2_Value := Character'Pos (C2); + C3_Value := Character'Pos (C3); + C4_Value := Character'Pos (C4); + + return Interfaces.Shift_Left (C1_Value, 24) or + Interfaces.Shift_Left (C2_Value, 16) or + Interfaces.Shift_Left (C3_Value, 8) or + C4_Value; + + end Build_Name; + + procedure Get_Classic_Name + (ID : in RTEMS.ID; + Name : out RTEMS.Name; + Result : out RTEMS.Status_Codes) + is + function Get_Classic_Name_Base + (ID : RTEMS.ID; + Name : access RTEMS.Name) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Classic_Name_Base, + "rtems_object_get_classic_name"); + Tmp_Name : aliased RTEMS.Name; + begin + Result := Get_Classic_Name_Base (ID, Tmp_Name'Access); + Name := Tmp_Name; + end Get_Classic_Name; + + procedure Get_Name + (ID : in RTEMS.ID; + Name : out String; + Result : out RTEMS.Address) + is + function Get_Name_Base + (ID : RTEMS.ID; + Length : RTEMS.Unsigned32; + Name : RTEMS.Address) + return RTEMS.Address; + pragma Import (C, Get_Name_Base, "rtems_object_get_name"); + begin + Name := (others => ASCII.NUL); + Result := + Get_Name_Base (ID, Name'Length, Name (Name'First)'Address); + end Get_Name; + + procedure Set_Name + (ID : in RTEMS.ID; + Name : in String; + Result : out RTEMS.Status_Codes) + is + function Set_Name_Base + (ID : RTEMS.ID; + Name : chars_ptr) + return RTEMS.Status_Codes; + pragma Import (C, Set_Name_Base, "rtems_object_set_name"); + NameAsCString : constant chars_ptr := New_String (Name); + begin + Result := Set_Name_Base (ID, NameAsCString); + end Set_Name; + + procedure Id_Get_API + (ID : in RTEMS.ID; + API : out RTEMS.Unsigned32) + is + function Id_Get_API_Base + (ID : RTEMS.ID) + return RTEMS.Unsigned32; + pragma Import (C, Id_Get_API_Base, "rtems_object_id_get_api"); + begin + API := Id_Get_API_Base (ID); + end Id_Get_API; + + procedure Id_Get_Class + (ID : in RTEMS.ID; + The_Class : out RTEMS.Unsigned32) + is + function Id_Get_Class_Base + (ID : RTEMS.ID) + return RTEMS.Unsigned32; + pragma Import + (C, + Id_Get_Class_Base, + "rtems_object_id_get_class"); + begin + The_Class := Id_Get_Class_Base (ID); + end Id_Get_Class; + + procedure Id_Get_Node + (ID : in RTEMS.ID; + Node : out RTEMS.Unsigned32) + is + function Id_Get_Node_Base + (ID : RTEMS.ID) + return RTEMS.Unsigned32; + pragma Import (C, Id_Get_Node_Base, "rtems_object_id_get_node"); + begin + Node := Id_Get_Node_Base (ID); + end Id_Get_Node; + + procedure Id_Get_Index + (ID : in RTEMS.ID; + Index : out RTEMS.Unsigned32) + is + function Id_Get_Index_Base + (ID : RTEMS.ID) + return RTEMS.Unsigned32; + pragma Import + (C, + Id_Get_Index_Base, + "rtems_object_id_get_index"); + begin + Index := Id_Get_Index_Base (ID); + end Id_Get_Index; + + function Build_Id + (The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + The_Node : in RTEMS.Unsigned32; + The_Index : in RTEMS.Unsigned32) + return RTEMS.ID + is + function Build_Id_Base + (The_API : RTEMS.Unsigned32; + The_Class : RTEMS.Unsigned32; + The_Node : RTEMS.Unsigned32; + The_Index : RTEMS.Unsigned32) + return RTEMS.ID; + pragma Import (C, Build_Id_Base, "rtems_build_id"); + begin + return Build_Id_Base (The_API, The_Class, The_Node, The_Index); + end Build_Id; + + function Id_API_Minimum return RTEMS.Unsigned32 is + function Id_API_Minimum_Base return RTEMS.Unsigned32; + pragma Import + (C, + Id_API_Minimum_Base, + "rtems_object_id_api_minimum"); + begin + return Id_API_Minimum_Base; + end Id_API_Minimum; + + function Id_API_Maximum return RTEMS.Unsigned32 is + function Id_API_Maximum_Base return RTEMS.Unsigned32; + pragma Import + (C, + Id_API_Maximum_Base, + "rtems_object_id_api_maximum"); + begin + return Id_API_Maximum_Base; + end Id_API_Maximum; + + procedure API_Minimum_Class + (API : in RTEMS.Unsigned32; + Minimum : out RTEMS.Unsigned32) + is + function API_Minimum_Class_Base + (API : RTEMS.Unsigned32) + return RTEMS.Unsigned32; + pragma Import + (C, + API_Minimum_Class_Base, + "rtems_object_api_minimum_class"); + begin + Minimum := API_Minimum_Class_Base (API); + end API_Minimum_Class; + + procedure API_Maximum_Class + (API : in RTEMS.Unsigned32; + Maximum : out RTEMS.Unsigned32) + is + function API_Maximum_Class_Base + (API : RTEMS.Unsigned32) + return RTEMS.Unsigned32; + pragma Import + (C, + API_Maximum_Class_Base, + "rtems_object_api_maximum_class"); + begin + Maximum := API_Maximum_Class_Base (API); + end API_Maximum_Class; + + -- Translate S from a C-style char* into an Ada String. + -- If S is Null_Ptr, return "", don't raise an exception. + -- Copied from Lovelace Tutorial + function Value_Without_Exception (S : chars_ptr) return String is + begin + if S = Null_Ptr then + return ""; + else + return Value (S); + end if; + end Value_Without_Exception; + pragma Inline (Value_Without_Exception); + + procedure Get_API_Name + (API : in RTEMS.Unsigned32; + Name : out String) + is + function Get_API_Name_Base + (API : RTEMS.Unsigned32) + return chars_ptr; + pragma Import + (C, + Get_API_Name_Base, + "rtems_object_get_api_name"); + Result : constant chars_ptr := Get_API_Name_Base (API); + APIName : constant String := Value_Without_Exception (Result); + begin + Name := APIName; + end Get_API_Name; + + procedure Get_API_Class_Name + (The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + Name : out String) + is + function Get_API_Class_Name_Base + (API : RTEMS.Unsigned32; + Class : RTEMS.Unsigned32) + return chars_ptr; + pragma Import + (C, + Get_API_Class_Name_Base, + "rtems_object_get_api_class_name"); + Result : constant chars_ptr := + Get_API_Class_Name_Base (The_API, The_Class); + ClassName : constant String := Value_Without_Exception (Result); + begin + Name := ClassName; + end Get_API_Class_Name; + + procedure Get_Class_Information + (The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + Info : out API_Class_Information; + Result : out RTEMS.Status_Codes) + is + function Get_Class_Information_Base + (The_API : RTEMS.Unsigned32; + The_Class : RTEMS.Unsigned32; + Info : access API_Class_Information) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Class_Information_Base, + "rtems_object_get_class_information"); + TmpInfo : aliased API_Class_Information; + begin + Result := + Get_Class_Information_Base + (The_API, + The_Class, + TmpInfo'Access); + Info := TmpInfo; + end Get_Class_Information; + +end RTEMS.Object; diff --git a/c/src/ada/rtems-object.ads b/c/src/ada/rtems-object.ads new file mode 100644 index 0000000000..8160f2b29f --- /dev/null +++ b/c/src/ada/rtems-object.ads @@ -0,0 +1,123 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Object is + + -- + -- Object Services + -- + + function Build_Name ( + C1 : in Character; + C2 : in Character; + C3 : in Character; + C4 : in Character + ) return RTEMS.Name; + + procedure Get_Classic_Name( + ID : in RTEMS.ID; + Name : out RTEMS.Name; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Name( + ID : in RTEMS.ID; + Name : out String; + Result : out RTEMS.Address + ); + + procedure Set_Name( + ID : in RTEMS.ID; + Name : in String; + Result : out RTEMS.Status_Codes + ); + + procedure Id_Get_API( + ID : in RTEMS.ID; + API : out RTEMS.Unsigned32 + ); + + procedure Id_Get_Class( + ID : in RTEMS.ID; + The_Class : out RTEMS.Unsigned32 + ); + + procedure Id_Get_Node( + ID : in RTEMS.ID; + Node : out RTEMS.Unsigned32 + ); + + procedure Id_Get_Index( + ID : in RTEMS.ID; + Index : out RTEMS.Unsigned32 + ); + + function Build_Id( + The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + The_Node : in RTEMS.Unsigned32; + The_Index : in RTEMS.Unsigned32 + ) return RTEMS.Id; + + function Id_API_Minimum return RTEMS.Unsigned32; + + function Id_API_Maximum return RTEMS.Unsigned32; + + procedure API_Minimum_Class( + API : in RTEMS.Unsigned32; + Minimum : out RTEMS.Unsigned32 + ); + + procedure API_Maximum_Class( + API : in RTEMS.Unsigned32; + Maximum : out RTEMS.Unsigned32 + ); + + procedure Get_API_Name( + API : in RTEMS.Unsigned32; + Name : out String + ); + + procedure Get_API_Class_Name( + The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + Name : out String + ); + + type API_Class_Information is + record + Minimum_Id : RTEMS.Id; + Maximum_Id : RTEMS.Id; + Maximum : RTEMS.Unsigned32; + AutoExtend : RTEMS.Boolean; + Unallocated : RTEMS.Unsigned32; + end record; + + procedure Get_Class_Information( + The_API : in RTEMS.Unsigned32; + The_Class : in RTEMS.Unsigned32; + Info : out API_Class_Information; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Object; diff --git a/c/src/ada/rtems-partition.adb b/c/src/ada/rtems-partition.adb new file mode 100644 index 0000000000..bcbfc7ae3c --- /dev/null +++ b/c/src/ada/rtems-partition.adb @@ -0,0 +1,136 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Partition is + + -- + -- Partition Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Buffer_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Starting_Address : RTEMS.Address; + Length : RTEMS.Unsigned32; + Buffer_Size : RTEMS.Unsigned32; + Attribute_Set : RTEMS.Attribute; + ID : access RTEMS.Event_Set) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_partition_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := + Create_Base + (Name, + Starting_Address, + Length, + Buffer_Size, + Attribute_Set, + ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + Node : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + Node : RTEMS.Unsigned32; + ID : access RTEMS.Event_Set) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_partition_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, Node, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_partition_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Get_Buffer + (ID : in RTEMS.ID; + Buffer : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Get_Buffer_Base + (ID : RTEMS.ID; + Buffer : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Buffer_Base, + "rtems_partition_get_buffer"); + Buffer_Base : aliased RTEMS.Address; + begin + + Result := Get_Buffer_Base (ID, Buffer_Base'Access); + Buffer := Buffer_Base; + + end Get_Buffer; + + procedure Return_Buffer + (ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Return_Buffer_Base + (ID : RTEMS.Name; + Buffer : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + Return_Buffer_Base, + "rtems_partition_return_buffer"); + begin + + Result := Return_Buffer_Base (ID, Buffer); + + end Return_Buffer; + +end RTEMS.Partition; diff --git a/c/src/ada/rtems-partition.ads b/c/src/ada/rtems-partition.ads new file mode 100644 index 0000000000..0d6723ea89 --- /dev/null +++ b/c/src/ada/rtems-partition.ads @@ -0,0 +1,65 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Partition is + + -- + -- Partition Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Buffer_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + Node : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Buffer ( + ID : in RTEMS.ID; + Buffer : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Return_Buffer ( + ID : in RTEMS.ID; + Buffer : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Partition; + diff --git a/c/src/ada/rtems-port.adb b/c/src/ada/rtems-port.adb new file mode 100644 index 0000000000..cd36b91be8 --- /dev/null +++ b/c/src/ada/rtems-port.adb @@ -0,0 +1,137 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Port is + + -- + -- Dual Ported Memory Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Internal_Start : in RTEMS.Address; + External_Start : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Internal_Start : RTEMS.Address; + External_Start : RTEMS.Address; + Length : RTEMS.Unsigned32; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_port_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := + Create_Base + (Name, + Internal_Start, + External_Start, + Length, + ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_port_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_port_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure External_To_Internal + (ID : in RTEMS.ID; + External : in RTEMS.Address; + Internal : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function External_To_Internal_Base + (ID : RTEMS.ID; + External : RTEMS.Address; + Internal : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + External_To_Internal_Base, + "rtems_port_external_to_internal"); + Internal_Base : aliased RTEMS.Address; + begin + + Result := + External_To_Internal_Base (ID, External, Internal_Base'Access); + Internal := Internal_Base; + + end External_To_Internal; + + procedure Internal_To_External + (ID : in RTEMS.ID; + Internal : in RTEMS.Address; + External : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Internal_To_External_Base + (ID : RTEMS.ID; + Internal : RTEMS.Address; + External : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + Internal_To_External_Base, + "rtems_port_internal_to_external"); + External_Base : aliased RTEMS.Address; + begin + + Result := + Internal_To_External_Base (ID, Internal, External_Base'Access); + External := External_Base; + + end Internal_To_External; + +end RTEMS.Port; diff --git a/c/src/ada/rtems-port.ads b/c/src/ada/rtems-port.ads new file mode 100644 index 0000000000..f6b8fa692a --- /dev/null +++ b/c/src/ada/rtems-port.ads @@ -0,0 +1,65 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Port is + + -- + -- Dual Ported Memory Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Internal_Start : in RTEMS.Address; + External_Start : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure External_To_Internal ( + ID : in RTEMS.ID; + External : in RTEMS.Address; + Internal : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Internal_To_External ( + ID : in RTEMS.ID; + Internal : in RTEMS.Address; + External : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Port; + diff --git a/c/src/ada/rtems-rate_monotonic.adb b/c/src/ada/rtems-rate_monotonic.adb new file mode 100644 index 0000000000..46c4b43007 --- /dev/null +++ b/c/src/ada/rtems-rate_monotonic.adb @@ -0,0 +1,165 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Rate_Monotonic is + + -- + -- Rate Monotonic Manager + -- + + procedure Create + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import + (C, + Create_Base, + "rtems_rate_monotonic_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Create_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import + (C, + Ident_Base, + "rtems_rate_monotonic_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import + (C, + Delete_Base, + "rtems_rate_monotonic_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Cancel + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Cancel_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import + (C, + Cancel_Base, + "rtems_rate_monotonic_cancel"); + begin + + Result := Cancel_Base (ID); + + end Cancel; + + procedure Period + (ID : in RTEMS.ID; + Length : in RTEMS.Interval; + Result : out RTEMS.Status_Codes) + is + function Period_Base + (ID : RTEMS.ID; + Length : RTEMS.Interval) + return RTEMS.Status_Codes; + pragma Import + (C, + Period_Base, + "rtems_rate_monotonic_period"); + begin + + Result := Period_Base (ID, Length); + + end Period; + + procedure Get_Status + (ID : in RTEMS.ID; + Status : out RTEMS.Rate_Monotonic.Period_Status; + Result : out RTEMS.Status_Codes) + is + function Get_Status_Base + (ID : RTEMS.ID; + Status : access RTEMS.Rate_Monotonic.Period_Status) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Status_Base, + "rtems_rate_monotonic_get_status"); + + Status_Base : aliased RTEMS.Rate_Monotonic.Period_Status; + begin + + Result := Get_Status_Base (ID, Status_Base'Access); + + Status := Status_Base; + + end Get_Status; + + procedure Reset_Statistics + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Reset_Statistics_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import + (C, + Reset_Statistics_Base, + "rtems_rate_monotonic_reset_statistics"); + begin + + Result := Reset_Statistics_Base (ID); + + end Reset_Statistics; + +end RTEMS.Rate_Monotonic; diff --git a/c/src/ada/rtems-rate_monotonic.ads b/c/src/ada/rtems-rate_monotonic.ads new file mode 100644 index 0000000000..a7825003f1 --- /dev/null +++ b/c/src/ada/rtems-rate_monotonic.ads @@ -0,0 +1,116 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Rate_Monotonic is + + -- + -- The following type defines the status information returned + -- about a period. + -- + + type Period_States is ( + Inactive, -- off chain, never initialized + Owner_Is_Blocking, -- on chain, owner is blocking on it + Active, -- on chain, running continuously + Expired_While_Blocking, -- on chain, expired while owner was was blocking + Expired -- off chain, will be reset by next + -- rtems_rate_monotonic_period + ); + + for Period_States'Size use 32; + + for Period_States use ( + Inactive => 0, + Owner_Is_Blocking => 1, + Active => 2, + Expired_While_Blocking => 3, + Expired => 4 + ); + + type Period_Status is + record + Owner : RTEMS.ID; + State : RTEMS.Rate_Monotonic.Period_States; + Ticks_Since_Last_Period : RTEMS.Unsigned32; + Ticks_Executed_Since_Last_Period : RTEMS.Unsigned32; + end record; + + -- + -- Rate Monotonic Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Cancel ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Period ( + ID : in RTEMS.ID; + Length : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Status ( + ID : in RTEMS.ID; + Status : out RTEMS.Rate_Monotonic.Period_Status; + Result : out RTEMS.Status_Codes + ); + + procedure Reset_Statistics ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Reset_All_Statistics; + pragma Import ( + C, + Reset_All_Statistics, + "rtems_rate_monotonic_reset_all_statistics" + ); + + procedure Report_Statistics; + pragma Import ( + C, + Report_Statistics, + "rtems_rate_monotonic_report_statistics" + ); + +end RTEMS.Rate_Monotonic; + diff --git a/c/src/ada/rtems-region.adb b/c/src/ada/rtems-region.adb new file mode 100644 index 0000000000..55b017d378 --- /dev/null +++ b/c/src/ada/rtems-region.adb @@ -0,0 +1,208 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Region is + + -- + -- Region Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Page_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Starting_Address : RTEMS.Address; + Length : RTEMS.Unsigned32; + Page_Size : RTEMS.Unsigned32; + Attribute_Set : RTEMS.Attribute; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_region_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := + Create_Base + (Name, + Starting_Address, + Length, + Page_Size, + Attribute_Set, + ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_region_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_region_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Extend + (ID : in RTEMS.ID; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes) + is + function Extend_Base + (ID : RTEMS.ID; + Starting_Address : RTEMS.Address; + Length : RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import (C, Extend_Base, "rtems_region_extend"); + begin + + Result := Extend_Base (ID, Starting_Address, Length); + + end Extend; + + procedure Get_Segment + (ID : in RTEMS.ID; + Size : in RTEMS.Unsigned32; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Segment : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Get_Segment_Base + (ID : RTEMS.ID; + Size : RTEMS.Unsigned32; + Option_Set : RTEMS.Option; + Timeout : RTEMS.Interval; + Segment : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Get_Segment_Base, "rtems_region_get_segment"); + Segment_Base : aliased RTEMS.Address; + begin + + Result := + Get_Segment_Base + (ID, + Size, + Option_Set, + Timeout, + Segment_Base'Access); + Segment := Segment_Base; + + end Get_Segment; + + procedure Get_Segment_Size + (ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Size : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes) + is + function Get_Segment_Size_Base + (ID : RTEMS.ID; + Segment : RTEMS.Address; + Size : access RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import + (C, + Get_Segment_Size_Base, + "rtems_region_get_segment_size"); + Size_Base : aliased RTEMS.Unsigned32; + begin + + Result := Get_Segment_Size_Base (ID, Segment, Size_Base'Access); + Size := Size_Base; + + end Get_Segment_Size; + + procedure Return_Segment + (ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Return_Segment_Base + (ID : RTEMS.ID; + Segment : RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + Return_Segment_Base, + "rtems_region_return_segment"); + begin + + Result := Return_Segment_Base (ID, Segment); + + end Return_Segment; + + procedure 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 Resize_Segment_Base + (ID : RTEMS.ID; + Segment : RTEMS.Address; + Size : RTEMS.Unsigned32; + Old_Size : access RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import + (C, + Resize_Segment_Base, + "rtems_region_resize_segment"); + Old_Size_Base : aliased RTEMS.Unsigned32; + begin + + Result := + Resize_Segment_Base (ID, Segment, Size, Old_Size_Base'Access); + Old_Size := Old_Size_Base; + + end Resize_Segment; + +end RTEMS.Region; diff --git a/c/src/ada/rtems-region.ads b/c/src/ada/rtems-region.ads new file mode 100644 index 0000000000..f442c926fe --- /dev/null +++ b/c/src/ada/rtems-region.ads @@ -0,0 +1,89 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Region is + + -- + -- Region Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Page_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Extend ( + ID : in RTEMS.ID; + Starting_Address : in RTEMS.Address; + Length : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Segment ( + ID : in RTEMS.ID; + Size : in RTEMS.Unsigned32; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Segment : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Segment_Size ( + ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Size : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Return_Segment ( + ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Resize_Segment ( + ID : in RTEMS.ID; + Segment : in RTEMS.Address; + Size : in RTEMS.Unsigned32; + Old_Size : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Region; + diff --git a/c/src/ada/rtems-semaphore.adb b/c/src/ada/rtems-semaphore.adb new file mode 100644 index 0000000000..6383a15eee --- /dev/null +++ b/c/src/ada/rtems-semaphore.adb @@ -0,0 +1,139 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Semaphore is + + -- + -- Semaphore Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Count : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + Priority_Ceiling : in RTEMS.Tasks.Priority; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Count : RTEMS.Unsigned32; + Attribute_Set : RTEMS.Attribute; + Priority_Ceiling : RTEMS.Tasks.Priority; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_semaphore_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := + Create_Base + (Name, + Count, + Attribute_Set, + Priority_Ceiling, + ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_semaphore_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Ident + (Name : in RTEMS.Name; + Node : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + Node : RTEMS.Unsigned32; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_semaphore_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, Node, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Obtain + (ID : in RTEMS.ID; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes) + is + function Obtain_Base + (ID : RTEMS.ID; + Option_Set : RTEMS.Option; + Timeout : RTEMS.Interval) + return RTEMS.Status_Codes; + pragma Import (C, Obtain_Base, "rtems_semaphore_obtain"); + begin + + Result := Obtain_Base (ID, Option_Set, Timeout); + + end Obtain; + + procedure Release + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Release_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Release_Base, "rtems_semaphore_release"); + begin + + Result := Release_Base (ID); + + end Release; + + procedure Flush + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Flush_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Flush_Base, "rtems_semaphore_flush"); + begin + + Result := Flush_Base (ID); + + end Flush; + +end RTEMS.Semaphore; diff --git a/c/src/ada/rtems-semaphore.ads b/c/src/ada/rtems-semaphore.ads new file mode 100644 index 0000000000..de32895cca --- /dev/null +++ b/c/src/ada/rtems-semaphore.ads @@ -0,0 +1,71 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with RTEMS.Tasks; + +package RTEMS.Semaphore is + + -- + -- Semaphore Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Count : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + Priority_Ceiling : in RTEMS.Tasks.Priority; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + Node : in RTEMS.Unsigned32; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Obtain ( + ID : in RTEMS.ID; + Option_Set : in RTEMS.Option; + Timeout : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + + procedure Release ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Flush ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Semaphore; + diff --git a/c/src/ada/rtems-signal.adb b/c/src/ada/rtems-signal.adb new file mode 100644 index 0000000000..abd0bc2039 --- /dev/null +++ b/c/src/ada/rtems-signal.adb @@ -0,0 +1,61 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Signal is + + -- + -- Signal Manager + -- + + procedure Catch + (ASR_Handler : in RTEMS.ASR_Handler; + Mode_Set : in RTEMS.Mode; + Result : out RTEMS.Status_Codes) + is + function Catch_Base + (ASR_Handler : RTEMS.ASR_Handler; + Mode_Set : RTEMS.Mode) + return RTEMS.Status_Codes; + pragma Import (C, Catch_Base, "rtems_signal_catch"); + begin + + Result := Catch_Base (ASR_Handler, Mode_Set); + + end Catch; + + procedure Send + (ID : in RTEMS.ID; + Signal_Set : in RTEMS.Signal_Set; + Result : out RTEMS.Status_Codes) + is + function Send_Base + (ID : RTEMS.ID; + Signal_Set : RTEMS.Signal_Set) + return RTEMS.Status_Codes; + pragma Import (C, Send_Base, "rtems_signal_send"); + begin + + Result := Send_Base (ID, Signal_Set); + + end Send; + +end RTEMS.Signal; diff --git a/c/src/ada/rtems-signal.ads b/c/src/ada/rtems-signal.ads new file mode 100644 index 0000000000..ce866d1cc8 --- /dev/null +++ b/c/src/ada/rtems-signal.ads @@ -0,0 +1,43 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Signal is + + -- + -- Signal Manager + -- + + procedure Catch ( + ASR_Handler : in RTEMS.ASR_Handler; + Mode_Set : in RTEMS.Mode; + Result : out RTEMS.Status_Codes + ); + + procedure Send ( + ID : in RTEMS.ID; + Signal_Set : in RTEMS.Signal_Set; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Signal; + diff --git a/c/src/ada/rtems-stack_checker.ads b/c/src/ada/rtems-stack_checker.ads new file mode 100644 index 0000000000..f5b595424e --- /dev/null +++ b/c/src/ada/rtems-stack_checker.ads @@ -0,0 +1,43 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2011. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with System; +with System.Storage_Elements; use System.Storage_Elements; +with Interfaces; +with Interfaces.C; + +package RTEMS.Stack_Checker is + + -- + -- Stack Bounds Checker + -- + + function Is_Blown return RTEMS.Boolean; + pragma Interface (C, Is_Blown); + pragma Interface_Name (Is_Blown, "rtems_stack_checker_is_blown"); + + procedure Report_Usage; + pragma Import (C, Report_Usage, "rtems_stack_checker_report_usage"); + +end RTEMS.Stack_Checker; + diff --git a/c/src/ada/rtems-tasks.adb b/c/src/ada/rtems-tasks.adb new file mode 100644 index 0000000000..9c85920d16 --- /dev/null +++ b/c/src/ada/rtems-tasks.adb @@ -0,0 +1,339 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2008. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Tasks is + + -- + -- Task Manager + -- + + procedure Create + (Name : in RTEMS.Name; + Initial_Priority : in Priority; + Stack_Size : in RTEMS.Unsigned32; + Initial_Modes : in RTEMS.Mode; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + Initial_Priority : Priority; + Stack_Size : RTEMS.Unsigned32; + Initial_Modes : RTEMS.Mode; + Attribute_Set : RTEMS.Attribute; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_task_create"); + ID_Base : aliased RTEMS.ID; + begin + Result := + Create_Base + (Name, + Initial_Priority, + Stack_Size, + Initial_Modes, + Attribute_Set, + ID_Base'Access); + ID := ID_Base; + end Create; + + procedure Ident + (Name : in RTEMS.Name; + Node : in RTEMS.Node; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + + function Ident_Base + (Name : RTEMS.Name; + Node : RTEMS.Node; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_task_ident"); + ID_Base : aliased RTEMS.ID; + + begin + + Result := Ident_Base (Name, Node, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Start + (ID : in RTEMS.ID; + Entry_Point : in RTEMS.Tasks.Entry_Point; + Argument : in RTEMS.Tasks.Argument; + Result : out RTEMS.Status_Codes) + is + function Start_Base + (ID : RTEMS.ID; + Entry_Point : RTEMS.Tasks.Entry_Point; + Argument : RTEMS.Tasks.Argument) + return RTEMS.Status_Codes; + pragma Import (C, Start_Base, "rtems_task_start"); + begin + + Result := Start_Base (ID, Entry_Point, Argument); + + end Start; + + procedure Restart + (ID : in RTEMS.ID; + Argument : in RTEMS.Tasks.Argument; + Result : out RTEMS.Status_Codes) + is + function Restart_Base + (ID : RTEMS.ID; + Argument : RTEMS.Tasks.Argument) + return RTEMS.Status_Codes; + pragma Import (C, Restart_Base, "rtems_task_restart"); + begin + + Result := Restart_Base (ID, Argument); + + end Restart; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_task_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure Suspend + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Suspend_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Suspend_Base, "rtems_task_suspend"); + begin + + Result := Suspend_Base (ID); + + end Suspend; + + procedure Resume + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Resume_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Resume_Base, "rtems_task_resume"); + begin + + Result := Resume_Base (ID); + + end Resume; + + procedure Is_Suspended + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Is_Suspended_Base + (ID : RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Is_Suspended_Base, "rtems_task_is_suspended"); + begin + + Result := Is_Suspended_Base (ID); + + end Is_Suspended; + + procedure Set_Priority + (ID : in RTEMS.ID; + New_Priority : in Priority; + Old_Priority : out Priority; + Result : out RTEMS.Status_Codes) + is + function Set_Priority_Base + (ID : RTEMS.ID; + New_Priority : Priority; + Old_Priority : access Priority) + return RTEMS.Status_Codes; + pragma Import (C, Set_Priority_Base, "rtems_task_set_priority"); + Old_Priority_Base : aliased Priority; + begin + + Result := + Set_Priority_Base (ID, New_Priority, Old_Priority_Base'Access); + Old_Priority := Old_Priority_Base; + + end Set_Priority; + + procedure Mode + (Mode_Set : in RTEMS.Mode; + Mask : in RTEMS.Mode; + Previous_Mode_Set : out RTEMS.Mode; + Result : out RTEMS.Status_Codes) + is + function Mode_Base + (Mode_Set : RTEMS.Mode; + Mask : RTEMS.Mode; + Previous_Mode_Set : access RTEMS.Mode) + return RTEMS.Status_Codes; + pragma Import (C, Mode_Base, "rtems_task_mode"); + Previous_Mode_Set_Base : aliased RTEMS.Mode; + begin + + Result := + Mode_Base (Mode_Set, Mask, Previous_Mode_Set_Base'Access); + Previous_Mode_Set := Previous_Mode_Set_Base; + + end Mode; + + procedure Get_Note + (ID : in RTEMS.ID; + Notepad : in RTEMS.Notepad_Index; + Note : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes) + is + function Get_Note_Base + (ID : RTEMS.ID; + Notepad : RTEMS.Notepad_Index; + Note : access RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import (C, Get_Note_Base, "rtems_task_get_note"); + Note_Base : aliased RTEMS.Unsigned32; + begin + + Result := Get_Note_Base (ID, Notepad, Note_Base'Access); + Note := Note_Base; + + end Get_Note; + + procedure Set_Note + (ID : in RTEMS.ID; + Notepad : in RTEMS.Notepad_Index; + Note : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes) + is + function Set_Note_Base + (ID : RTEMS.ID; + Notepad : RTEMS.Notepad_Index; + Note : RTEMS.Unsigned32) + return RTEMS.Status_Codes; + pragma Import (C, Set_Note_Base, "rtems_task_set_note"); + begin + + Result := Set_Note_Base (ID, Notepad, Note); + + end Set_Note; + + procedure Variable_Add + (ID : in RTEMS.ID; + Task_Variable : in RTEMS.Address; + Dtor : in Variable_Dtor; + Result : out RTEMS.Status_Codes) + is + function Variable_Add_Base + (ID : RTEMS.ID; + Task_Variable : RTEMS.Address; + Dtor : Variable_Dtor) + return RTEMS.Status_Codes; + pragma Import (C, Variable_Add_Base, "rtems_task_variable_add"); + begin + + Result := Variable_Add_Base (ID, Task_Variable, Dtor); + + end Variable_Add; + + procedure Variable_Get + (ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Task_Variable_Value : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Variable_Get_Base + (ID : RTEMS.ID; + Task_Variable : access RTEMS.Address; + Task_Variable_Value : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import (C, Variable_Get_Base, "rtems_task_variable_get"); + Task_Variable_Base : aliased RTEMS.Address; + Task_Variable_Value_Base : aliased RTEMS.Address; + begin + + Result := + Variable_Get_Base + (ID, + Task_Variable_Base'Access, + Task_Variable_Value_Base'Access); + Task_Variable := Task_Variable_Base; + Task_Variable_Value := Task_Variable_Value_Base; + + end Variable_Get; + + procedure Variable_Delete + (ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Result : out RTEMS.Status_Codes) + is + function Variable_Delete_Base + (ID : RTEMS.ID; + Task_Variable : access RTEMS.Address) + return RTEMS.Status_Codes; + pragma Import + (C, + Variable_Delete_Base, + "rtems_task_variable_delete"); + Task_Variable_Base : aliased RTEMS.Address; + begin + + Result := Variable_Delete_Base (ID, Task_Variable_Base'Access); + Task_Variable := Task_Variable_Base; + + end Variable_Delete; + + procedure Wake_When + (Time_Buffer : in RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes) + is + function Wake_When_Base + (Time_Buffer : RTEMS.Time_Of_Day) + return RTEMS.Status_Codes; + pragma Import (C, Wake_When_Base, "rtems_task_wake_when"); + begin + + Result := Wake_When_Base (Time_Buffer); + + end Wake_When; + + procedure Wake_After + (Ticks : in RTEMS.Interval; + Result : out RTEMS.Status_Codes) + is + function Wake_After_Base + (Ticks : RTEMS.Interval) + return RTEMS.Status_Codes; + pragma Import (C, Wake_After_Base, "rtems_task_wake_after"); + begin + + Result := Wake_After_Base (Ticks); + + end Wake_After; + +end RTEMS.Tasks; diff --git a/c/src/ada/rtems-tasks.ads b/c/src/ada/rtems-tasks.ads new file mode 100644 index 0000000000..46ada12313 --- /dev/null +++ b/c/src/ada/rtems-tasks.ads @@ -0,0 +1,158 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2008. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package RTEMS.Tasks is + + subtype Priority is RTEMS.Unsigned32; + + Current_Priority : constant Priority := 0; + No_Priority : constant Priority := 0; + + subtype Argument is RTEMS.Unsigned32; + type Argument_PTR is access all Argument; + + type Entry_Point is access procedure ( + Argument : RTEMS.Unsigned32 + ); + pragma Convention (C, Entry_Point); + + + -- + -- Task Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + Initial_Priority : in Priority; + Stack_Size : in Unsigned32; + Initial_Modes : in RTEMS.Mode; + Attribute_Set : in RTEMS.Attribute; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + Node : in RTEMS.Node; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Start ( + ID : in RTEMS.ID; + Entry_Point : in RTEMS.Tasks.Entry_Point; + Argument : in RTEMS.Tasks.Argument; + Result : out RTEMS.Status_Codes + ); + + procedure Restart ( + ID : in RTEMS.ID; + Argument : in RTEMS.Tasks.Argument; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Suspend ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Resume ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Is_Suspended ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Set_Priority ( + ID : in RTEMS.ID; + New_Priority : in Priority; + Old_Priority : out Priority; + Result : out RTEMS.Status_Codes + ); + + procedure Mode ( + Mode_Set : in RTEMS.Mode; + Mask : in RTEMS.Mode; + Previous_Mode_Set : out RTEMS.Mode; + Result : out RTEMS.Status_Codes + ); + + procedure Get_Note ( + ID : in RTEMS.ID; + Notepad : in RTEMS.Notepad_Index; + Note : out RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + procedure Set_Note ( + ID : in RTEMS.ID; + Notepad : in RTEMS.Notepad_Index; + Note : in RTEMS.Unsigned32; + Result : out RTEMS.Status_Codes + ); + + type Variable_Dtor is access procedure ( + Argument : in RTEMS.Address + ); + pragma Convention (C, Variable_Dtor); + + procedure Variable_Add ( + ID : in RTEMS.ID; + Task_Variable : in RTEMS.Address; + Dtor : in Variable_Dtor; + Result : out RTEMS.Status_Codes + ); + + procedure Variable_Get ( + ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Task_Variable_Value : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Variable_Delete ( + ID : in RTEMS.ID; + Task_Variable : out RTEMS.Address; + Result : out RTEMS.Status_Codes + ); + + procedure Wake_When ( + Time_Buffer : in RTEMS.Time_Of_Day; + Result : out RTEMS.Status_Codes + ); + + procedure Wake_After ( + Ticks : in RTEMS.Interval; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Tasks; + diff --git a/c/src/ada/rtems-timer.adb b/c/src/ada/rtems-timer.adb new file mode 100644 index 0000000000..2f5492ef88 --- /dev/null +++ b/c/src/ada/rtems-timer.adb @@ -0,0 +1,210 @@ +-- +-- RTEMS / Body +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- +-- DEPENDENCIES: +-- +-- +-- +-- COPYRIGHT (c) 1997-2008. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +package body RTEMS.Timer is + + -- + -- Timer Manager + -- + + procedure Create + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Create_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Create_Base, "rtems_timer_create"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Create_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Create; + + procedure Ident + (Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Ident_Base + (Name : RTEMS.Name; + ID : access RTEMS.ID) + return RTEMS.Status_Codes; + pragma Import (C, Ident_Base, "rtems_timer_ident"); + ID_Base : aliased RTEMS.ID; + begin + + Result := Ident_Base (Name, ID_Base'Access); + ID := ID_Base; + + end Ident; + + procedure Delete + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Delete_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Delete_Base, "rtems_timer_delete"); + begin + + Result := Delete_Base (ID); + + end Delete; + + procedure 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 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, Fire_After_Base, "rtems_timer_fire_after"); + begin + + Result := Fire_After_Base (ID, Ticks, Routine, User_Data); + + end Fire_After; + + procedure 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 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, + Server_Fire_After_Base, + "rtems_timer_server_fire_after"); + begin + + Result := Server_Fire_After_Base (ID, Ticks, Routine, User_Data); + + end Server_Fire_After; + + procedure 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 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, Fire_When_Base, "rtems_timer_fire_when"); + begin + + Result := Fire_When_Base (ID, Wall_Time, Routine, User_Data); + + end Fire_When; + + procedure 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 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, + Server_Fire_When_Base, + "rtems_timer_server_fire_when"); + begin + + Result := + Server_Fire_When_Base (ID, Wall_Time, Routine, User_Data); + end Server_Fire_When; + + procedure Reset + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Reset_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Reset_Base, "rtems_timer_reset"); + begin + + Result := Reset_Base (ID); + + end Reset; + + procedure Cancel + (ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes) + is + function Cancel_Base (ID : RTEMS.ID) return RTEMS.Status_Codes; + pragma Import (C, Cancel_Base, "rtems_timer_cancel"); + begin + + Result := Cancel_Base (ID); + + end Cancel; + + procedure Initiate_Server + (Server_Priority : in RTEMS.Tasks.Priority; + Stack_Size : in RTEMS.Unsigned32; + Attribute_Set : in RTEMS.Attribute; + Result : out RTEMS.Status_Codes) + is + function Initiate_Server_Base + (Server_Priority : RTEMS.Tasks.Priority; + Stack_Size : RTEMS.Unsigned32; + Attribute_Set : RTEMS.Attribute) + return RTEMS.Status_Codes; + pragma Import + (C, + Initiate_Server_Base, + "rtems_timer_initiate_server"); + begin + Result := + Initiate_Server_Base + (Server_Priority, + Stack_Size, + Attribute_Set); + end Initiate_Server; + +end RTEMS.Timer; diff --git a/c/src/ada/rtems-timer.ads b/c/src/ada/rtems-timer.ads new file mode 100644 index 0000000000..a0cc6dff52 --- /dev/null +++ b/c/src/ada/rtems-timer.ads @@ -0,0 +1,108 @@ +-- +-- RTEMS / Specification +-- +-- DESCRIPTION: +-- +-- This package provides the interface to the RTEMS API. +-- +-- DEPENDENCIES: +-- +-- NOTES: +-- RTEMS initialization and configuration are called from +-- the BSP side, therefore should never be called from ADA. +-- +-- COPYRIGHT (c) 1997-2008. +-- 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.rtems.com/license/LICENSE. +-- +-- $Id$ +-- + +with RTEMS.Tasks; + +package RTEMS.Timer is + + -- + -- The following type define a pointer to a watchdog/timer service routine. + -- + + type Service_Routine is access procedure ( + ID : in RTEMS.ID; + User_Data : in RTEMS.Address + ); + pragma Convention (C, Service_Routine); + + -- + -- Timer Manager + -- + + procedure Create ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Ident ( + Name : in RTEMS.Name; + ID : out RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Delete ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure 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 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 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 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 Reset ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Cancel ( + ID : in RTEMS.ID; + Result : out RTEMS.Status_Codes + ); + + procedure Initiate_Server ( + Server_Priority : in RTEMS.Tasks.Priority; + Stack_Size : in Unsigned32; + Attribute_Set : in RTEMS.Attribute; + Result : out RTEMS.Status_Codes + ); + +end RTEMS.Timer; diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb index 22d97549a3..1a2f520799 100644 --- a/c/src/ada/rtems.adb +++ b/c/src/ada/rtems.adb @@ -1,4 +1,4 @@ --- + -- RTEMS / Body -- -- DESCRIPTION: @@ -10,7 +10,7 @@ -- -- -- --- COPYRIGHT (c) 1997-2008. +-- COPYRIGHT (c) 1997-2011. -- On-Line Applications Research Corporation (OAR). -- -- The license and distribution terms for this file may in @@ -22,9 +22,8 @@ with Ada; with Ada.Unchecked_Conversion; -with Interfaces; use Interfaces; -with Interfaces.C; use Interfaces.C; -with Interfaces.C.Strings; use Interfaces.C.Strings; +with Interfaces; use Interfaces; +with Interfaces.C; use Interfaces.C; package body RTEMS is @@ -32,9 +31,10 @@ package body RTEMS is -- Utility Functions -- - function From_Ada_Boolean ( - Ada_Boolean : Standard.Boolean - ) return RTEMS.Boolean is + function From_Ada_Boolean + (Ada_Boolean : Standard.Boolean) + return RTEMS.Boolean + is begin if Ada_Boolean then @@ -45,9 +45,10 @@ package body RTEMS is end From_Ada_Boolean; - function To_Ada_Boolean ( - RTEMS_Boolean : RTEMS.Boolean - ) return Standard.Boolean is + function To_Ada_Boolean + (RTEMS_Boolean : RTEMS.Boolean) + return Standard.Boolean + is begin if RTEMS_Boolean = RTEMS.True then @@ -58,19 +59,21 @@ package body RTEMS is end To_Ada_Boolean; - function Milliseconds_To_Microseconds ( - Milliseconds : RTEMS.Unsigned32 - ) return RTEMS.Unsigned32 is + function Milliseconds_To_Microseconds + (Milliseconds : RTEMS.Unsigned32) + return RTEMS.Unsigned32 + is begin return Milliseconds * 1000; end Milliseconds_To_Microseconds; - function Microseconds_To_Ticks ( - Microseconds : RTEMS.Unsigned32 - ) return RTEMS.Interval is - function Microseconds_Per_Tick return RTEMS.Unsigned32; + function Microseconds_To_Ticks + (Microseconds : RTEMS.Unsigned32) + return RTEMS.Interval + is + function Microseconds_Per_Tick return RTEMS.Unsigned32; pragma Import (C, Microseconds_Per_Tick, "_ada_microseconds_per_tick"); begin @@ -78,58 +81,56 @@ package body RTEMS is end Microseconds_To_Ticks; - function Milliseconds_To_Ticks ( - Milliseconds : RTEMS.Unsigned32 - ) return RTEMS.Interval is + function Milliseconds_To_Ticks + (Milliseconds : RTEMS.Unsigned32) + return RTEMS.Interval + is begin - return Microseconds_To_Ticks(Milliseconds_To_Microseconds(Milliseconds)); + return Microseconds_To_Ticks + (Milliseconds_To_Microseconds (Milliseconds)); end Milliseconds_To_Ticks; - procedure Name_To_Characters ( - Name : in RTEMS.Name; - C1 : out Character; - C2 : out Character; - C3 : out Character; - C4 : out Character - ) is + procedure Name_To_Characters + (Name : in RTEMS.Name; + C1 : out Character; + C2 : out Character; + C3 : out Character; + C4 : out Character) + is C1_Value : RTEMS.Unsigned32; C2_Value : RTEMS.Unsigned32; C3_Value : RTEMS.Unsigned32; C4_Value : RTEMS.Unsigned32; begin - C1_Value := Interfaces.Shift_Right( Name, 24 ); - C2_Value := Interfaces.Shift_Right( Name, 16 ); - C3_Value := Interfaces.Shift_Right( Name, 8 ); - C4_Value := Name; + C1_Value := Interfaces.Shift_Right (Name, 24); + C2_Value := Interfaces.Shift_Right (Name, 16); + C3_Value := Interfaces.Shift_Right (Name, 8); + C4_Value := Name; - C1_Value := C1_Value and 16#00FF#; - C2_Value := C2_Value and 16#00FF#; - C3_Value := C3_Value and 16#00FF#; - C4_Value := C4_Value and 16#00FF#; + C1_Value := C1_Value and 16#00FF#; + C2_Value := C2_Value and 16#00FF#; + C3_Value := C3_Value and 16#00FF#; + C4_Value := C4_Value and 16#00FF#; - C1 := Character'Val( C1_Value ); - C2 := Character'Val( C2_Value ); - C3 := Character'Val( C3_Value ); - C4 := Character'Val( C4_Value ); + C1 := Character'Val (C1_Value); + C2 := Character'Val (C2_Value); + C3 := Character'Val (C3_Value); + C4 := Character'Val (C4_Value); end Name_To_Characters; - function Get_Node ( - ID : in RTEMS.ID - ) return RTEMS.Unsigned32 is + function Get_Node (ID : in RTEMS.ID) return RTEMS.Unsigned32 is begin -- May not be right - return Interfaces.Shift_Right( ID, 16 ); + return Interfaces.Shift_Right (ID, 16); end Get_Node; - function Get_Index ( - ID : in RTEMS.ID - ) return RTEMS.Unsigned32 is + function Get_Index (ID : in RTEMS.ID) return RTEMS.Unsigned32 is begin -- May not be right @@ -137,10 +138,11 @@ package body RTEMS is end Get_Index; - function Are_Statuses_Equal ( - Status : in RTEMS.Status_Codes; - Desired : in RTEMS.Status_Codes - ) return Standard.Boolean is + function Are_Statuses_Equal + (Status : in RTEMS.Status_Codes; + Desired : in RTEMS.Status_Codes) + return Standard.Boolean + is begin if Status = Desired then @@ -151,9 +153,10 @@ package body RTEMS is end Are_Statuses_Equal; - function Is_Status_Successful ( - Status : in RTEMS.Status_Codes - ) return Standard.Boolean is + function Is_Status_Successful + (Status : in RTEMS.Status_Codes) + return Standard.Boolean + is begin if Status = RTEMS.Successful then @@ -164,26 +167,30 @@ package body RTEMS is end Is_Status_Successful; - function Subtract ( - Left : in RTEMS.Address; - Right : in RTEMS.Address - ) return RTEMS.Unsigned32 is - function To_Unsigned32 is - new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32); + function Subtract + (Left : in RTEMS.Address; + Right : in RTEMS.Address) + return RTEMS.Unsigned32 + is + function To_Unsigned32 is new Ada.Unchecked_Conversion ( + System.Address, + RTEMS.Unsigned32); begin - return To_Unsigned32(Left) - To_Unsigned32(Right); + return To_Unsigned32 (Left) - To_Unsigned32 (Right); end Subtract; - function Are_Equal ( - Left : in RTEMS.Address; - Right : in RTEMS.Address - ) return Standard.Boolean is - function To_Unsigned32 is - new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32); + function Are_Equal + (Left : in RTEMS.Address; + Right : in RTEMS.Address) + return Standard.Boolean + is + function To_Unsigned32 is new Ada.Unchecked_Conversion ( + System.Address, + RTEMS.Unsigned32); begin - return (To_Unsigned32(Left) = To_Unsigned32(Right)); + return (To_Unsigned32 (Left) = To_Unsigned32 (Right)); end Are_Equal; -- @@ -191,1980 +198,6 @@ 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 - -- - - procedure Task_Create ( - Name : in RTEMS.Name; - Initial_Priority : in RTEMS.Task_Priority; - Stack_Size : in RTEMS.Unsigned32; - Initial_Modes : in RTEMS.Mode; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Task_Create_Base ( - Name : RTEMS.Name; - Initial_Priority : RTEMS.Task_Priority; - Stack_Size : RTEMS.Unsigned32; - Initial_Modes : RTEMS.Mode; - 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; - begin - Result := Task_Create_Base ( - Name, - Initial_Priority, - Stack_Size, - Initial_Modes, - Attribute_Set, - ID_Base'Access - ); - ID := ID_Base; - end Task_Create; - - procedure Task_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Node; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - - function Task_Ident_Base ( - Name : RTEMS.Name; - Node : RTEMS.Node; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Ident_Base, "rtems_task_ident"); - ID_Base : aliased RTEMS.ID; - - begin - - Result := Task_Ident_Base (Name, Node, ID_Base'Access); - ID := ID_Base; - - end Task_Ident; - - procedure Task_Start ( - ID : in RTEMS.ID; - Entry_Point : in RTEMS.Task_Entry; - 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); - - end Task_Start; - - procedure Task_Restart ( - ID : in RTEMS.ID; - Argument : in RTEMS.Task_Argument; - Result : out RTEMS.Status_Codes - ) is - function Task_Restart_Base ( - ID : RTEMS.ID; - Argument : RTEMS.Task_Argument - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Restart_Base, "rtems_task_restart"); - begin - - Result := Task_Restart_Base (ID, Argument); - - end Task_Restart; - - procedure Task_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Task_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Delete_Base, "rtems_task_delete"); - begin - - Result := Task_Delete_Base (ID); - - end Task_Delete; - - procedure Task_Suspend ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Task_Suspend_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Suspend_Base, "rtems_task_suspend"); - begin - - Result := Task_Suspend_Base (ID); - - end Task_Suspend; - - procedure Task_Resume ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Task_Resume_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Resume_Base, "rtems_task_resume"); - begin - - 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_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; - Old_Priority : out RTEMS.Task_Priority; - Result : out RTEMS.Status_Codes - ) is - function Task_Set_Priority_Base ( - ID : RTEMS.ID; - New_Priority : RTEMS.Task_Priority; - Old_Priority : access RTEMS.Task_Priority - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority"); - Old_Priority_Base : aliased RTEMS.Task_Priority; - begin - - Result := Task_Set_Priority_Base ( - ID, - New_Priority, - Old_Priority_Base'Access - ); - Old_Priority := Old_Priority_Base; - - end Task_Set_Priority; - - procedure Task_Mode ( - Mode_Set : in RTEMS.Mode; - Mask : in RTEMS.Mode; - Previous_Mode_Set : out RTEMS.Mode; - Result : out RTEMS.Status_Codes - ) is - function Task_Mode_Base ( - Mode_Set : RTEMS.Mode; - Mask : RTEMS.Mode; - Previous_Mode_Set : access RTEMS.Mode - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Mode_Base, "rtems_task_mode"); - Previous_Mode_Set_Base : aliased RTEMS.Mode; - begin - - Result := Task_Mode_Base ( - Mode_Set, - Mask, - Previous_Mode_Set_Base'Access - ); - Previous_Mode_Set := Previous_Mode_Set_Base; - - end Task_Mode; - - procedure Task_Get_Note ( - ID : in RTEMS.ID; - Notepad : in RTEMS.Notepad_Index; - Note : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Task_Get_Note_Base ( - ID : RTEMS.ID; - Notepad : RTEMS.Notepad_Index; - Note : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note"); - Note_Base : aliased RTEMS.Unsigned32; - begin - - Result := Task_Get_Note_Base (ID, Notepad, Note_Base'Access); - Note := NOTE_Base; - - end Task_Get_Note; - - procedure Task_Set_Note ( - ID : in RTEMS.ID; - Notepad : in RTEMS.Notepad_Index; - Note : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Task_Set_Note_Base ( - ID : RTEMS.ID; - Notepad : RTEMS.Notepad_Index; - Note : RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note"); - begin - - Result := Task_Set_Note_Base (ID, Notepad, Note); - - end Task_Set_Note; - - procedure Task_Variable_Add ( - ID : in RTEMS.ID; - Task_Variable : in RTEMS.Address; - Dtor : in RTEMS.Task_Variable_Dtor; - Result : out RTEMS.Status_Codes - ) is - function Task_Variable_Add_Base ( - ID : RTEMS.ID; - Task_Variable : RTEMS.Address; - Dtor : RTEMS.Task_Variable_Dtor - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add"); - begin - - Result := Task_Variable_Add_Base (ID, Task_Variable, Dtor); - - end Task_Variable_Add; - - procedure Task_Variable_Get ( - ID : in RTEMS.ID; - Task_Variable : out RTEMS.Address; - Task_Variable_Value : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Task_Variable_Get_Base ( - ID : RTEMS.ID; - Task_Variable : access RTEMS.Address; - Task_Variable_Value : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get"); - Task_Variable_Base : aliased RTEMS.Address; - Task_Variable_Value_Base : aliased RTEMS.Address; - begin - - Result := Task_Variable_Get_Base ( - ID, - Task_Variable_Base'Access, - Task_Variable_Value_Base'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'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 - ) is - function Task_Wake_When_Base ( - Time_Buffer : RTEMS.Time_Of_Day - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when"); - begin - - Result := Task_Wake_When_Base (Time_Buffer); - - end Task_Wake_When; - - procedure Task_Wake_After ( - Ticks : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ) is - function Task_Wake_After_Base ( - Ticks : RTEMS.Interval - ) return RTEMS.Status_Codes; - pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after"); - begin - - Result := Task_Wake_After_Base (Ticks); - - end Task_Wake_After; - - -- - -- Interrupt Manager - -- - - -- 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 - -- - - procedure Clock_Set ( - Time_Buffer : in RTEMS.Time_Of_Day; - Result : out RTEMS.Status_Codes - ) is - function Clock_Set_Base ( - Time_Buffer : access RTEMS.Time_Of_Day - ) return RTEMS.Status_Codes; - pragma Import (C, Clock_Set_Base, "rtems_clock_set"); - - Tmp_Time : aliased RTEMS.Time_Of_Day; - begin - - Tmp_Time := Time_Buffer; - Result := Clock_Set_Base (Tmp_Time'Access); - - 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 ( - Option : RTEMS.Clock_Get_Options; - Time_Buffer : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Clock_Get_Base, "rtems_clock_get"); - begin - - Result := Clock_Get_Base (Option, Time_Buffer); - - 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 ( - Uptime : out RTEMS.Timespec; - Result : out RTEMS.Status_Codes - ) is - function Clock_Get_Uptime_Base ( - Uptime : access RTEMS.Timespec - ) return RTEMS.Status_Codes; - pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime"); - Uptime_Base : aliased RTEMS.Timespec; - begin - - Result := Clock_Get_Uptime_Base (Uptime_Base'Access); - Uptime := Uptime_Base; - - end Clock_Get_Uptime; - - procedure Clock_Tick ( - Result : out RTEMS.Status_Codes - ) is - function Clock_Tick_Base return RTEMS.Status_Codes; - pragma Import (C, Clock_Tick_Base, "rtems_clock_tick"); - begin - - Result := Clock_Tick_Base; - - end Clock_Tick; - - -- - -- Extension Manager - -- - - procedure Extension_Create ( - Name : in RTEMS.Name; - Table : in RTEMS.Extensions_Table_Pointer; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Extension_Create_Base ( - Name : RTEMS.Name; - Table : RTEMS.Extensions_Table_Pointer; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Extension_Create_Base, "rtems_extension_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Extension_Create_Base (Name, Table, ID_Base'Access); - ID := ID_Base; - - end Extension_Create; - - procedure Extension_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Extension_Ident_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Extension_Ident_Base, "rtems_extension_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Extension_Ident_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Extension_Ident; - - procedure Extension_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Extension_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Extension_Delete_Base, "rtems_extension_delete"); - begin - - Result := Extension_Delete_Base (ID); - - end Extension_Delete; - - -- - -- Timer Manager - -- - - procedure Timer_Create ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Timer_Create_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Create_Base, "rtems_timer_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Timer_Create_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Timer_Create; - - procedure Timer_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Timer_Ident_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Ident_Base, "rtems_timer_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Timer_Ident_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Timer_Ident; - - procedure Timer_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Timer_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Delete_Base, "rtems_timer_delete"); - begin - - Result := Timer_Delete_Base (ID); - - end Timer_Delete; - - procedure Timer_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_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_Fire_After_Base, "rtems_timer_fire_after"); - begin - - 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; - Routine : in RTEMS.Timer_Service_Routine; - User_Data : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Timer_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_Fire_When_Base, "rtems_timer_fire_when"); - begin - - 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 - ) is - function Timer_Reset_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Reset_Base, "rtems_timer_reset"); - begin - - Result := Timer_Reset_Base (ID); - - end Timer_Reset; - - procedure Timer_Cancel ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Timer_Cancel_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel"); - begin - - Result := Timer_Cancel_Base (ID); - - 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 - -- - - procedure Semaphore_Create ( - Name : in RTEMS.Name; - Count : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - Priority_Ceiling : in RTEMS.Task_Priority; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Semaphore_Create_Base ( - Name : RTEMS.Name; - Count : RTEMS.Unsigned32; - Attribute_Set : RTEMS.Attribute; - Priority_Ceiling : RTEMS.Task_Priority; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Semaphore_Create_Base ( - Name, - Count, - Attribute_Set, - Priority_Ceiling, - ID_Base'Access - ); - ID := ID_Base; - - end Semaphore_Create; - - procedure Semaphore_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Semaphore_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete"); - begin - - Result := Semaphore_Delete_Base (ID); - - end Semaphore_Delete; - - procedure Semaphore_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Semaphore_Ident_Base ( - Name : RTEMS.Name; - Node : RTEMS.Unsigned32; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Semaphore_Ident_Base (Name, Node, ID_Base'Access); - ID := ID_Base; - - end Semaphore_Ident; - - procedure Semaphore_Obtain ( - ID : in RTEMS.ID; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ) is - function Semaphore_Obtain_Base ( - ID : RTEMS.ID; - Option_Set : RTEMS.Option; - Timeout : RTEMS.Interval - ) return RTEMS.Status_Codes; - pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain"); - begin - - Result := Semaphore_Obtain_Base (ID, Option_Set, Timeout); - - end Semaphore_Obtain; - - procedure Semaphore_Release ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Semaphore_Release_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release"); - begin - - Result := Semaphore_Release_Base (ID); - - 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 - -- - - procedure Message_Queue_Create ( - Name : in RTEMS.Name; - Count : in RTEMS.Unsigned32; - Max_Message_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - -- XXX broken - function Message_Queue_Create_Base ( - Name : RTEMS.Name; - Count : RTEMS.Unsigned32; - Max_Message_Size : RTEMS.Unsigned32; - Attribute_Set : RTEMS.Attribute; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, - Message_Queue_Create_Base, "rtems_message_queue_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Message_Queue_Create_Base ( - Name, - Count, - Max_Message_Size, - Attribute_Set, - ID_Base'Access - ); - ID := ID_Base; - - end Message_Queue_Create; - - procedure Message_Queue_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Ident_Base ( - Name : RTEMS.Name; - Node : RTEMS.Unsigned32; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := - Message_Queue_Ident_Base (Name, Node, ID_Base'Access); - ID := ID_Base; - - end Message_Queue_Ident; - - procedure Message_Queue_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import ( - C, Message_Queue_Delete_Base, "rtems_message_queue_delete"); - begin - - Result := Message_Queue_Delete_Base (ID); - - end Message_Queue_Delete; - - procedure Message_Queue_Send ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Send_Base ( - ID : RTEMS.ID; - Buffer : RTEMS.Address; - Size : RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send"); - begin - - Result := Message_Queue_Send_Base (ID, Buffer, Size); - - end Message_Queue_Send; - - procedure Message_Queue_Urgent ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Urgent_Base ( - ID : RTEMS.ID; - Buffer : RTEMS.Address; - Size : RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Urgent_Base, - "rtems_message_queue_urgent"); - begin - - Result := Message_Queue_Urgent_Base (ID, Buffer, Size); - - end Message_Queue_Urgent; - - procedure Message_Queue_Broadcast ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Count : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Broadcast_Base ( - ID : RTEMS.ID; - Buffer : RTEMS.Address; - Size : RTEMS.Unsigned32; - Count : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Broadcast_Base, - "rtems_message_queue_broadcast"); - Count_Base : aliased RTEMS.Unsigned32; - begin - - Result := Message_Queue_Broadcast_Base ( - ID, - Buffer, - Size, - Count_Base'Access - ); - Count := Count_Base; - - end Message_Queue_Broadcast; - - procedure Message_Queue_Receive ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Size : in out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Receive_Base ( - ID : RTEMS.ID; - Buffer : RTEMS.Address; - Size : access RTEMS.Unsigned32; - Option_Set : RTEMS.Option; - Timeout : RTEMS.Interval - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Receive_Base, - "rtems_message_queue_receive"); - Size_Base : aliased RTEMS.Unsigned32; - begin - - Size_Base := Size; - - Result := Message_Queue_Receive_Base ( - ID, - Buffer, - Size_Base'Access, - Option_Set, - Timeout - ); - Size := Size_Base; - - 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'Access - ); - Count := COUNT_Base; - - end Message_Queue_Get_Number_Pending; - - procedure Message_Queue_Flush ( - ID : in RTEMS.ID; - Count : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Message_Queue_Flush_Base ( - ID : RTEMS.ID; - Count : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush"); - COUNT_Base : aliased RTEMS.Unsigned32; - begin - - Result := Message_Queue_Flush_Base (ID, COUNT_Base'Access); - Count := COUNT_Base; - - end Message_Queue_Flush; - - -- - -- Event Manager - -- - - procedure Event_Send ( - ID : in RTEMS.ID; - Event_In : in RTEMS.Event_Set; - Result : out RTEMS.Status_Codes - ) is - function Event_Send_Base ( - ID : RTEMS.ID; - Event_In : RTEMS.Event_Set - ) return RTEMS.Status_Codes; - pragma Import (C, Event_Send_Base, "rtems_event_send"); - begin - - Result := Event_Send_Base (ID, Event_In); - - end Event_Send; - - procedure Event_Receive ( - Event_In : in RTEMS.Event_Set; - Option_Set : in RTEMS.Option; - Ticks : in RTEMS.Interval; - Event_Out : out RTEMS.Event_Set; - Result : out RTEMS.Status_Codes - ) is - function Event_Receive_Base ( - Event_In : RTEMS.Event_Set; - Option_Set : RTEMS.Option; - Ticks : RTEMS.Interval; - Event_Out : access RTEMS.Event_Set - ) return RTEMS.Status_Codes; - pragma Import (C, Event_Receive_Base, "rtems_event_receive"); - Event_Out_Base : aliased RTEMS.Event_Set; - begin - - Result := Event_Receive_Base ( - Event_In, - Option_Set, - Ticks, - Event_Out_Base'Access - ); - Event_Out := Event_Out_Base; - - end Event_Receive; - - -- - -- Signal Manager - -- - - procedure Signal_Catch ( - ASR_Handler : in RTEMS.ASR_Handler; - Mode_Set : in RTEMS.Mode; - Result : out RTEMS.Status_Codes - ) is - function Signal_Catch_Base ( - ASR_Handler : RTEMS.ASR_Handler; - Mode_Set : RTEMS.Mode - ) return RTEMS.Status_Codes; - pragma Import (C, Signal_Catch_Base, "rtems_signal_catch"); - begin - - Result := Signal_Catch_Base (ASR_Handler, Mode_Set); - - end Signal_Catch; - - procedure Signal_Send ( - ID : in RTEMS.ID; - Signal_Set : in RTEMS.Signal_Set; - Result : out RTEMS.Status_Codes - ) is - function Signal_Send_Base ( - ID : RTEMS.ID; - Signal_Set : RTEMS.Signal_Set - ) return RTEMS.Status_Codes; - pragma Import (C, Signal_Send_Base, "rtems_signal_send"); - begin - - Result := Signal_Send_Base (ID, Signal_Set); - - end Signal_Send; - - - -- - -- Partition Manager - -- - - procedure Partition_Create ( - Name : in RTEMS.Name; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Buffer_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Partition_Create_Base ( - Name : RTEMS.Name; - Starting_Address : RTEMS.Address; - Length : RTEMS.Unsigned32; - Buffer_Size : RTEMS.Unsigned32; - Attribute_Set : RTEMS.Attribute; - ID : access RTEMS.Event_Set - ) return RTEMS.Status_Codes; - pragma Import (C, Partition_Create_Base, "rtems_partition_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Partition_Create_Base ( - Name, - Starting_Address, - Length, - Buffer_Size, - Attribute_Set, - ID_Base'Access - ); - ID := ID_Base; - - end Partition_Create; - - procedure Partition_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Partition_Ident_Base ( - Name : RTEMS.Name; - Node : RTEMS.Unsigned32; - ID : access RTEMS.Event_Set - ) return RTEMS.Status_Codes; - pragma Import (C, Partition_Ident_Base, "rtems_partition_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Partition_Ident_Base (Name, Node, ID_Base'Access); - ID := ID_Base; - - end Partition_Ident; - - procedure Partition_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Partition_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Partition_Delete_Base, "rtems_partition_delete"); - begin - - Result := Partition_Delete_Base (ID); - - end Partition_Delete; - - procedure Partition_Get_Buffer ( - ID : in RTEMS.ID; - Buffer : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Partition_Get_Buffer_Base ( - ID : RTEMS.ID; - Buffer : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Partition_Get_Buffer_Base, - "rtems_partition_get_buffer"); - Buffer_Base : aliased RTEMS.Address; - begin - - Result := Partition_Get_Buffer_Base (ID, Buffer_Base'Access); - Buffer := Buffer_Base; - - end Partition_Get_Buffer; - - procedure Partition_Return_Buffer ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Partition_Return_Buffer_Base ( - ID : RTEMS.Name; - Buffer : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Partition_Return_Buffer_Base, - "rtems_partition_return_buffer"); - begin - - Result := Partition_Return_Buffer_Base (ID, Buffer); - - end Partition_Return_Buffer; - - -- - -- Region Manager - -- - - procedure Region_Create ( - Name : in RTEMS.Name; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Page_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Region_Create_Base ( - Name : RTEMS.Name; - Starting_Address : RTEMS.Address; - Length : RTEMS.Unsigned32; - Page_Size : RTEMS.Unsigned32; - Attribute_Set : RTEMS.Attribute; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Create_Base, "rtems_region_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Region_Create_Base ( - Name, - Starting_Address, - Length, - Page_Size, - Attribute_Set, - ID_Base'Access - ); - ID := ID_Base; - - end Region_Create; - - procedure Region_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Region_Ident_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Ident_Base, "rtems_region_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Region_Ident_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Region_Ident; - - procedure Region_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Region_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Delete_Base, "rtems_region_delete"); - begin - - Result := Region_Delete_Base (ID); - - end Region_Delete; - - procedure Region_Extend ( - ID : in RTEMS.ID; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Region_Extend_Base ( - ID : RTEMS.ID; - Starting_Address : RTEMS.Address; - Length : RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Extend_Base, "rtems_region_extend"); - begin - - Result := Region_Extend_Base (ID, Starting_Address, Length); - - end Region_Extend; - - procedure Region_Get_Segment ( - ID : in RTEMS.ID; - Size : in RTEMS.Unsigned32; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Segment : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Region_Get_Segment_Base ( - ID : RTEMS.ID; - Size : RTEMS.Unsigned32; - Option_Set : RTEMS.Option; - Timeout : RTEMS.Interval; - Segment : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment"); - Segment_Base : aliased RTEMS.Address; - begin - - Result := Region_Get_Segment_Base ( - ID, - Size, - Option_Set, - Timeout, - Segment_Base'Access - ); - Segment := SEGMENT_Base; - - end Region_Get_Segment; - - procedure Region_Get_Segment_Size ( - ID : in RTEMS.ID; - Segment : in RTEMS.Address; - Size : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Region_Get_Segment_Size_Base ( - ID : RTEMS.ID; - Segment : RTEMS.Address; - Size : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Get_Segment_Size_Base, - "rtems_region_get_segment_size"); - Size_Base : aliased RTEMS.Unsigned32; - begin - - Result := Region_Get_Segment_Size_Base ( - ID, - Segment, - Size_Base'Access - ); - Size := SIZE_Base; - - end Region_Get_Segment_Size; - - procedure Region_Return_Segment ( - ID : in RTEMS.ID; - Segment : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Region_Return_Segment_Base ( - ID : RTEMS.ID; - Segment : RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Region_Return_Segment_Base, - "rtems_region_return_segment"); - begin - - Result := Region_Return_Segment_Base (ID, Segment); - - 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'Access - ); - Old_Size := Old_Size_Base; - - end Region_Resize_Segment; - - -- - -- Dual Ported Memory Manager - -- - - procedure Port_Create ( - Name : in RTEMS.Name; - Internal_Start : in RTEMS.Address; - External_Start : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Port_Create_Base ( - Name : RTEMS.Name; - Internal_Start : RTEMS.Address; - External_Start : RTEMS.Address; - Length : RTEMS.Unsigned32; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Port_Create_Base, "rtems_port_create"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Port_Create_Base ( - Name, - Internal_Start, - External_Start, - Length, - ID_Base'Access - ); - ID := ID_Base; - - end Port_Create; - - procedure Port_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Port_Ident_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Port_Ident_Base, "rtems_port_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Port_Ident_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Port_Ident; - - procedure Port_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Port_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Port_Delete_Base, "rtems_port_delete"); - begin - - Result := Port_Delete_Base (ID); - - end Port_Delete; - - procedure Port_External_To_Internal ( - ID : in RTEMS.ID; - External : in RTEMS.Address; - Internal : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Port_External_To_Internal_Base ( - ID : RTEMS.ID; - External : RTEMS.Address; - Internal : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Port_External_To_Internal_Base, - "rtems_port_external_to_internal"); - Internal_Base : aliased RTEMS.Address; - begin - - Result := Port_External_To_Internal_Base ( - ID, - External, - Internal_Base'Access - ); - Internal := INTERNAL_Base; - - end Port_External_To_Internal; - - procedure Port_Internal_To_External ( - ID : in RTEMS.ID; - Internal : in RTEMS.Address; - External : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ) is - function Port_Internal_To_External_Base ( - ID : RTEMS.ID; - Internal : RTEMS.Address; - External : access RTEMS.Address - ) return RTEMS.Status_Codes; - pragma Import (C, Port_Internal_To_External_Base, - "rtems_port_internal_to_external"); - External_Base : aliased RTEMS.Address; - begin - - Result := Port_Internal_To_External_Base ( - ID, - Internal, - External_Base'Access - ); - External := EXTERNAL_Base; - - 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 : out RTEMS.Driver_Name_t; - 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 := 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; - pragma Inline (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; - pragma Inline (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; - pragma Inline (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; - pragma Inline (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; - pragma Inline (IO_Control); - - - -- - -- Fatal Error Manager - -- - - procedure Fatal_Error_Occurred ( - The_Error : in RTEMS.Unsigned32 - ) is - procedure Fatal_Error_Occurred_Base ( - The_Error : RTEMS.Unsigned32 - ); - pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred"); - begin - - Fatal_Error_Occurred_Base (The_Error); - - end Fatal_Error_Occurred; - - - -- - -- Rate Monotonic Manager - -- - - procedure Rate_Monotonic_Create ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - 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"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Rate_Monotonic_Create_Base (Name, ID_Base'Access); - ID := ID_Base; - - end Rate_Monotonic_Create; - - procedure Rate_Monotonic_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Rate_Monotonic_Ident_Base ( - Name : RTEMS.Name; - ID : access RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident"); - ID_Base : aliased RTEMS.ID; - begin - - Result := Rate_Monotonic_Ident_Base (Name, ID_Base'Access); - - ID := ID_Base; - - end Rate_Monotonic_Ident; - - procedure Rate_Monotonic_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Rate_Monotonic_Delete_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Rate_Monotonic_Delete_Base, - "rtems_rate_monotonic_delete"); - begin - - Result := Rate_Monotonic_Delete_Base (ID); - - end Rate_Monotonic_Delete; - - procedure Rate_Monotonic_Cancel ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ) is - function Rate_Monotonic_Cancel_Base ( - ID : RTEMS.ID - ) return RTEMS.Status_Codes; - pragma Import (C, Rate_Monotonic_Cancel_Base, - "rtems_rate_monotonic_cancel"); - begin - - Result := Rate_Monotonic_Cancel_Base (ID); - - end Rate_Monotonic_Cancel; - - procedure Rate_Monotonic_Period ( - ID : in RTEMS.ID; - Length : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ) is - function Rate_Monotonic_Period_Base ( - ID : RTEMS.ID; - Length : RTEMS.Interval - ) return RTEMS.Status_Codes; - pragma Import (C, Rate_Monotonic_Period_Base, - "rtems_rate_monotonic_period"); - begin - - 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; - Result : out RTEMS.Status_Codes - ) is - function Rate_Monotonic_Get_Status_Base ( - ID : RTEMS.ID; - Status : access RTEMS.Rate_Monotonic_Period_Status - ) return RTEMS.Status_Codes; - pragma Import (C, Rate_Monotonic_Get_Status_Base, - "rtems_rate_monotonic_get_status"); - - Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status; - begin - - Result := Rate_Monotonic_Get_Status_Base ( - ID, - Status_Base'Access - ); - - Status := Status_Base; - - - 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'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'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; - Timeout : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ) is - function Barrier_Wait_Base ( - ID : RTEMS.ID; - Timeout : RTEMS.Interval - ) return RTEMS.Status_Codes; - pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait"); - begin - - Result := Barrier_Wait_Base (ID, Timeout); - - end Barrier_Wait; - - procedure Barrier_Release ( - ID : in RTEMS.ID; - Released : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ) is - function Barrier_Release_Base ( - ID : RTEMS.ID; - Released : access RTEMS.Unsigned32 - ) return RTEMS.Status_Codes; - pragma Import (C, Barrier_Release_Base, "rtems_barrier_release"); - Released_Base : aliased RTEMS.Unsigned32; - begin - - Result := Barrier_Release_Base (ID, Released_Base'Access); - Released := Released_Base; - - end Barrier_Release; - - - -- - -- Debug Manager - -- - - procedure Debug_Enable ( - To_Be_Enabled : in RTEMS.Debug_Set - ) is - procedure Debug_Enable_Base ( - To_Be_Enabled : RTEMS.Debug_Set - ); - pragma Import (C, Debug_Enable_Base, "rtems_debug_enable"); - begin - - Debug_Enable_Base (To_Be_Enabled); - - end Debug_Enable; - - procedure Debug_Disable ( - To_Be_Disabled : in RTEMS.Debug_Set - ) is - procedure Debug_Disable_Base ( - To_Be_Disabled : RTEMS.Debug_Set - ); - pragma Import (C, Debug_Disable_Base, "rtems_debug_disable"); - begin - - Debug_Disable_Base (To_Be_Disabled); - - end Debug_Disable; - - function Debug_Is_Enabled ( - Level : in RTEMS.Debug_Set - ) return RTEMS.Boolean is - function Debug_Is_Enabled_Base ( - Level : RTEMS.Debug_Set - ) return RTEMS.Boolean; - pragma Import (C, Debug_Is_Enabled_Base, "rtems_debug_is_enabled"); - begin - - return Debug_Is_Enabled_Base (Level); - - end Debug_Is_Enabled; - - -- - -- Object Services - -- - function Build_Name ( C1 : in Character; C2 : in Character; @@ -2189,232 +222,14 @@ package body RTEMS is end Build_Name; - procedure Object_Get_Classic_Name( - ID : in RTEMS.ID; - Name : out RTEMS.Name; - Result : out RTEMS.Status_Codes - ) is - function Object_Get_Classic_Name_Base ( - ID : RTEMS.ID; - Name : access RTEMS.Name - ) return RTEMS.Status_Codes; - pragma Import - (C, Object_Get_Classic_Name_Base, "rtems_object_get_classic_name"); - Tmp_Name : aliased RTEMS.Name; - begin - Result := Object_Get_Classic_Name_Base (ID, Tmp_Name'Access); - Name := Tmp_Name; - end Object_Get_Classic_Name; - - - procedure Object_Get_Name( - ID : in RTEMS.ID; - Name : out String; - Result : out RTEMS.Address - ) is - function Object_Get_Name_Base ( - ID : RTEMS.ID; - Length : RTEMS.Unsigned32; - Name : RTEMS.Address - ) return RTEMS.Address; - pragma Import (C, Object_Get_Name_Base, "rtems_object_get_name"); - begin - Name := (others => ASCII.Nul); - Result := Object_Get_Name_Base ( - Id, - Name'Length, - Name(Name'First)'Address - ); - end Object_Get_Name; - - procedure Object_Set_Name( - ID : in RTEMS.ID; - Name : in String; - Result : out RTEMS.Status_Codes - ) is - function Object_Set_Name_Base ( - ID : RTEMS.ID; - Name : chars_ptr - ) return RTEMS.Status_Codes; - pragma Import (C, Object_Set_Name_Base, "rtems_object_set_name"); - NameAsCString : constant chars_ptr := New_String(Name); - begin - Result := Object_Set_Name_Base (ID, NameAsCString); - end Object_Set_Name; - - procedure Object_Id_Get_API( - ID : in RTEMS.ID; - API : out RTEMS.Unsigned32 - ) is - function Object_Id_Get_API_Base ( - ID : RTEMS.ID - ) return RTEMS.Unsigned32; - pragma Import (C, Object_Id_Get_API_Base, "rtems_object_id_get_api"); - begin - API := Object_Id_Get_API_Base (ID); - end Object_Id_Get_API; - - procedure Object_Id_Get_Class( - ID : in RTEMS.ID; - The_Class : out RTEMS.Unsigned32 - ) is - function Object_Id_Get_Class_Base ( - ID : RTEMS.ID - ) return RTEMS.Unsigned32; - pragma Import (C, Object_Id_Get_Class_Base, "rtems_object_id_get_class"); - begin - The_Class := Object_Id_Get_Class_Base (ID); - end Object_Id_Get_Class; - - procedure Object_Id_Get_Node( - ID : in RTEMS.ID; - Node : out RTEMS.Unsigned32 - ) is - function Object_Id_Get_Node_Base ( - ID : RTEMS.ID - ) return RTEMS.Unsigned32; - pragma Import (C, Object_Id_Get_Node_Base, "rtems_object_id_get_node"); - begin - Node := Object_Id_Get_Node_Base (ID); - end Object_Id_Get_Node; - - procedure Object_Id_Get_Index( - ID : in RTEMS.ID; - Index : out RTEMS.Unsigned32 - ) is - function Object_Id_Get_Index_Base ( - ID : RTEMS.ID - ) return RTEMS.Unsigned32; - pragma Import (C, Object_Id_Get_Index_Base, "rtems_object_id_get_index"); - begin - Index := Object_Id_Get_Index_Base (ID); - end Object_Id_Get_Index; - - function Build_Id( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - The_Node : in RTEMS.Unsigned32; - The_Index : in RTEMS.Unsigned32 - ) return RTEMS.Id is - function Build_Id_Base ( - The_API : RTEMS.Unsigned32; - The_Class : RTEMS.Unsigned32; - The_Node : RTEMS.Unsigned32; - The_Index : RTEMS.Unsigned32 - ) return RTEMS.Id; - pragma Import (C, Build_Id_Base, "rtems_build_id"); - begin - return Build_Id_Base (The_API, The_Class, The_Node, The_Index); - end Build_Id; - - function Object_Id_API_Minimum - return RTEMS.Unsigned32 is - function Object_Id_API_Minimum_Base return RTEMS.Unsigned32; - pragma Import - (C, Object_Id_API_Minimum_Base, "rtems_object_id_api_minimum"); - begin - return Object_Id_API_Minimum_Base; - end Object_Id_API_Minimum; - - function Object_Id_API_Maximum - return RTEMS.Unsigned32 is - function Object_Id_API_Maximum_Base return RTEMS.Unsigned32; - pragma Import - (C, Object_Id_API_Maximum_Base, "rtems_object_id_api_maximum"); - begin - return Object_Id_API_Maximum_Base; - end Object_Id_API_Maximum; - - procedure Object_API_Minimum_Class( - API : in RTEMS.Unsigned32; - Minimum : out RTEMS.Unsigned32 - ) is - function Object_API_Minimum_Class_Base ( - API : RTEMS.Unsigned32 - ) return RTEMS.Unsigned32; - pragma Import - (C, Object_API_Minimum_Class_Base, "rtems_object_api_minimum_class"); - begin - Minimum := Object_API_Minimum_Class_Base (API); - end Object_API_Minimum_Class; - - procedure Object_API_Maximum_Class( - API : in RTEMS.Unsigned32; - Maximum : out RTEMS.Unsigned32 - ) is - function Object_API_Maximum_Class_Base ( - API : RTEMS.Unsigned32 - ) return RTEMS.Unsigned32; - pragma Import - (C, Object_API_Maximum_Class_Base, "rtems_object_api_maximum_class"); - begin - Maximum := Object_API_Maximum_Class_Base (API); - end Object_API_Maximum_Class; - - -- Translate S from a C-style char* into an Ada String. - -- If S is Null_Ptr, return "", don't raise an exception. - -- Copied from Lovelace Tutorial - function Value_Without_Exception(S : chars_ptr) return String is - begin - if S = Null_Ptr then return ""; - else return Value(S); - end if; - end Value_Without_Exception; - pragma Inline(Value_Without_Exception); - - procedure Object_Get_API_Name( - API : in RTEMS.Unsigned32; - Name : out String - ) is - function Object_Get_API_Name_Base ( - API : RTEMS.Unsigned32 - ) return chars_ptr; - pragma Import (C, Object_Get_API_Name_Base, "rtems_object_get_api_name"); - Result : constant chars_ptr := Object_Get_API_Name_Base (API); - APIName : constant String := Value_Without_Exception (Result); - begin - Name := APIName; - end Object_Get_API_Name; - - procedure Object_Get_API_Class_Name( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - Name : out String - ) is - function Object_Get_API_Class_Name_Base ( - API : RTEMS.Unsigned32; - Class : RTEMS.Unsigned32 - ) return chars_ptr; - pragma Import - (C, Object_Get_API_Class_Name_Base, "rtems_object_get_api_class_name"); - Result : constant - chars_ptr := Object_Get_API_Class_Name_Base (The_API, The_Class); - ClassName : constant String := Value_Without_Exception (Result); - begin - Name := ClassName; - end Object_Get_API_Class_Name; - - procedure Object_Get_Class_Information( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - Info : out RTEMS.Object_API_Class_Information; - Result : out RTEMS.Status_Codes - ) is - function Object_Get_Class_Information_Base ( - The_API : RTEMS.Unsigned32; - The_Class : RTEMS.Unsigned32; - Info : access RTEMS.Object_API_Class_Information - ) return RTEMS.Status_Codes; - pragma Import ( - C, - Object_Get_Class_Information_Base, - "rtems_object_get_class_information" - ); - TmpInfo : aliased RTEMS.Object_API_Class_Information; + -- + -- 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 - Result := Object_Get_Class_Information_Base - (The_API, The_Class, TmpInfo'Access); - Info := TmpInfo; - end Object_Get_Class_Information; + Shutdown_Executive_Base (Status); + end Shutdown_Executive; end RTEMS; diff --git a/c/src/ada/rtems.ads b/c/src/ada/rtems.ads index 0df60fdf46..32dc642100 100644 --- a/c/src/ada/rtems.ads +++ b/c/src/ada/rtems.ads @@ -1,4 +1,4 @@ --- + -- RTEMS / Specification -- -- DESCRIPTION: @@ -11,7 +11,7 @@ -- RTEMS initialization and configuration are called from -- the BSP side, therefore should never be called from ADA. -- --- COPYRIGHT (c) 1997-2008. +-- COPYRIGHT (c) 1997-2011. -- On-Line Applications Research Corporation (OAR). -- -- The license and distribution terms for this file may in @@ -87,12 +87,10 @@ pragma Elaborate_Body (RTEMS); subtype Attribute is RTEMS.Unsigned32; subtype Mode is RTEMS.Unsigned32; subtype Option is RTEMS.Unsigned32; - subtype Task_Priority is RTEMS.Unsigned32; subtype Notepad_Index is RTEMS.Unsigned32 range 0 .. 15; subtype Event_Set is RTEMS.Unsigned32; subtype Signal_Set is RTEMS.Unsigned32; - subtype Debug_Set is RTEMS.Unsigned32; subtype Device_Major_Number is RTEMS.Unsigned32; subtype Device_Minor_Number is RTEMS.Unsigned32; subtype ISR_Level is RTEMS.Unsigned32; @@ -113,19 +111,11 @@ pragma Elaborate_Body (RTEMS); -- Task Related Types -- - subtype Task_Argument is RTEMS.Unsigned32; - type Task_Argument_PTR is access all Task_Argument; - - type Task_Entry is access procedure ( - Argument : RTEMS.Unsigned32 - ); - pragma Convention (C, Task_Entry); - subtype TCB is RTEMS.Unsigned32; type TCB_Pointer is access all RTEMS.TCB; -- - -- Clock and Time of Day Types + -- Time of Day Type -- type Time_Of_Day is @@ -139,20 +129,6 @@ pragma Elaborate_Body (RTEMS); Ticks : RTEMS.Unsigned32; -- elapsed ticks between seconds end record; - type Clock_Time_Value is - record - Seconds : RTEMS.Unsigned32; - Microseconds : RTEMS.Unsigned32; - end record; - - type Clock_Get_Options is ( - Clock_Get_TOD, - Clock_Get_Seconds_Since_Epoch, - Clock_Get_Ticks_Since_Boot, - Clock_Get_Ticks_Per_Second, - Clock_Get_Time_Value - ); - type Time_T is new Interfaces.C.Long; type Timespec is record @@ -161,6 +137,12 @@ pragma Elaborate_Body (RTEMS); end record; pragma Convention (C, Timespec); + type Time_Value is + record + Seconds : RTEMS.Unsigned32; + Microseconds : RTEMS.Unsigned32; + end record; + -- -- Ident Options -- @@ -255,12 +237,11 @@ pragma Elaborate_Body (RTEMS); -- Miscellaneous -- - No_Timeout : constant RTEMS.Interval := 0; - Self : constant RTEMS.ID := 0; - Period_Status : constant RTEMS.Interval := 0; - Yield_Processor : constant RTEMS.Interval := 0; - Current_Priority : constant RTEMS.Task_Priority := 0; - No_Priority : constant RTEMS.Task_Priority := 0; + No_Timeout : constant RTEMS.Interval := 0; + Self : constant RTEMS.ID := 0; + Yield_Processor : constant RTEMS.Interval := 0; + Rate_Monotonic_Period_Status : constant RTEMS.Interval := 0; + -- -- Extension Callouts and Table @@ -332,16 +313,6 @@ pragma Elaborate_Body (RTEMS); type Extensions_Table_Pointer is access all Extensions_Table; -- - -- The following type define a pointer to a watchdog/timer service routine. - -- - - type Timer_Service_Routine is access procedure ( - ID : in RTEMS.ID; - User_Data : in RTEMS.Address - ); - pragma Convention (C, Timer_Service_Routine); - - -- -- The following type define a pointer to a signal service routine. -- @@ -351,38 +322,6 @@ pragma Elaborate_Body (RTEMS); pragma Convention (C, ASR_Handler); -- - -- The following type defines the status information returned - -- about a period. - -- - - type Rate_Monotonic_Period_States is ( - Inactive, -- off chain, never initialized - Owner_Is_Blocking, -- on chain, owner is blocking on it - Active, -- on chain, running continuously - Expired_While_Blocking, -- on chain, expired while owner was was blocking - Expired -- off chain, will be reset by next - -- rtems_rate_monotonic_period - ); - - for Rate_Monotonic_Period_States'Size use 32; - - for Rate_Monotonic_Period_States use ( - Inactive => 0, - Owner_Is_Blocking => 1, - Active => 2, - Expired_While_Blocking => 3, - Expired => 4 - ); - - type Rate_Monotonic_Period_Status is - record - Owner : RTEMS.ID; - State : RTEMS.Rate_Monotonic_Period_States; - Ticks_Since_Last_Period : RTEMS.Unsigned32; - Ticks_Executed_Since_Last_Period : RTEMS.Unsigned32; - end record; - - -- -- Method Completions Status Codes -- @@ -588,793 +527,10 @@ pragma Elaborate_Body (RTEMS); Right : in RTEMS.Address ) return Standard.Boolean; - -- -- RTEMS API -- - -- - -- Initialization Manager -- Shutdown Only - -- - procedure Shutdown_Executive ( - Status : in RTEMS.Unsigned32 - ); - - -- - -- Task Manager - -- - - procedure Task_Create ( - Name : in RTEMS.Name; - Initial_Priority : in RTEMS.Task_Priority; - Stack_Size : in Unsigned32; - Initial_Modes : in RTEMS.Mode; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Node; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Start ( - ID : in RTEMS.ID; - Entry_Point : in RTEMS.Task_Entry; - Argument : in RTEMS.Task_Argument; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Restart ( - ID : in RTEMS.ID; - Argument : in RTEMS.Task_Argument; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Suspend ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Resume ( - ID : in RTEMS.ID; - 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; - Old_Priority : out RTEMS.Task_Priority; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Mode ( - Mode_Set : in RTEMS.Mode; - Mask : in RTEMS.Mode; - Previous_Mode_Set : out RTEMS.Mode; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Get_Note ( - ID : in RTEMS.ID; - Notepad : in RTEMS.Notepad_Index; - Note : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Set_Note ( - ID : in RTEMS.ID; - Notepad : in RTEMS.Notepad_Index; - Note : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - type Task_Variable_Dtor is access procedure ( - Argument : in RTEMS.Address - ); - pragma Convention (C, Task_Variable_Dtor); - - 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_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; - Result : out RTEMS.Status_Codes - ); - - procedure Task_Wake_After ( - Ticks : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ); - - -- - -- Interrupt Manager - -- - - 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; - pragma Interface (C, Interrupt_Is_In_Progress); - pragma Interface_Name - (Interrupt_Is_In_Progress, "rtems_interrupt_is_in_progress"); - - -- - -- 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_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 ( - Uptime : out RTEMS.Timespec; - Result : out RTEMS.Status_Codes - ); - - procedure Clock_Tick ( - Result : out RTEMS.Status_Codes - ); - - -- - -- Extension Manager - -- - - procedure Extension_Create ( - Name : in RTEMS.Name; - Table : in RTEMS.Extensions_Table_Pointer; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Extension_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Extension_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - -- - -- Timer Manager - -- - - procedure Timer_Create ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Timer_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Timer_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Timer_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_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; - Routine : in RTEMS.Timer_Service_Routine; - User_Data : in RTEMS.Address; - 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 - ); - - procedure Timer_Cancel ( - ID : in RTEMS.ID; - 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 - -- - - procedure Semaphore_Create ( - Name : in RTEMS.Name; - Count : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - Priority_Ceiling : in RTEMS.Task_Priority; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Semaphore_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Semaphore_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Semaphore_Obtain ( - ID : in RTEMS.ID; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ); - - procedure Semaphore_Release ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Semaphore_Flush ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - -- - -- Message Queue Manager - -- - - procedure Message_Queue_Create ( - Name : in RTEMS.Name; - Count : in RTEMS.Unsigned32; - Max_Message_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Send ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Urgent ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Broadcast ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Size : in RTEMS.Unsigned32; - Count : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Message_Queue_Receive ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Size : in out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - 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 - -- - - procedure Event_Send ( - ID : in RTEMS.ID; - Event_In : in RTEMS.Event_Set; - Result : out RTEMS.Status_Codes - ); - - procedure Event_Receive ( - Event_In : in RTEMS.Event_Set; - Option_Set : in RTEMS.Option; - Ticks : in RTEMS.Interval; - Event_Out : out RTEMS.Event_Set; - Result : out RTEMS.Status_Codes - ); - - -- - -- Signal Manager - -- - - procedure Signal_Catch ( - ASR_Handler : in RTEMS.ASR_Handler; - Mode_Set : in RTEMS.Mode; - Result : out RTEMS.Status_Codes - ); - - procedure Signal_Send ( - ID : in RTEMS.ID; - Signal_Set : in RTEMS.Signal_Set; - Result : out RTEMS.Status_Codes - ); - - -- - -- Partition Manager - -- - - procedure Partition_Create ( - Name : in RTEMS.Name; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Buffer_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Partition_Ident ( - Name : in RTEMS.Name; - Node : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Partition_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Partition_Get_Buffer ( - ID : in RTEMS.ID; - Buffer : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ); - - procedure Partition_Return_Buffer ( - ID : in RTEMS.ID; - Buffer : in RTEMS.Address; - Result : out RTEMS.Status_Codes - ); - - -- - -- Region Manager - -- - - procedure Region_Create ( - Name : in RTEMS.Name; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Page_Size : in RTEMS.Unsigned32; - Attribute_Set : in RTEMS.Attribute; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Extend ( - ID : in RTEMS.ID; - Starting_Address : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Get_Segment ( - ID : in RTEMS.ID; - Size : in RTEMS.Unsigned32; - Option_Set : in RTEMS.Option; - Timeout : in RTEMS.Interval; - Segment : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Get_Segment_Size ( - ID : in RTEMS.ID; - Segment : in RTEMS.Address; - Size : out RTEMS.Unsigned32; - Result : out RTEMS.Status_Codes - ); - - procedure Region_Return_Segment ( - ID : in RTEMS.ID; - Segment : in RTEMS.Address; - 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 - -- - - procedure Port_Create ( - Name : in RTEMS.Name; - Internal_Start : in RTEMS.Address; - External_Start : in RTEMS.Address; - Length : in RTEMS.Unsigned32; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Port_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Port_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Port_External_To_Internal ( - ID : in RTEMS.ID; - External : in RTEMS.Address; - Internal : out RTEMS.Address; - Result : out RTEMS.Status_Codes - ); - - procedure Port_Internal_To_External ( - ID : in RTEMS.ID; - Internal : in RTEMS.Address; - External : out RTEMS.Address; - 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 : out RTEMS.Driver_Name_t; - 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 - ); - pragma Inline (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 - ); - pragma Inline (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 - ); - pragma Inline (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 - ); - pragma Inline (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 - ); - pragma Inline (IO_Control); - - -- - -- Fatal Error Manager - -- - - procedure Fatal_Error_Occurred ( - The_Error : in RTEMS.Unsigned32 - ); - - -- - -- Rate Monotonic Manager - -- - - procedure Rate_Monotonic_Create ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Rate_Monotonic_Ident ( - Name : in RTEMS.Name; - ID : out RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Rate_Monotonic_Delete ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Rate_Monotonic_Cancel ( - ID : in RTEMS.ID; - Result : out RTEMS.Status_Codes - ); - - procedure Rate_Monotonic_Period ( - ID : in RTEMS.ID; - Length : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ); - - procedure Rate_Monotonic_Get_Status ( - ID : in RTEMS.ID; - Status : out RTEMS.Rate_Monotonic_Period_Status; - 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; - Timeout : in RTEMS.Interval; - Result : out RTEMS.Status_Codes - ); - - procedure Barrier_Release ( - ID : in RTEMS.ID; - Released : out RTEMS.Unsigned32; - 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 - -- - - Debug_All_Mask : constant RTEMS.Debug_Set := 16#ffffffff#; - Debug_Region : constant RTEMS.Debug_Set := 16#00000001#; - - procedure Debug_Enable ( - To_Be_Enabled : in RTEMS.Debug_Set - ); - - procedure Debug_Disable ( - To_Be_Disabled : in RTEMS.Debug_Set - ); - - function Debug_Is_Enabled ( - Level : in RTEMS.Debug_Set - ) return RTEMS.Boolean; - - -- - -- Object Services - -- - function Build_Name ( C1 : in Character; C2 : in Character; @@ -1382,90 +538,12 @@ pragma Elaborate_Body (RTEMS); C4 : in Character ) return RTEMS.Name; - procedure Object_Get_Classic_Name( - ID : in RTEMS.ID; - Name : out RTEMS.Name; - Result : out RTEMS.Status_Codes - ); - - procedure Object_Get_Name( - ID : in RTEMS.ID; - Name : out String; - Result : out RTEMS.Address - ); - - procedure Object_Set_Name( - ID : in RTEMS.ID; - Name : in String; - Result : out RTEMS.Status_Codes - ); - - procedure Object_Id_Get_API( - ID : in RTEMS.ID; - API : out RTEMS.Unsigned32 - ); - - procedure Object_Id_Get_Class( - ID : in RTEMS.ID; - The_Class : out RTEMS.Unsigned32 - ); - - procedure Object_Id_Get_Node( - ID : in RTEMS.ID; - Node : out RTEMS.Unsigned32 - ); - - procedure Object_Id_Get_Index( - ID : in RTEMS.ID; - Index : out RTEMS.Unsigned32 - ); - - function Build_Id( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - The_Node : in RTEMS.Unsigned32; - The_Index : in RTEMS.Unsigned32 - ) return RTEMS.Id; - - function Object_Id_API_Minimum return RTEMS.Unsigned32; - - function Object_Id_API_Maximum return RTEMS.Unsigned32; - - procedure Object_API_Minimum_Class( - API : in RTEMS.Unsigned32; - Minimum : out RTEMS.Unsigned32 - ); - - procedure Object_API_Maximum_Class( - API : in RTEMS.Unsigned32; - Maximum : out RTEMS.Unsigned32 - ); - - procedure Object_Get_API_Name( - API : in RTEMS.Unsigned32; - Name : out String - ); - - procedure Object_Get_API_Class_Name( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - Name : out String - ); - - type Object_API_Class_Information is - record - Minimum_Id : RTEMS.Id; - Maximum_Id : RTEMS.Id; - Maximum : RTEMS.Unsigned32; - AutoExtend : RTEMS.Boolean; - Unallocated : RTEMS.Unsigned32; - end record; - - procedure Object_Get_Class_Information( - The_API : in RTEMS.Unsigned32; - The_Class : in RTEMS.Unsigned32; - Info : out RTEMS.Object_API_Class_Information; - Result : out RTEMS.Status_Codes + -- + -- Initialization Manager -- Shutdown Only + -- + procedure Shutdown_Executive ( + Status : in RTEMS.Unsigned32 ); end RTEMS; + |