2007-04-02 Jennifer Averett <jennifer.averrett@oarcorp.com>

	* rtems.adb, rtems.ads: Update.

1 files changed, 35 insertions, 144 deletions

diff --git a/c/src/ada/rtems.adb b/c/src/ada/rtems.adb
index a1a5b446d4..d2f4240713 100644
--- a/c/src/ada/rtems.adb
+++ b/c/src/ada/rtems.adb
@@ -10,14 +10,14 @@
 --
 --
 --
---  COPYRIGHT (c) 1997-2003.
+--  COPYRIGHT (c) 1997-2007.
 --  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$
+--  rtems.adb,v 1.13.2.2 2003/09/04 18:46:47 joel Exp
 --
 
 with Ada;
@@ -216,25 +216,6 @@ package body RTEMS is
    --
 
    --
-   --  Initialization Manager
-   --
-
-   -- RTEMS Initialization not supported from Ada.  Please write BSPs in C.
-
-   procedure Shutdown_Executive (
-      Result : in     RTEMS.Unsigned32
-   ) is
-      procedure Shutdown_Executive_Base(
-         Result : in     RTEMS.Unsigned32
-      );
-      pragma Import (C,Shutdown_Executive_Base,"rtems_shutdown_executive");
-   begin
-
-      Shutdown_Executive_Base( Result );
-
-   end Shutdown_Executive;
-
-   --
    --  Task Manager
    --
 
@@ -256,7 +237,7 @@ package body RTEMS is
          ID               : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Task_Create_Base, "rtems_task_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
       Result := Task_Create_Base (
         Name,
@@ -282,7 +263,7 @@ package body RTEMS is
          ID               : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Task_Ident_Base, "rtems_task_ident");
-      ID_Base     : aliased RTEMS.ID;
+      ID_Base     : aliased RTEMS.ID := ID;
 
    begin
 
@@ -379,7 +360,7 @@ package body RTEMS is
          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;
+      Old_Priority_Base : aliased RTEMS.Task_Priority := Old_Priority;
    begin
  
       Result := Task_Set_Priority_Base (
@@ -403,7 +384,7 @@ package body RTEMS is
          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;
+      Previous_Mode_Set_Base : aliased RTEMS.Mode := Previous_Mode_Set;
    begin
 
       Result := Task_Mode_Base (
@@ -427,11 +408,11 @@ package body RTEMS is
          Note    : access RTEMS.Unsigned32
       )  return RTEMS.Status_Codes;
       pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
-      Note_Base : aliased RTEMS.Unsigned32;
+      Note_Base : aliased RTEMS.Unsigned32 := Note;
    begin
 
       Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access );
-      Note := Note_Base;
+      Note := NOTE_Base;
 
    end Task_Get_Note;
  
@@ -453,41 +434,6 @@ 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
-   begin
-     -- FIXME
-     Result := Internal_Error;
-   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
-   begin
-     -- FIXME
-     Task_Variable := RTEMS.Null_Address;
-     Task_Variable_Value := RTEMS.Null_Address;
-     Result := Internal_Error;
-   end Task_Variable_Get;
-
-   procedure Task_Variable_Delete (
-      ID                  : in     RTEMS.ID;
-      Task_Variable       :    out RTEMS.Address;
-      Result              :    out RTEMS.Status_Codes
-   ) is
-   begin
-     -- FIXME
-     Task_Variable := RTEMS.Null_Address;
-     Result := Internal_Error;
-   end Task_Variable_Delete;
-
    procedure Task_Wake_When (
       Time_Buffer : in     RTEMS.Time_Of_Day;
       Result      :    out RTEMS.Status_Codes
@@ -532,13 +478,13 @@ package body RTEMS is
          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;
+      Old_ISR_Handler_Base : aliased RTEMS.Address := Old_ISR_Handler;
    begin
  
       Result := Interrupt_Catch_Base (
          New_ISR_Handler,
          Vector,
-         Old_ISR_Handler_Base'Unchecked_Access
+         OLD_ISR_HANDLER_Base'Unchecked_Access
       );
       Old_ISR_Handler := OLD_ISR_HANDLER_Base;
  
@@ -610,7 +556,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Extension_Create_Base, "rtems_extension_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
@@ -628,7 +574,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access ); 
@@ -664,7 +610,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Timer_Create_Base, "rtems_timer_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
@@ -682,7 +628,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
@@ -864,7 +810,7 @@ package body RTEMS is
          ID               : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Semaphore_Create_Base (
@@ -904,7 +850,7 @@ package body RTEMS is
          ID   : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
@@ -966,7 +912,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C,
         Message_Queue_Create_Base, "rtems_message_queue_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Message_Queue_Create_Base (
@@ -992,7 +938,7 @@ package body RTEMS is
          ID   : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result :=
@@ -1068,7 +1014,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C, Message_Queue_Broadcast_Base,
          "rtems_message_queue_broadcast");
-      Count_Base : aliased RTEMS.Unsigned32;
+      Count_Base : aliased RTEMS.Unsigned32 := Count;
    begin
  
       Result := Message_Queue_Broadcast_Base ( 
@@ -1122,7 +1068,7 @@ package body RTEMS is
          Count : access RTEMS.Unsigned32
       )  return RTEMS.Status_Codes;
       pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
-      COUNT_Base : aliased RTEMS.Unsigned32;
+      COUNT_Base : aliased RTEMS.Unsigned32 := Count;
    begin
  
       Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
