2007-10-10 Glenn Humphrey <glenn.humphrey@OARcorp.com>

	* rtems.adb, rtems.ads: Cleaned up binding and removed bindings for
	things that are not reasonable to do in Ada.

3 files changed, 98 insertions, 299 deletions

diff --git a/c/src/ada/ChangeLog b/c/src/ada/ChangeLog
index 61a80b246c..67c10bca75 100644
--- a/c/src/ada/ChangeLog
+++ b/c/src/ada/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-10	Glenn Humphrey <glenn.humphrey@OARcorp.com>
+
+	* rtems.adb, rtems.ads: Cleaned up binding and removed bindings for
+	things that are not reasonable to do in Ada.
+
 2007-10-01	Joel Sherrill <joel.sherrill@OARcorp.com>
 
 	* rtems.adb, rtems.ads: Most of single processor Ada tests now build.
diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb
index b30390ffec..58bc81da49 100644
--- a/c/src/ada/rtems.adb
+++ b/c/src/ada/rtems.adb
@@ -449,6 +449,72 @@ package body RTEMS is
 
    end Task_Set_Note;
  
+   procedure Task_Variable_Add (
+      ID            : in     RTEMS.ID;
+      Task_Variable : in     RTEMS.Address;
+      Dtor          : in     RTEMS.Task_Variable_Dtor;
+      Result        :    out RTEMS.Status_Codes
+   ) is
+      function Task_Variable_Add_Base (
+         ID            : RTEMS.ID;
+         Task_Variable : RTEMS.Address;
+         Dtor          : RTEMS.Task_Variable_Dtor
+      )  return RTEMS.Status_Codes;
+      pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
+   begin
+
+      Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
+
+   end Task_Variable_Add;
+
+   procedure Task_Variable_Get (
+      ID                  : in     RTEMS.ID;
+      Task_Variable       :    out RTEMS.Address;
+      Task_Variable_Value :    out RTEMS.Address;
+      Result              :    out RTEMS.Status_Codes
+   ) is
+      function Task_Variable_Get_Base (
+         ID                  : RTEMS.ID;
+         Task_Variable       : access RTEMS.Address;
+         Task_Variable_Value : access RTEMS.Address
+      )  return RTEMS.Status_Codes;
+      pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
+      Task_Variable_Base       : aliased RTEMS.Address;
+      Task_Variable_Value_Base : aliased RTEMS.Address;
+   begin
+
+      Result := Task_Variable_Get_Base (
+         ID,
+         Task_Variable_Base'Unchecked_Access,
+         Task_Variable_Value_Base'Unchecked_Access
+      );
+      Task_Variable := Task_Variable_Base;
+      Task_Variable_Value := Task_Variable_Value_Base;
+
+   end Task_Variable_Get;
+
+   procedure Task_Variable_Delete (
+      ID                  : in     RTEMS.ID;
+      Task_Variable       :    out RTEMS.Address;
+      Result              :    out RTEMS.Status_Codes
+   ) is
+      function Task_Variable_Delete_Base (
+         ID                  : RTEMS.ID;
+         Task_Variable       : access RTEMS.Address
+      )  return RTEMS.Status_Codes;
+      pragma Import (
+         C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
+      );
+      Task_Variable_Base : aliased RTEMS.Address;
+   begin
+
+      Result := Task_Variable_Delete_Base (
+         ID, Task_Variable_Base'Unchecked_Access
+      );
+      Task_Variable := Task_Variable_Base;
+
+   end Task_Variable_Delete;
+
    procedure Task_Wake_When (
       Time_Buffer : in     RTEMS.Time_Of_Day;
       Result      :    out RTEMS.Status_Codes
@@ -481,30 +547,6 @@ package body RTEMS is
    -- Interrupt Manager
    --
 
-   procedure Interrupt_Catch (
-      New_ISR_Handler : in     RTEMS.Address;
-      Vector          : in     RTEMS.Vector_Number;
-      Old_ISR_Handler :    out RTEMS.Address;
-      Result          :    out RTEMS.Status_Codes
-   ) is
-      function Interrupt_Catch_Base (
-         New_ISR_Handler : RTEMS.Address;
-         Vector          : RTEMS.Vector_Number;
-         Old_ISR_Handler : access RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, Interrupt_Catch_Base, "rtems_interrupt_catch");
-      Old_ISR_Handler_Base : aliased RTEMS.Address;
-   begin
- 
-      Result := Interrupt_Catch_Base (
-         New_ISR_Handler,
-         Vector,
-         OLD_ISR_HANDLER_Base'Unchecked_Access
-      );
-      Old_ISR_Handler := OLD_ISR_HANDLER_Base;
- 
-   end Interrupt_Catch;
-
    -- Interrupt_Disable is interfaced in the specification
    -- Interrupt_Enable is interfaced in the specification
    -- Interrupt_Flash is interfaced in the specification
@@ -1557,139 +1599,6 @@ package body RTEMS is
 
    end Port_Internal_To_External;
  
-   --
-   -- Input/Output Manager
-   --
- 
-   procedure IO_Register_Name (
-      Name   : in     String;
-      Major  : in     RTEMS.Device_Major_Number;
-      Minor  : in     RTEMS.Device_Minor_Number;
-      Result :    out RTEMS.Status_Codes
-   ) is
-      function IO_Register_Name_Base (
-         Name   : Interfaces.C.Char_Array;
-         Major  : RTEMS.Device_Major_Number;
-         Minor  : RTEMS.Device_Minor_Number
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Register_Name_Base, "rtems_io_register_name");
-   begin
-
-      Result :=
-         IO_Register_Name_Base ( Interfaces.C.To_C (Name), Major, Minor );
-
-   end IO_Register_Name;
-
-   procedure IO_Lookup_Name (
-      Name         : in     String;
-      Device_Info  : in     RTEMS.Driver_Name_t_Pointer;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Lookup_Name_Base (
-         Name        : Interfaces.C.Char_Array;
-         Device_Info : access RTEMS.Driver_Name_t
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Lookup_Name_Base, "rtems_io_lookup_name");
-      Device_Info_Base : aliased RTEMS.Driver_Name_t;
-   begin
-
-      Result := IO_Lookup_Name_Base (
-         Interfaces.C.To_C (Name),
-         Device_Info_Base'Unchecked_Access
-      );
-      Device_Info.All := Device_Info_Base;
-
-   end IO_Lookup_Name;
-
-   procedure IO_Open (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Open_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Open_Base, "rtems_io_open");
-   begin
- 
-      Result := IO_Open_Base (Major, Minor, Argument);
- 
-   end IO_Open;
- 
-   procedure IO_Close (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Close_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Close_Base, "rtems_io_close");
-   begin
- 
-      Result := IO_Close_Base (Major, Minor, Argument);
- 
-   end IO_Close;
- 
-   procedure IO_Read (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Read_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Read_Base, "rtems_io_read");
-   begin
- 
-      Result := IO_Read_Base (Major, Minor, Argument);
- 
-   end IO_Read;
- 
-   procedure IO_Write (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Write_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Write_Base, "rtems_io_write");
-   begin
- 
-      Result := IO_Write_Base (Major, Minor, Argument);
- 
-   end IO_Write;
- 
-   procedure IO_Control (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Control_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Control_Base, "rtems_io_control");
-   begin
- 
-      Result := IO_Control_Base (Major, Minor, Argument);
- 
-   end IO_Control;
  
    --
    -- Fatal Error Manager
diff --git a/c/src/ada/rtems.ads b/c/src/ada/rtems.ads
index a13ccee0a9..42411e72f2 100644
--- a/c/src/ada/rtems.ads
+++ b/c/src/ada/rtems.ads
@@ -77,6 +77,7 @@ pragma Elaborate_Body (RTEMS);
    True  : constant RTEMS.Boolean := 1;
    False : constant RTEMS.Boolean := 0;
 
+   --
    --  More Types
    --
 
@@ -94,27 +95,24 @@ pragma Elaborate_Body (RTEMS);
    subtype Debug_Set           is RTEMS.Unsigned32;
    subtype Device_Major_Number is RTEMS.Unsigned32;
    subtype Device_Minor_Number is RTEMS.Unsigned32;
-   subtype Vector_Number       is RTEMS.Unsigned32;
    subtype ISR_Level           is RTEMS.Unsigned32;
 
    subtype Node                is RTEMS.Unsigned32;
 
    --
    --  Task Related Types
-   --  XXXX fix this
+   --
+
    subtype Task_Argument       is RTEMS.Unsigned32;
    type Task_Argument_PTR      is access all Task_Argument;
 
-   -- XXXX fix this
-   subtype TCB                 is RTEMS.Unsigned32;
-   type    TCB_Pointer         is access all RTEMS.TCB;
-
-   subtype Task_States         is RTEMS.Unsigned32;
-
    type Task_Entry is access procedure (
       Argument : RTEMS.Unsigned32
    );
 
+   subtype TCB                 is RTEMS.Unsigned32;
+   type    TCB_Pointer         is access all RTEMS.TCB;
+
    --
    --  Clock and Time of Day Types
    --
@@ -145,42 +143,6 @@ pragma Elaborate_Body (RTEMS);
    );
 
    --
-   --  Device Driver Entry Prototype
-   --
-
-   type Device_Driver_Entry is access function (
-      Major    : in     RTEMS.Device_Major_Number;
-      Minor    : in     RTEMS.Device_Major_Number;
-      Argument : in     RTEMS.Unsigned32;
-      ID       : in     RTEMS.Unsigned32
-   ) return RTEMS.Unsigned32;
-
-   type Driver_Address_Table_Entry is
-      record
-         Initialization : RTEMS.Device_Driver_Entry;
-         Open           : RTEMS.Device_Driver_Entry;
-         Close          : RTEMS.Device_Driver_Entry;
-         Read           : RTEMS.Device_Driver_Entry;
-         Write          : RTEMS.Device_Driver_Entry;
-         Control        : RTEMS.Device_Driver_Entry;
-      end record;
-
-   type Driver_Address_Table is array ( RTEMS.Unsigned32
-     range 1 .. RTEMS.Unsigned32'Last ) of RTEMS.Driver_Address_Table_Entry;
-
-   type Driver_Address_Table_Pointer is access all Driver_Address_Table;
-
-   type Driver_Name_t is
-      record
-         Device_Name        : RTEMS.Address;
-         Device_Name_Length : RTEMS.Unsigned32;
-         Major              : RTEMS.Device_Major_Number;
-         Minor              : RTEMS.Device_Minor_Number;
-      end record;
-
-   type Driver_Name_t_Pointer is access all Driver_Name_t;
-
-   --
    --  Ident Options
    --
 
@@ -249,7 +211,6 @@ pragma Elaborate_Body (RTEMS);
    Minimum_Stack_Size : RTEMS.Unsigned32;
    pragma Import (C, Minimum_Stack_Size, "rtems_minimum_stack_size");
 
-
    --
    --  Notepad index constants
    --
@@ -282,15 +243,14 @@ pragma Elaborate_Body (RTEMS);
    Current_Priority : constant RTEMS.Task_Priority := 0;
    No_Priority      : constant RTEMS.Task_Priority := 0;
 
-
    --
    --  Extension Callouts and Table
    --
 
-   type Thread_Create_Extension is access procedure (
+   type Thread_Create_Extension is access function (
       Current_Task : in     RTEMS.TCB_Pointer;
       New_Task     : in     RTEMS.TCB_Pointer
-   );
+   ) return RTEMS.Boolean;
 
    type Thread_Start_Extension is access procedure (
       Current_Task : in     RTEMS.TCB_Pointer;
@@ -539,15 +499,6 @@ pragma Elaborate_Body (RTEMS);
    Signal_31   : constant RTEMS.Signal_Set := 16#80000000#;
 
    --
-   --  For now, do not provide access to the CPU Table from Ada.
-   --  When this type is provided, a CPU dependent file must
-   --  define it.
-   --
-
-   subtype CPU_Table is RTEMS.Address;
-   type CPU_Table_Pointer is access all CPU_Table;
-
-   --
    --  Utility Functions
    --
 
@@ -612,6 +563,8 @@ pragma Elaborate_Body (RTEMS);
       Left   : in     RTEMS.Address;
       Right  : in     RTEMS.Address
    ) return Standard.Boolean;
+
+
    --
    --  RTEMS API
    --
@@ -704,25 +657,25 @@ pragma Elaborate_Body (RTEMS);
       Argument : in     RTEMS.Address
    );
 
---   procedure Task_Variable_Add (
---      ID            : in     RTEMS.ID;
---      Task_Variable : in     RTEMS.Address;
---      Dtor          : in     RTEMS.Task_Variable_Dtor;
---      Result        :    out RTEMS.Status_Codes
---   );
+   procedure Task_Variable_Add (
+      ID            : in     RTEMS.ID;
+      Task_Variable : in     RTEMS.Address;
+      Dtor          : in     RTEMS.Task_Variable_Dtor;
+      Result        :    out RTEMS.Status_Codes
+   );
 
---   procedure Task_Variable_Get (
---      ID                  : in     RTEMS.ID;
---      Task_Variable       :    out RTEMS.Address;
---      Task_Variable_Value :    out RTEMS.Address;
---      Result              :    out RTEMS.Status_Codes
---   );
+   procedure Task_Variable_Get (
+      ID                  : in     RTEMS.ID;
+      Task_Variable       :    out RTEMS.Address;
+      Task_Variable_Value :    out RTEMS.Address;
+      Result              :    out RTEMS.Status_Codes
+   );
 
---   procedure Task_Variable_Delete (
---      ID                  : in     RTEMS.ID;
---      Task_Variable       :    out RTEMS.Address;
---      Result              :    out RTEMS.Status_Codes
---   );
+   procedure Task_Variable_Delete (
+      ID                  : in     RTEMS.ID;
+      Task_Variable       :    out RTEMS.Address;
+      Result              :    out RTEMS.Status_Codes
+   );
 
    procedure Task_Wake_When (
       Time_Buffer : in     RTEMS.Time_Of_Day;
@@ -738,13 +691,6 @@ pragma Elaborate_Body (RTEMS);
    --  Interrupt Manager
    --
 
-   procedure Interrupt_Catch (
-      New_ISR_Handler : in     RTEMS.Address;
-      Vector          : in     RTEMS.Vector_Number;
-      Old_ISR_Handler :    out RTEMS.Address;
-      Result          :    out RTEMS.Status_Codes
-   );
-
    function Interrupt_Disable return RTEMS.ISR_Level;
    pragma Interface (C, Interrupt_Disable);
    pragma Interface_Name (Interrupt_Disable, "rtems_interrupt_disable");
@@ -807,7 +753,6 @@ pragma Elaborate_Body (RTEMS);
       Result :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Timer Manager
    --
@@ -915,7 +860,6 @@ pragma Elaborate_Body (RTEMS);
       Result :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Message Queue Manager
    --
@@ -978,7 +922,6 @@ pragma Elaborate_Body (RTEMS);
       Result :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Event Manager
    --
@@ -1013,7 +956,6 @@ pragma Elaborate_Body (RTEMS);
       Result     :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Partition Manager
    --
@@ -1052,7 +994,6 @@ pragma Elaborate_Body (RTEMS);
       Result :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Region Manager
    --
@@ -1107,7 +1048,6 @@ pragma Elaborate_Body (RTEMS);
       Result  :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Dual Ported Memory Manager
    --
@@ -1147,59 +1087,6 @@ pragma Elaborate_Body (RTEMS);
    );
 
    --
-   --  Input/Output Manager
-   --
-
-   procedure IO_Register_Name (
-      Name   : in     String;
-      Major  : in     RTEMS.Device_Major_Number;
-      Minor  : in     RTEMS.Device_Minor_Number;
-      Result :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Lookup_Name (
-      Name         : in     String;
-      Device_Info  : In     RTEMS.Driver_Name_t_Pointer;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Open (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Close (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Read (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Write (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-   procedure IO_Control (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   );
-
-
-   --
    --  Fatal Error Manager
    --
 
@@ -1207,7 +1094,6 @@ pragma Elaborate_Body (RTEMS);
       The_Error : in     RTEMS.Unsigned32
    );
 
-
    --
    --  Rate Monotonic Manager
    --
@@ -1246,7 +1132,6 @@ pragma Elaborate_Body (RTEMS);
       Result  :    out RTEMS.Status_Codes
    );
 
-
    --
    --  Debug Manager
    --