@@ -1164,7 +1110,7 @@ package body RTEMS is
          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;
+      Event_Out_Base : aliased RTEMS.Event_Set; -- := Event_Out;
    begin
 
       Result := Event_Receive_Base (
@@ -1236,7 +1182,7 @@ package body RTEMS is
          ID               : access RTEMS.Event_Set
       )  return RTEMS.Status_Codes;
       pragma Import (C, Partition_Create_Base, "rtems_partition_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Partition_Create_Base (
@@ -1263,7 +1209,7 @@ package body RTEMS is
          ID   : access RTEMS.Event_Set
       )  return RTEMS.Status_Codes;
       pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
@@ -1296,7 +1242,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C, Partition_Get_Buffer_Base,
          "rtems_partition_get_buffer");
-      Buffer_Base : aliased RTEMS.Address;
+      Buffer_Base : aliased RTEMS.Address := Buffer;
    begin
  
       Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
@@ -1343,7 +1289,7 @@ package body RTEMS is
          ID               : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Region_Create_Base, "rtems_region_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Region_Create_Base (
@@ -1368,7 +1314,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Region_Ident_Base, "rtems_region_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
@@ -1424,7 +1370,7 @@ package body RTEMS is
          Segment    : access RTEMS.Address
       )  return RTEMS.Status_Codes;
       pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
-      Segment_Base : aliased RTEMS.Address;
+      Segment_Base : aliased RTEMS.Address := Segment;
    begin
  
       Result := Region_Get_Segment_Base (
@@ -1451,7 +1397,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C, Region_Get_Segment_Size_Base,
          "rtems_region_get_segment_size");
-      Size_Base : aliased RTEMS.Unsigned32;
+      Size_Base : aliased RTEMS.Unsigned32 := Size;
    begin
  
       Result := Region_Get_Segment_Size_Base (
@@ -1459,38 +1405,10 @@ package body RTEMS is
          Segment,
          Size_Base'Unchecked_Access
       );
-      Size := Size_Base;
+      Size := SIZE_Base;
 
    end Region_Get_Segment_Size;
  
-   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_get_segment_size");
-      Old_Size_Base : aliased RTEMS.Unsigned32;
-   begin
- 
-      Result := Region_Resize_Segment_Base (
-         ID,
-         Segment,
-         Size,
-         Old_Size_Base'Unchecked_Access
-      );
-      Old_Size := Old_Size_Base;
-
-   end Region_Resize_Segment;
-
    procedure Region_Return_Segment (
       ID      : in     RTEMS.ID;
       Segment : in     RTEMS.Address;
@@ -1528,7 +1446,7 @@ package body RTEMS is
          ID             : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Port_Create_Base, "rtems_port_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Port_Create_Base (
@@ -1552,7 +1470,7 @@ package body RTEMS is
          ID   : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Port_Ident_Base, "rtems_port_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
@@ -1587,7 +1505,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C, Port_External_To_Internal_Base,
          "rtems_port_external_to_internal");
-      Internal_Base : aliased RTEMS.Address;
+      Internal_Base : aliased RTEMS.Address := Internal;
    begin
  
       Result := Port_External_To_Internal_Base (
@@ -1612,7 +1530,7 @@ package body RTEMS is
       )  return RTEMS.Status_Codes;
       pragma Import (C, Port_Internal_To_External_Base,
          "rtems_port_internal_to_external");
-      External_Base : aliased RTEMS.Address;
+      External_Base : aliased RTEMS.Address := External;
    begin
  
       Result := Port_Internal_To_External_Base (
@@ -1628,24 +1546,6 @@ package body RTEMS is
    -- Input/Output Manager
    --
  
-   procedure IO_Initialize (
-      Major        : in     RTEMS.Device_Major_Number;
-      Minor        : in     RTEMS.Device_Minor_Number;
-      Argument     : in     RTEMS.Address;
-      Result       :    out RTEMS.Status_Codes
-   ) is
-      function IO_Initialize_Base (
-         Major        : RTEMS.Device_Major_Number;
-         Minor        : RTEMS.Device_Minor_Number;
-         Argument     : RTEMS.Address
-      )  return RTEMS.Status_Codes;
-      pragma Import (C, IO_Initialize_Base, "rtems_io_initialize");
-   begin
- 
-      Result := IO_Initialize_Base ( Major, Minor, Argument );
-
-   end IO_Initialize;
- 
    procedure IO_Register_Name (
       Name   : in     String;
       Major  : in     RTEMS.Device_Major_Number;
@@ -1808,7 +1708,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Rate_Monotonic_Create_base, "rtems_rate_monotonic_create");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Rate_Monotonic_Create_base ( Name, ID_Base'Unchecked_Access );
@@ -1826,7 +1726,7 @@ package body RTEMS is
          ID     : access RTEMS.ID
       )  return RTEMS.Status_Codes;
       pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
-      ID_Base : aliased RTEMS.ID;
+      ID_Base : aliased RTEMS.ID := ID;
    begin
  
       Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
@@ -1952,13 +1852,4 @@ package body RTEMS is
 
    end Debug_Is_Enabled;
 
-    -- HACK
-    -- function Configuration 
-    -- return RTEMS.Configuration_Table_Pointer is
-    --    Configuration_base : RTEMS.Configuration_Table_Pointer;
-    --    pragma Import (C, Configuration_base, "_Configuration_Table");
-    -- begin
-    --    return Configuration_Base;
-    -- end Configuration;
-
 end RTEMS;