Changeset 8407b5e in rtems


Ignore:
Timestamp:
Feb 1, 2008, 9:24:18 PM (12 years ago)
Author:
Joel Sherrill <joel.sherrill@…>
Branches:
4.10, 4.11, 4.9, master
Children:
6c4e9d0
Parents:
0bc8e5c
Message:

2008-02-01 Joel Sherrill <joel.sherrill@…>

  • rtems.adb, rtems.ads: Add Ada binding for Object Services.
Location:
c/src/ada
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • c/src/ada/ChangeLog

    r0bc8e5c r8407b5e  
     12008-02-01      Joel Sherrill <joel.sherrill@oarcorp.com>
     2
     3        * rtems.adb, rtems.ads: Add Ada binding for Object Services.
     4
    152007-12-04      Joel Sherrill <joel.sherrill@oarcorp.com>
    26
  • c/src/ada/rtems.adb

    r0bc8e5c r8407b5e  
    1111--
    1212--
    13 --  COPYRIGHT (c) 1997-2007.
     13--  COPYRIGHT (c) 1997-2008.
    1414--  On-Line Applications Research Corporation (OAR).
    1515--
     
    2525with System;
    2626with Interfaces; use Interfaces;
    27 with Interfaces.C;
     27with Interfaces.C; use Interfaces.C;
     28with Interfaces.C.Strings; use Interfaces.C.Strings;
    2829
    2930package body RTEMS is
     
    8788
    8889   end Milliseconds_To_Ticks;
     90
     91   procedure Name_To_Characters (
     92      Name : in     RTEMS.Name;
     93      C1   :    out Character;
     94      C2   :    out Character;
     95      C3   :    out Character;
     96      C4   :    out Character
     97   ) is
     98      C1_Value : RTEMS.Unsigned32;
     99      C2_Value : RTEMS.Unsigned32;
     100      C3_Value : RTEMS.Unsigned32;
     101      C4_Value : RTEMS.Unsigned32;
     102   begin
     103
     104     C1_Value := Interfaces.Shift_Right( Name, 24 );
     105     C2_Value := Interfaces.Shift_Right( Name, 16 );
     106     C3_Value := Interfaces.Shift_Right( Name, 8 );
     107     C4_Value := Name;
     108
     109     C1_Value := C1_Value and 16#00FF#;
     110     C2_Value := C2_Value and 16#00FF#;
     111     C3_Value := C3_Value and 16#00FF#;
     112     C4_Value := C4_Value and 16#00FF#;
     113
     114     C1 := Character'Val( C1_Value );
     115     C2 := Character'Val( C2_Value );
     116     C3 := Character'Val( C3_Value );
     117     C4 := Character'Val( C4_Value );
     118
     119   end Name_To_Characters;
     120
     121   function Get_Node (
     122      ID : in     RTEMS.ID
     123   ) return RTEMS.Unsigned32 is
     124   begin
     125
     126      -- May not be right
     127      return Interfaces.Shift_Right( ID, 16 );
     128
     129   end Get_Node;
     130
     131   function Get_Index (
     132      ID : in     RTEMS.ID
     133   ) return RTEMS.Unsigned32 is
     134   begin
     135
     136      -- May not be right
     137      return ID and 16#FFFF#;
     138
     139   end Get_Index;
     140
     141   function Are_Statuses_Equal (
     142      Status  : in     RTEMS.Status_Codes;
     143      Desired : in     RTEMS.Status_Codes
     144   ) return Standard.Boolean is
     145   begin
     146
     147      if Status = Desired then
     148         return Standard.True;
     149      end if;
     150
     151      return Standard.False;
     152
     153   end Are_Statuses_Equal;
     154
     155   function Is_Status_Successful (
     156      Status  : in     RTEMS.Status_Codes
     157   ) return Standard.Boolean is
     158   begin
     159
     160      if Status = RTEMS.Successful then
     161         return Standard.True;
     162      end if;
     163
     164      return Standard.False;
     165
     166   end Is_Status_Successful;
     167
     168   function Subtract (
     169      Left   : in     RTEMS.Address;
     170      Right  : in     RTEMS.Address
     171   ) return RTEMS.Unsigned32 is
     172      function To_Unsigned32 is
     173         new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
     174
     175   begin
     176      return To_Unsigned32(Left) - To_Unsigned32(Right);
     177   end Subtract;
     178
     179   function Are_Equal (
     180      Left   : in     RTEMS.Address;
     181      Right  : in     RTEMS.Address
     182   ) return Standard.Boolean is
     183      function To_Unsigned32 is
     184         new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
     185
     186   begin
     187      return (To_Unsigned32(Left) = To_Unsigned32(Right));
     188   end Are_Equal;
     189
     190   --
     191   --
     192   --  RTEMS API
     193   --
     194
     195   --
     196   --  Initialization Manager -- Shutdown Only
     197   --
     198   procedure Shutdown_Executive (
     199      Status           : in     RTEMS.Unsigned32
     200   ) is
     201      procedure Shutdown_Executive_Base (
     202         Status : RTEMS.Unsigned32
     203      );
     204      pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
     205   begin
     206      Shutdown_Executive_Base (Status);
     207   end Shutdown_Executive;
     208 
     209
     210   --
     211   --  Task Manager
     212   --
     213
     214   procedure Task_Create (
     215      Name             : in     RTEMS.Name;
     216      Initial_Priority : in     RTEMS.Task_Priority;
     217      Stack_Size       : in     RTEMS.Unsigned32;
     218      Initial_Modes    : in     RTEMS.Mode;
     219      Attribute_Set    : in     RTEMS.Attribute;
     220      ID               :    out RTEMS.ID;
     221      Result           :    out RTEMS.Status_Codes
     222   ) is
     223      function Task_Create_Base (
     224         Name             : RTEMS.Name;
     225         Initial_Priority : RTEMS.Task_Priority;
     226         Stack_Size       : RTEMS.Unsigned32;
     227         Initial_Modes    : RTEMS.Mode;
     228         Attribute_Set    : RTEMS.Attribute;
     229         ID               : access RTEMS.ID
     230      )  return RTEMS.Status_Codes;
     231      pragma Import (C, Task_Create_Base, "rtems_task_create");
     232      ID_Base : aliased RTEMS.ID;
     233   begin
     234      Result := Task_Create_Base (
     235        Name,
     236        Initial_Priority,
     237        Stack_Size,
     238        Initial_Modes,
     239        Attribute_Set,
     240        ID_Base'Unchecked_Access
     241      );
     242      ID := ID_Base;
     243   end Task_Create;
     244
     245   procedure Task_Ident (
     246      Name             : in     RTEMS.Name;
     247      Node             : in     RTEMS.Node;
     248      ID               :    out RTEMS.ID;
     249      Result           :    out RTEMS.Status_Codes
     250   ) is
     251
     252      function Task_Ident_Base (
     253         Name             : RTEMS.Name;
     254         Node             : RTEMS.Node;
     255         ID               : access RTEMS.ID
     256      )  return RTEMS.Status_Codes;
     257      pragma Import (C, Task_Ident_Base, "rtems_task_ident");
     258      ID_Base     : aliased RTEMS.ID;
     259
     260   begin
     261
     262      Result := Task_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
     263      ID := ID_Base;
     264
     265   end Task_Ident;
     266
     267   procedure Task_Start (
     268      ID          : in     RTEMS.ID;
     269      Entry_Point : in     RTEMS.Task_Entry;
     270      Argument    : in     RTEMS.Task_Argument;
     271      Result      :    out RTEMS.Status_Codes
     272   ) is
     273      function Task_Start_Base (
     274         ID          : RTEMS.ID;
     275         Entry_Point : RTEMS.Task_Entry;
     276         Argument    : RTEMS.Task_Argument
     277      )  return RTEMS.Status_Codes;
     278      pragma Import (C, Task_Start_Base, "rtems_task_start");
     279   begin
     280
     281      Result := Task_Start_Base ( ID, Entry_Point, Argument );
     282
     283   end Task_Start;
     284
     285   procedure Task_Restart (
     286      ID       : in     RTEMS.ID;
     287      Argument : in     RTEMS.Task_Argument;
     288      Result   :    out RTEMS.Status_Codes
     289   ) is
     290      function Task_Restart_Base (
     291         ID       : RTEMS.ID;
     292         Argument : RTEMS.Task_Argument
     293      )  return RTEMS.Status_Codes;
     294      pragma Import (C, Task_Restart_Base, "rtems_task_restart");
     295   begin
     296
     297      Result := Task_Restart_Base ( ID, Argument );
     298 
     299   end Task_Restart;
     300 
     301   procedure Task_Delete (
     302      ID     : in     RTEMS.ID;
     303      Result :    out RTEMS.Status_Codes
     304   ) is
     305      function Task_Delete_Base (
     306         ID : RTEMS.ID
     307      )  return RTEMS.Status_Codes;
     308      pragma Import (C, Task_Delete_Base, "rtems_task_delete");
     309   begin
     310
     311      Result := Task_Delete_Base ( ID );
     312 
     313   end Task_Delete;
     314 
     315   procedure Task_Suspend (
     316      ID     : in     RTEMS.ID;
     317      Result :    out RTEMS.Status_Codes
     318   ) is
     319      function Task_Suspend_Base (
     320         ID : RTEMS.ID
     321      )  return RTEMS.Status_Codes;
     322      pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
     323   begin
     324
     325      Result := Task_Suspend_Base ( ID );
     326 
     327   end Task_Suspend;
     328 
     329   procedure Task_Resume (
     330      ID     : in     RTEMS.ID;
     331      Result :    out RTEMS.Status_Codes
     332   ) is
     333      function Task_Resume_Base (
     334         ID : RTEMS.ID
     335      )  return RTEMS.Status_Codes;
     336      pragma Import (C, Task_Resume_Base, "rtems_task_resume");
     337   begin
     338
     339      Result := Task_Resume_Base ( ID );
     340
     341   end Task_Resume;
     342 
     343   procedure Task_Is_Suspended (
     344      ID     : in     RTEMS.ID;
     345      Result :    out RTEMS.Status_Codes
     346   ) is
     347      function Task_Is_Suspended_Base (
     348         ID : RTEMS.ID
     349      )  return RTEMS.Status_Codes;
     350      pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended");
     351   begin
     352
     353      Result := Task_Is_Suspended_Base ( ID );
     354
     355   end Task_Is_Suspended;
     356 
     357   procedure Task_Set_Priority (
     358      ID           : in     RTEMS.ID;
     359      New_Priority : in     RTEMS.Task_Priority;
     360      Old_Priority :    out RTEMS.Task_Priority;
     361      Result       :    out RTEMS.Status_Codes
     362   ) is
     363      function Task_Set_Priority_Base (
     364         ID           : RTEMS.ID;
     365         New_Priority : RTEMS.Task_Priority;
     366         Old_Priority : access RTEMS.Task_Priority
     367      )  return RTEMS.Status_Codes;
     368      pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority");
     369      Old_Priority_Base : aliased RTEMS.Task_Priority;
     370   begin
     371 
     372      Result := Task_Set_Priority_Base (
     373         ID,
     374         New_Priority,
     375         Old_Priority_Base'Unchecked_Access
     376      );
     377      Old_Priority := Old_Priority_Base;
     378
     379   end Task_Set_Priority;
     380 
     381   procedure Task_Mode (
     382      Mode_Set          : in     RTEMS.Mode;
     383      Mask              : in     RTEMS.Mode;
     384      Previous_Mode_Set :    out RTEMS.Mode;
     385      Result            :    out RTEMS.Status_Codes
     386   ) is
     387      function Task_Mode_Base (
     388         Mode_Set          : RTEMS.Mode;
     389         Mask              : RTEMS.Mode;
     390         Previous_Mode_Set : access RTEMS.Mode
     391      )  return RTEMS.Status_Codes;
     392      pragma Import (C, Task_Mode_Base, "rtems_task_mode");
     393      Previous_Mode_Set_Base : aliased RTEMS.Mode;
     394   begin
     395
     396      Result := Task_Mode_Base (
     397         Mode_Set,
     398         Mask,
     399         Previous_Mode_Set_Base'Unchecked_Access
     400      );
     401      Previous_Mode_Set := Previous_Mode_Set_Base;
     402
     403   end Task_Mode;
     404 
     405   procedure Task_Get_Note (
     406      ID      : in     RTEMS.ID;
     407      Notepad : in     RTEMS.Notepad_Index;
     408      Note    :    out RTEMS.Unsigned32;
     409      Result  :    out RTEMS.Status_Codes
     410   ) is
     411      function Task_Get_Note_Base (
     412         ID      : RTEMS.ID;
     413         Notepad : RTEMS.Notepad_Index;
     414         Note    : access RTEMS.Unsigned32
     415      )  return RTEMS.Status_Codes;
     416      pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
     417      Note_Base : aliased RTEMS.Unsigned32;
     418   begin
     419
     420      Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access );
     421      Note := NOTE_Base;
     422
     423   end Task_Get_Note;
     424 
     425   procedure Task_Set_Note (
     426      ID      : in     RTEMS.ID;
     427      Notepad : in     RTEMS.Notepad_Index;
     428      Note    : in     RTEMS.Unsigned32;
     429      Result  :    out RTEMS.Status_Codes
     430   ) is
     431      function Task_Set_Note_Base (
     432         ID      : RTEMS.ID;
     433         Notepad : RTEMS.Notepad_Index;
     434         Note    : RTEMS.Unsigned32
     435      )  return RTEMS.Status_Codes;
     436      pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
     437   begin
     438
     439      Result := Task_Set_Note_Base ( ID, Notepad, Note );
     440
     441   end Task_Set_Note;
     442 
     443   procedure Task_Variable_Add (
     444      ID            : in     RTEMS.ID;
     445      Task_Variable : in     RTEMS.Address;
     446      Dtor          : in     RTEMS.Task_Variable_Dtor;
     447      Result        :    out RTEMS.Status_Codes
     448   ) is
     449      function Task_Variable_Add_Base (
     450         ID            : RTEMS.ID;
     451         Task_Variable : RTEMS.Address;
     452         Dtor          : RTEMS.Task_Variable_Dtor
     453      )  return RTEMS.Status_Codes;
     454      pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
     455   begin
     456
     457      Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
     458
     459   end Task_Variable_Add;
     460
     461   procedure Task_Variable_Get (
     462      ID                  : in     RTEMS.ID;
     463      Task_Variable       :    out RTEMS.Address;
     464      Task_Variable_Value :    out RTEMS.Address;
     465      Result              :    out RTEMS.Status_Codes
     466   ) is
     467      function Task_Variable_Get_Base (
     468         ID                  : RTEMS.ID;
     469         Task_Variable       : access RTEMS.Address;
     470         Task_Variable_Value : access RTEMS.Address
     471      )  return RTEMS.Status_Codes;
     472      pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
     473      Task_Variable_Base       : aliased RTEMS.Address;
     474      Task_Variable_Value_Base : aliased RTEMS.Address;
     475   begin
     476
     477      Result := Task_Variable_Get_Base (
     478         ID,
     479         Task_Variable_Base'Unchecked_Access,
     480         Task_Variable_Value_Base'Unchecked_Access
     481      );
     482      Task_Variable := Task_Variable_Base;
     483      Task_Variable_Value := Task_Variable_Value_Base;
     484
     485   end Task_Variable_Get;
     486
     487   procedure Task_Variable_Delete (
     488      ID                  : in     RTEMS.ID;
     489      Task_Variable       :    out RTEMS.Address;
     490      Result              :    out RTEMS.Status_Codes
     491   ) is
     492      function Task_Variable_Delete_Base (
     493         ID                  : RTEMS.ID;
     494         Task_Variable       : access RTEMS.Address
     495      )  return RTEMS.Status_Codes;
     496      pragma Import (
     497         C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
     498      );
     499      Task_Variable_Base : aliased RTEMS.Address;
     500   begin
     501
     502      Result := Task_Variable_Delete_Base (
     503         ID, Task_Variable_Base'Unchecked_Access
     504      );
     505      Task_Variable := Task_Variable_Base;
     506
     507   end Task_Variable_Delete;
     508
     509   procedure Task_Wake_When (
     510      Time_Buffer : in     RTEMS.Time_Of_Day;
     511      Result      :    out RTEMS.Status_Codes
     512   ) is
     513      function Task_Wake_When_Base (
     514         Time_Buffer : RTEMS.Time_Of_Day
     515      )  return RTEMS.Status_Codes;
     516      pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
     517   begin
     518
     519      Result := Task_Wake_When_Base ( Time_Buffer );
     520
     521   end Task_Wake_When;
     522 
     523   procedure Task_Wake_After (
     524      Ticks  : in     RTEMS.Interval;
     525      Result :    out RTEMS.Status_Codes
     526   ) is
     527      function Task_Wake_After_Base (
     528         Ticks : RTEMS.Interval
     529      )  return RTEMS.Status_Codes;
     530      pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
     531   begin
     532
     533      Result := Task_Wake_After_Base ( Ticks );
     534
     535   end Task_Wake_After;
     536 
     537   --
     538   -- Interrupt Manager
     539   --
     540
     541   -- Interrupt_Disable is interfaced in the specification
     542   -- Interrupt_Enable is interfaced in the specification
     543   -- Interrupt_Flash is interfaced in the specification
     544   -- Interrupt_Is_In_Progress is interfaced in the specification
     545
     546   --
     547   -- Clock Manager
     548   --
     549 
     550   procedure Clock_Set (
     551      Time_Buffer : in     RTEMS.Time_Of_Day;
     552      Result      :    out RTEMS.Status_Codes
     553   ) is
     554      function Clock_Set_Base (
     555         Time_Buffer : RTEMS.Time_Of_Day
     556      )  return RTEMS.Status_Codes;
     557      pragma Import (C, Clock_Set_Base, "rtems_clock_set");
     558   begin
     559 
     560      Result := Clock_Set_Base ( Time_Buffer );
     561
     562   end Clock_Set;
     563 
     564   procedure Clock_Get (
     565      Option      : in     RTEMS.Clock_Get_Options;
     566      Time_Buffer : in     RTEMS.Address;
     567      Result      :    out RTEMS.Status_Codes
     568   ) is
     569      function Clock_Get_Base (
     570         Option      : RTEMS.Clock_Get_Options;
     571         Time_Buffer : RTEMS.Address
     572      )  return RTEMS.Status_Codes;
     573      pragma Import (C, Clock_Get_Base, "rtems_clock_get");
     574   begin
     575
     576      Result := Clock_Get_Base ( Option, Time_Buffer );
     577
     578   end Clock_Get;
     579 
     580   procedure Clock_Get_Uptime (
     581      Uptime :    out RTEMS.Timespec;
     582      Result :    out RTEMS.Status_Codes
     583   ) is
     584      function Clock_Get_Uptime_Base (
     585         Uptime : access RTEMS.Timespec
     586      )  return RTEMS.Status_Codes;
     587      pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime");
     588      Uptime_Base : aliased RTEMS.Timespec;
     589   begin
     590
     591      Result := Clock_Get_Uptime_Base (
     592         Uptime_Base'Unchecked_Access
     593      );
     594      Uptime := Uptime_Base;
     595
     596   end Clock_Get_Uptime;
     597 
     598   procedure Clock_Tick (
     599      Result :    out RTEMS.Status_Codes
     600   ) is
     601      function Clock_Tick_Base return RTEMS.Status_Codes;
     602      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
     603   begin
     604
     605      Result := Clock_Tick_Base;
     606
     607   end Clock_Tick;
     608
     609   --
     610   -- Extension Manager
     611   --
     612 
     613   procedure Extension_Create (
     614      Name   : in     RTEMS.Name;
     615      Table  : in     RTEMS.Extensions_Table_Pointer;
     616      ID     :    out RTEMS.ID;
     617      Result :    out RTEMS.Status_Codes
     618   ) is
     619      function Extension_Create_Base (
     620         Name   : RTEMS.Name;
     621         Table  : RTEMS.Extensions_Table_Pointer;
     622         ID     : access RTEMS.ID
     623      )  return RTEMS.Status_Codes;
     624      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
     625      ID_Base : aliased RTEMS.ID;
     626   begin
     627 
     628      Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
     629      ID := ID_Base;
     630
     631   end Extension_Create;
     632 
     633   procedure Extension_Ident (
     634      Name   : in     RTEMS.Name;
     635      ID     :    out RTEMS.ID;
     636      Result :    out RTEMS.Status_Codes
     637   ) is
     638      function Extension_Ident_Base (
     639         Name   : RTEMS.Name;
     640         ID     : access RTEMS.ID
     641      )  return RTEMS.Status_Codes;
     642      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
     643      ID_Base : aliased RTEMS.ID;
     644   begin
     645 
     646      Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access );
     647      ID := ID_Base;
     648
     649   end Extension_Ident;
     650 
     651   procedure Extension_Delete (
     652      ID     : in     RTEMS.ID;
     653      Result :    out RTEMS.Status_Codes
     654   ) is
     655      function Extension_Delete_Base (
     656         ID : RTEMS.ID
     657      )  return RTEMS.Status_Codes;
     658      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
     659   begin
     660 
     661      Result := Extension_Delete_Base ( ID );
     662
     663   end Extension_Delete;
     664 
     665   --
     666   -- Timer Manager
     667   --
     668 
     669   procedure Timer_Create (
     670      Name   : in     RTEMS.Name;
     671      ID     :    out RTEMS.ID;
     672      Result :    out RTEMS.Status_Codes
     673   ) is
     674      function Timer_Create_Base (
     675         Name   : RTEMS.Name;
     676         ID     : access RTEMS.ID
     677      )  return RTEMS.Status_Codes;
     678      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
     679      ID_Base : aliased RTEMS.ID;
     680   begin
     681 
     682      Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
     683      ID := ID_Base;
     684
     685   end Timer_Create;
     686 
     687   procedure Timer_Ident (
     688      Name   : in     RTEMS.Name;
     689      ID     :    out RTEMS.ID;
     690      Result :    out RTEMS.Status_Codes
     691   ) is
     692      function Timer_Ident_Base (
     693         Name   : RTEMS.Name;
     694         ID     : access RTEMS.ID
     695      )  return RTEMS.Status_Codes;
     696      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
     697      ID_Base : aliased RTEMS.ID;
     698   begin
     699 
     700      Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
     701      ID := ID_Base;
     702
     703   end Timer_Ident;
     704 
     705   procedure Timer_Delete (
     706      ID     : in     RTEMS.ID;
     707      Result :    out RTEMS.Status_Codes
     708   ) is
     709      function Timer_Delete_Base (
     710         ID : RTEMS.ID
     711      )  return RTEMS.Status_Codes;
     712      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
     713   begin
     714 
     715      Result := Timer_Delete_Base ( ID );
     716
     717   end Timer_Delete;
     718 
     719   procedure Timer_Fire_After (
     720      ID        : in     RTEMS.ID;
     721      Ticks     : in     RTEMS.Interval;
     722      Routine   : in     RTEMS.Timer_Service_Routine;
     723      User_Data : in     RTEMS.Address;
     724      Result    :    out RTEMS.Status_Codes
     725   ) is
     726      function Timer_Fire_After_Base (
     727         ID        : RTEMS.ID;
     728         Ticks     : RTEMS.Interval;
     729         Routine   : RTEMS.Timer_Service_Routine;
     730         User_Data : RTEMS.Address
     731      )  return RTEMS.Status_Codes;
     732      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
     733   begin
     734 
     735      Result := Timer_Fire_After_Base ( ID, Ticks, Routine, User_Data );
     736
     737   end Timer_Fire_After;
     738 
     739   procedure Timer_Server_Fire_After (
     740      ID        : in     RTEMS.ID;
     741      Ticks     : in     RTEMS.Interval;
     742      Routine   : in     RTEMS.Timer_Service_Routine;
     743      User_Data : in     RTEMS.Address;
     744      Result    :    out RTEMS.Status_Codes
     745   ) is
     746      function Timer_Server_Fire_After_Base (
     747         ID        : RTEMS.ID;
     748         Ticks     : RTEMS.Interval;
     749         Routine   : RTEMS.Timer_Service_Routine;
     750         User_Data : RTEMS.Address
     751      )  return RTEMS.Status_Codes;
     752      pragma Import (
     753        C,
     754        Timer_Server_Fire_After_Base,
     755        "rtems_timer_server_fire_after"
     756      );
     757   begin
     758 
     759      Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data );
     760
     761   end Timer_Server_Fire_After;
     762 
     763   procedure Timer_Fire_When (
     764      ID        : in     RTEMS.ID;
     765      Wall_Time : in     RTEMS.Time_Of_Day;
     766      Routine   : in     RTEMS.Timer_Service_Routine;
     767      User_Data : in     RTEMS.Address;
     768      Result    :    out RTEMS.Status_Codes
     769   ) is
     770      function Timer_Fire_When_Base (
     771         ID        : RTEMS.ID;
     772         Wall_Time : RTEMS.Time_Of_Day;
     773         Routine   : RTEMS.Timer_Service_Routine;
     774         User_Data : RTEMS.Address
     775      )  return RTEMS.Status_Codes;
     776      pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
     777   begin
     778 
     779      Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
     780
     781   end Timer_Fire_When;
     782 
     783   procedure Timer_Server_Fire_When (
     784      ID        : in     RTEMS.ID;
     785      Wall_Time : in     RTEMS.Time_Of_Day;
     786      Routine   : in     RTEMS.Timer_Service_Routine;
     787      User_Data : in     RTEMS.Address;
     788      Result    :    out RTEMS.Status_Codes
     789   ) is
     790      function Timer_Server_Fire_When_Base (
     791         ID        : RTEMS.ID;
     792         Wall_Time : RTEMS.Time_Of_Day;
     793         Routine   : RTEMS.Timer_Service_Routine;
     794         User_Data : RTEMS.Address
     795      )  return RTEMS.Status_Codes;
     796      pragma Import (
     797         C,
     798         Timer_Server_Fire_When_Base,
     799         "rtems_timer_server_fire_when"
     800      );
     801   begin
     802 
     803      Result :=
     804         Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
     805   end Timer_Server_Fire_When;
     806 
     807   procedure Timer_Reset (
     808      ID     : in     RTEMS.ID;
     809      Result :    out RTEMS.Status_Codes
     810   ) is
     811      function Timer_Reset_Base (
     812         ID : RTEMS.ID
     813      )  return RTEMS.Status_Codes;
     814      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
     815   begin
     816 
     817      Result := Timer_Reset_Base ( ID );
     818
     819   end Timer_Reset;
     820 
     821   procedure Timer_Cancel (
     822      ID     : in     RTEMS.ID;
     823      Result :    out RTEMS.Status_Codes
     824   ) is
     825      function Timer_Cancel_Base (
     826         ID : RTEMS.ID
     827      )  return RTEMS.Status_Codes;
     828      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
     829   begin
     830 
     831      Result := Timer_Cancel_Base ( ID );
     832
     833   end Timer_Cancel;
     834 
     835   procedure Timer_Initiate_Server (
     836      Server_Priority : in     RTEMS.Task_Priority;
     837      Stack_Size      : in     RTEMS.Unsigned32;
     838      Attribute_Set   : in     RTEMS.Attribute;
     839      Result          :    out RTEMS.Status_Codes
     840   ) is
     841      function Timer_Initiate_Server_Base (
     842         Server_Priority : RTEMS.Task_Priority;
     843         Stack_Size      : RTEMS.Unsigned32;
     844         Attribute_Set   : RTEMS.Attribute
     845      )  return RTEMS.Status_Codes;
     846      pragma Import (
     847         C,
     848         Timer_Initiate_Server_Base,
     849         "rtems_timer_initiate_server"
     850      );
     851   begin
     852      Result := Timer_Initiate_Server_Base (
     853         Server_Priority,
     854         Stack_Size,
     855         Attribute_Set
     856      );
     857   end Timer_Initiate_Server;
     858
     859   --
     860   -- Semaphore Manager
     861   --
     862 
     863   procedure Semaphore_Create (
     864      Name             : in     RTEMS.Name;
     865      Count            : in     RTEMS.Unsigned32;
     866      Attribute_Set    : in     RTEMS.Attribute;
     867      Priority_Ceiling : in     RTEMS.Task_Priority;
     868      ID               :    out RTEMS.ID;
     869      Result           :    out RTEMS.Status_Codes
     870   ) is
     871      function Semaphore_Create_Base (
     872         Name             : RTEMS.Name;
     873         Count            : RTEMS.Unsigned32;
     874         Attribute_Set    : RTEMS.Attribute;
     875         Priority_Ceiling : RTEMS.Task_Priority;
     876         ID               : access RTEMS.ID
     877      )  return RTEMS.Status_Codes;
     878      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
     879      ID_Base : aliased RTEMS.ID;
     880   begin
     881 
     882      Result := Semaphore_Create_Base (
     883         Name,
     884         Count,
     885         Attribute_Set,
     886         Priority_Ceiling,
     887         ID_Base'Unchecked_Access
     888      );
     889      ID := ID_Base;
     890
     891   end Semaphore_Create;
     892 
     893   procedure Semaphore_Delete (
     894      ID     : in     RTEMS.ID;
     895      Result :    out RTEMS.Status_Codes
     896   ) is
     897      function Semaphore_Delete_Base (
     898         ID : RTEMS.ID
     899      )  return RTEMS.Status_Codes;
     900      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
     901   begin
     902 
     903      Result := Semaphore_Delete_Base ( ID );
     904
     905   end Semaphore_Delete;
     906 
     907   procedure Semaphore_Ident (
     908      Name   : in     RTEMS.Name;
     909      Node   : in     RTEMS.Unsigned32;
     910      ID     :    out RTEMS.ID;
     911      Result :    out RTEMS.Status_Codes
     912   ) is
     913      function Semaphore_Ident_Base (
     914         Name : RTEMS.Name;
     915         Node : RTEMS.Unsigned32;
     916         ID   : access RTEMS.ID
     917      )  return RTEMS.Status_Codes;
     918      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
     919      ID_Base : aliased RTEMS.ID;
     920   begin
     921 
     922      Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
     923      ID := ID_Base;
     924
     925   end Semaphore_Ident;
     926 
     927   procedure Semaphore_Obtain (
     928      ID         : in     RTEMS.ID;
     929      Option_Set : in     RTEMS.Option;
     930      Timeout    : in     RTEMS.Interval;
     931      Result     :    out RTEMS.Status_Codes
     932   ) is
     933      function Semaphore_Obtain_Base (
     934         ID         : RTEMS.ID;
     935         Option_Set : RTEMS.Option;
     936         Timeout    : RTEMS.Interval
     937      )  return RTEMS.Status_Codes;
     938      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
     939   begin
     940 
     941      Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout );
     942
     943   end Semaphore_Obtain;
     944 
     945   procedure Semaphore_Release (
     946      ID     : in     RTEMS.ID;
     947      Result :    out RTEMS.Status_Codes
     948   ) is
     949      function Semaphore_Release_Base (
     950         ID : RTEMS.ID
     951      )  return RTEMS.Status_Codes;
     952      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
     953   begin
     954 
     955      Result := Semaphore_Release_Base ( ID );
     956
     957   end Semaphore_Release;
     958 
     959   procedure Semaphore_Flush (
     960      ID     : in     RTEMS.ID;
     961      Result :    out RTEMS.Status_Codes
     962   ) is
     963      function Semaphore_Flush_Base (
     964         ID : RTEMS.ID
     965      )  return RTEMS.Status_Codes;
     966      pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
     967   begin
     968 
     969      Result := Semaphore_Flush_Base ( ID );
     970
     971   end Semaphore_Flush;
     972 
     973   --
     974   -- Message Queue Manager
     975   --
     976 
     977   procedure Message_Queue_Create (
     978      Name             : in     RTEMS.Name;
     979      Count            : in     RTEMS.Unsigned32;
     980      Max_Message_Size : in     RTEMS.Unsigned32;
     981      Attribute_Set    : in     RTEMS.Attribute;
     982      ID               :    out RTEMS.ID;
     983      Result           :    out RTEMS.Status_Codes
     984   ) is
     985      --  XXX broken
     986      function Message_Queue_Create_Base (
     987         Name             : RTEMS.Name;
     988         Count            : RTEMS.Unsigned32;
     989         Max_Message_Size : RTEMS.Unsigned32;
     990         Attribute_Set    : RTEMS.Attribute;
     991         ID               : access RTEMS.ID
     992      )  return RTEMS.Status_Codes;
     993      pragma Import (C,
     994        Message_Queue_Create_Base, "rtems_message_queue_create");
     995      ID_Base : aliased RTEMS.ID;
     996   begin
     997 
     998      Result := Message_Queue_Create_Base (
     999         Name,
     1000         Count,
     1001         Max_Message_Size,
     1002         Attribute_Set,
     1003         ID_Base'Unchecked_Access
     1004      );
     1005      ID := ID_Base;
     1006
     1007   end Message_Queue_Create;
     1008 
     1009   procedure Message_Queue_Ident (
     1010      Name   : in     RTEMS.Name;
     1011      Node   : in     RTEMS.Unsigned32;
     1012      ID     :    out RTEMS.ID;
     1013      Result :    out RTEMS.Status_Codes
     1014   ) is
     1015      function Message_Queue_Ident_Base (
     1016         Name : RTEMS.Name;
     1017         Node : RTEMS.Unsigned32;
     1018         ID   : access RTEMS.ID
     1019      )  return RTEMS.Status_Codes;
     1020      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
     1021      ID_Base : aliased RTEMS.ID;
     1022   begin
     1023 
     1024      Result :=
     1025         Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
     1026      ID := ID_Base;
     1027
     1028   end Message_Queue_Ident;
     1029 
     1030   procedure Message_Queue_Delete (
     1031      ID     : in     RTEMS.ID;
     1032      Result :    out RTEMS.Status_Codes
     1033   ) is
     1034      function Message_Queue_Delete_Base (
     1035         ID : RTEMS.ID
     1036      )  return RTEMS.Status_Codes;
     1037      pragma Import (
     1038         C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
     1039   begin
     1040 
     1041      Result := Message_Queue_Delete_Base ( ID );
     1042
     1043   end Message_Queue_Delete;
     1044 
     1045   procedure Message_Queue_Send (
     1046      ID     : in     RTEMS.ID;
     1047      Buffer : in     RTEMS.Address;
     1048      Size   : in     RTEMS.Unsigned32;
     1049      Result :    out RTEMS.Status_Codes
     1050   ) is
     1051      function Message_Queue_Send_Base (
     1052         ID     : RTEMS.ID;
     1053         Buffer : RTEMS.Address;
     1054         Size   : RTEMS.Unsigned32
     1055      )  return RTEMS.Status_Codes;
     1056      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
     1057   begin
     1058 
     1059      Result := Message_Queue_Send_Base ( ID, Buffer, Size );
     1060
     1061   end Message_Queue_Send;
     1062 
     1063   procedure Message_Queue_Urgent (
     1064      ID     : in     RTEMS.ID;
     1065      Buffer : in     RTEMS.Address;
     1066      Size   : in     RTEMS.Unsigned32;
     1067      Result :    out RTEMS.Status_Codes
     1068   ) is
     1069      function Message_Queue_Urgent_Base (
     1070         ID     : RTEMS.ID;
     1071         Buffer : RTEMS.Address;
     1072         Size   : RTEMS.Unsigned32
     1073      )  return RTEMS.Status_Codes;
     1074      pragma Import (C, Message_Queue_Urgent_Base,
     1075         "rtems_message_queue_urgent");
     1076   begin
     1077 
     1078      Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
     1079
     1080   end Message_Queue_Urgent;
     1081 
     1082   procedure Message_Queue_Broadcast (
     1083      ID     : in     RTEMS.ID;
     1084      Buffer : in     RTEMS.Address;
     1085      Size   : in     RTEMS.Unsigned32;
     1086      Count  :    out RTEMS.Unsigned32;
     1087      Result :    out RTEMS.Status_Codes
     1088   ) is
     1089      function Message_Queue_Broadcast_Base (
     1090         ID     : RTEMS.ID;
     1091         Buffer : RTEMS.Address;
     1092         Size   : RTEMS.Unsigned32;
     1093         Count  : access RTEMS.Unsigned32
     1094      )  return RTEMS.Status_Codes;
     1095      pragma Import (C, Message_Queue_Broadcast_Base,
     1096         "rtems_message_queue_broadcast");
     1097      Count_Base : aliased RTEMS.Unsigned32;
     1098   begin
     1099 
     1100      Result := Message_Queue_Broadcast_Base (
     1101         ID,
     1102         Buffer,
     1103         Size,
     1104         Count_Base'Unchecked_Access
     1105      );
     1106      Count := Count_Base;
     1107
     1108   end Message_Queue_Broadcast;
     1109 
     1110   procedure Message_Queue_Receive (
     1111      ID         : in     RTEMS.ID;
     1112      Buffer     : in     RTEMS.Address;
     1113      Option_Set : in     RTEMS.Option;
     1114      Timeout    : in     RTEMS.Interval;
     1115      Size       :    out RTEMS.Unsigned32;
     1116      Result     :    out RTEMS.Status_Codes
     1117   ) is
     1118      function Message_Queue_Receive_Base (
     1119         ID         : RTEMS.ID;
     1120         Buffer     : RTEMS.Address;
     1121         Size       : access RTEMS.Unsigned32;
     1122         Option_Set : RTEMS.Option;
     1123         Timeout    : RTEMS.Interval
     1124      )  return RTEMS.Status_Codes;
     1125      pragma Import (C, Message_Queue_Receive_Base,
     1126         "rtems_message_queue_receive");
     1127      Size_Base : aliased RTEMS.Unsigned32;
     1128   begin
     1129 
     1130      Result := Message_Queue_Receive_Base (
     1131         ID,
     1132         Buffer,
     1133         Size_Base'Unchecked_Access,
     1134         Option_Set,
     1135         Timeout
     1136      );
     1137      Size := Size_Base;
     1138
     1139   end Message_Queue_Receive;
     1140 
     1141   procedure Message_Queue_Get_Number_Pending (
     1142      ID     : in     RTEMS.ID;
     1143      Count  :    out RTEMS.Unsigned32;
     1144      Result :    out RTEMS.Status_Codes
     1145   ) is
     1146      function Message_Queue_Get_Number_Pending_Base (
     1147         ID    : RTEMS.ID;
     1148         Count : access RTEMS.Unsigned32
     1149      )  return RTEMS.Status_Codes;
     1150      pragma Import (
     1151         C,
     1152         Message_Queue_Get_Number_Pending_Base,
     1153         "rtems_message_queue_get_number_pending"
     1154      );
     1155      COUNT_Base : aliased RTEMS.Unsigned32;
     1156   begin
     1157 
     1158      Result := Message_Queue_Get_Number_Pending_Base (
     1159         ID, COUNT_Base'Unchecked_Access
     1160      );
     1161      Count := COUNT_Base;
     1162
     1163   end Message_Queue_Get_Number_Pending;
     1164 
     1165   procedure Message_Queue_Flush (
     1166      ID     : in     RTEMS.ID;
     1167      Count  :    out RTEMS.Unsigned32;
     1168      Result :    out RTEMS.Status_Codes
     1169   ) is
     1170      function Message_Queue_Flush_Base (
     1171         ID    : RTEMS.ID;
     1172         Count : access RTEMS.Unsigned32
     1173      )  return RTEMS.Status_Codes;
     1174      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
     1175      COUNT_Base : aliased RTEMS.Unsigned32;
     1176   begin
     1177 
     1178      Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
     1179      Count := COUNT_Base;
     1180
     1181   end Message_Queue_Flush;
     1182 
     1183   --
     1184   -- Event Manager
     1185   --
     1186
     1187   procedure Event_Send (
     1188      ID       : in     RTEMS.ID;
     1189      Event_In : in     RTEMS.Event_Set;
     1190      Result   :    out RTEMS.Status_Codes
     1191   ) is
     1192      function Event_Send_Base (
     1193         ID       : RTEMS.ID;
     1194         Event_In : RTEMS.Event_Set
     1195      )  return RTEMS.Status_Codes;
     1196      pragma Import (C, Event_Send_Base, "rtems_event_send");
     1197   begin
     1198
     1199      Result := Event_Send_Base ( ID, Event_In );
     1200
     1201   end Event_Send;
     1202
     1203   procedure Event_Receive (
     1204      Event_In   : in     RTEMS.Event_Set;
     1205      Option_Set : in     RTEMS.Option;
     1206      Ticks      : in     RTEMS.Interval;
     1207      Event_Out  :    out RTEMS.Event_Set;
     1208      Result     :    out RTEMS.Status_Codes
     1209   ) is
     1210      function Event_Receive_Base (
     1211         Event_In   : RTEMS.Event_Set;
     1212         Option_Set : RTEMS.Option;
     1213         Ticks      : RTEMS.Interval;
     1214         Event_Out  : access RTEMS.Event_Set
     1215      )  return RTEMS.Status_Codes;
     1216      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
     1217      Event_Out_Base : aliased RTEMS.Event_Set;
     1218   begin
     1219
     1220      Result := Event_Receive_Base (
     1221         Event_In,
     1222         Option_Set,
     1223         Ticks,
     1224         Event_Out_Base'Access
     1225      );
     1226      Event_Out := Event_Out_Base;
     1227
     1228   end Event_Receive;
     1229
     1230   --
     1231   -- Signal Manager
     1232   --
     1233 
     1234   procedure Signal_Catch (
     1235      ASR_Handler : in     RTEMS.ASR_Handler;
     1236      Mode_Set    : in     RTEMS.Mode;
     1237      Result      :    out RTEMS.Status_Codes
     1238   ) is
     1239      function Signal_Catch_Base (
     1240         ASR_Handler : RTEMS.ASR_Handler;
     1241         Mode_Set    : RTEMS.Mode
     1242      )  return RTEMS.Status_Codes;
     1243      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
     1244   begin
     1245
     1246      Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
     1247
     1248   end Signal_Catch;
     1249 
     1250   procedure Signal_Send (
     1251      ID         : in     RTEMS.ID;
     1252      Signal_Set : in     RTEMS.Signal_Set;
     1253      Result     :    out RTEMS.Status_Codes
     1254   ) is
     1255      function Signal_Send_Base (
     1256         ID         : RTEMS.ID;
     1257         Signal_Set : RTEMS.Signal_Set
     1258      )  return RTEMS.Status_Codes;
     1259      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
     1260   begin
     1261 
     1262      Result := Signal_Send_Base ( ID, Signal_Set );
     1263
     1264   end Signal_Send;
     1265 
     1266 
     1267   --
     1268   -- Partition Manager
     1269   --
     1270 
     1271   procedure Partition_Create (
     1272      Name             : in     RTEMS.Name;
     1273      Starting_Address : in     RTEMS.Address;
     1274      Length           : in     RTEMS.Unsigned32;
     1275      Buffer_Size      : in     RTEMS.Unsigned32;
     1276      Attribute_Set    : in     RTEMS.Attribute;
     1277      ID               :    out RTEMS.ID;
     1278      Result           :    out RTEMS.Status_Codes
     1279   ) is
     1280      function Partition_Create_Base (
     1281         Name             : RTEMS.Name;
     1282         Starting_Address : RTEMS.Address;
     1283         Length           : RTEMS.Unsigned32;
     1284         Buffer_Size      : RTEMS.Unsigned32;
     1285         Attribute_Set    : RTEMS.Attribute;
     1286         ID               : access RTEMS.Event_Set
     1287      )  return RTEMS.Status_Codes;
     1288      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
     1289      ID_Base : aliased RTEMS.ID;
     1290   begin
     1291 
     1292      Result := Partition_Create_Base (
     1293         Name,
     1294         Starting_Address,
     1295         Length,
     1296         Buffer_Size,
     1297         Attribute_Set,
     1298         ID_Base'Unchecked_Access
     1299      );
     1300      ID := ID_Base;
     1301 
     1302   end Partition_Create;
     1303 
     1304   procedure Partition_Ident (
     1305      Name   : in     RTEMS.Name;
     1306      Node   : in     RTEMS.Unsigned32;
     1307      ID     :    out RTEMS.ID;
     1308      Result :    out RTEMS.Status_Codes
     1309   ) is
     1310      function Partition_Ident_Base (
     1311         Name : RTEMS.Name;
     1312         Node : RTEMS.Unsigned32;
     1313         ID   : access RTEMS.Event_Set
     1314      )  return RTEMS.Status_Codes;
     1315      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
     1316      ID_Base : aliased RTEMS.ID;
     1317   begin
     1318 
     1319      Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
     1320      ID := ID_Base;
     1321
     1322   end Partition_Ident;
     1323 
     1324   procedure Partition_Delete (
     1325      ID     : in     RTEMS.ID;
     1326      Result :    out RTEMS.Status_Codes
     1327   ) is
     1328      function Partition_Delete_Base (
     1329         ID : RTEMS.ID
     1330      )  return RTEMS.Status_Codes;
     1331      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
     1332   begin
     1333 
     1334      Result := Partition_Delete_Base ( ID );
     1335
     1336   end Partition_Delete;
     1337 
     1338   procedure Partition_Get_Buffer (
     1339      ID     : in     RTEMS.ID;
     1340      Buffer :    out RTEMS.Address;
     1341      Result :    out RTEMS.Status_Codes
     1342   ) is
     1343      function Partition_Get_Buffer_Base (
     1344         ID     : RTEMS.ID;
     1345         Buffer : access RTEMS.Address
     1346      )  return RTEMS.Status_Codes;
     1347      pragma Import (C, Partition_Get_Buffer_Base,
     1348         "rtems_partition_get_buffer");
     1349      Buffer_Base : aliased RTEMS.Address;
     1350   begin
     1351 
     1352      Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
     1353      Buffer := Buffer_Base;
     1354
     1355   end Partition_Get_Buffer;
     1356 
     1357   procedure Partition_Return_Buffer (
     1358      ID     : in     RTEMS.ID;
     1359      Buffer : in     RTEMS.Address;
     1360      Result :    out RTEMS.Status_Codes
     1361   ) is
     1362      function Partition_Return_Buffer_Base (
     1363         ID     : RTEMS.Name;
     1364         Buffer : RTEMS.Address
     1365      )  return RTEMS.Status_Codes;
     1366      pragma Import (C, Partition_Return_Buffer_Base,
     1367         "rtems_partition_return_buffer");
     1368   begin
     1369 
     1370      Result := Partition_Return_Buffer_Base ( ID, Buffer );
     1371
     1372   end Partition_Return_Buffer;
     1373
     1374   --
     1375   -- Region Manager
     1376   --
     1377 
     1378   procedure Region_Create (
     1379      Name             : in     RTEMS.Name;
     1380      Starting_Address : in     RTEMS.Address;
     1381      Length           : in     RTEMS.Unsigned32;
     1382      Page_Size        : in     RTEMS.Unsigned32;
     1383      Attribute_Set    : in     RTEMS.Attribute;
     1384      ID               :    out RTEMS.ID;
     1385      Result           :    out RTEMS.Status_Codes
     1386   ) is
     1387      function Region_Create_Base (
     1388         Name             : RTEMS.Name;
     1389         Starting_Address : RTEMS.Address;
     1390         Length           : RTEMS.Unsigned32;
     1391         Page_Size        : RTEMS.Unsigned32;
     1392         Attribute_Set    : RTEMS.Attribute;
     1393         ID               : access RTEMS.ID
     1394      )  return RTEMS.Status_Codes;
     1395      pragma Import (C, Region_Create_Base, "rtems_region_create");
     1396      ID_Base : aliased RTEMS.ID;
     1397   begin
     1398 
     1399      Result := Region_Create_Base (
     1400         Name,
     1401         Starting_Address,
     1402         Length,
     1403         Page_Size,
     1404         Attribute_Set,
     1405         ID_Base'Unchecked_Access
     1406      );
     1407      ID := ID_Base;
     1408
     1409   end Region_Create;
     1410 
     1411   procedure Region_Ident (
     1412      Name   : in     RTEMS.Name;
     1413      ID     :    out RTEMS.ID;
     1414      Result :    out RTEMS.Status_Codes
     1415   ) is
     1416      function Region_Ident_Base (
     1417         Name   : RTEMS.Name;
     1418         ID     : access RTEMS.ID
     1419      )  return RTEMS.Status_Codes;
     1420      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
     1421      ID_Base : aliased RTEMS.ID;
     1422   begin
     1423 
     1424      Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
     1425      ID := ID_Base;
     1426
     1427   end Region_Ident;
     1428 
     1429   procedure Region_Delete (
     1430      ID     : in     RTEMS.ID;
     1431      Result :    out RTEMS.Status_Codes
     1432   ) is
     1433      function Region_Delete_Base (
     1434         ID : RTEMS.ID
     1435      )  return RTEMS.Status_Codes;
     1436      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
     1437   begin
     1438 
     1439      Result := Region_Delete_Base ( ID );
     1440
     1441   end Region_Delete;
     1442 
     1443   procedure Region_Extend (
     1444      ID               : in     RTEMS.ID;
     1445      Starting_Address : in     RTEMS.Address;
     1446      Length           : in     RTEMS.Unsigned32;
     1447      Result           :    out RTEMS.Status_Codes
     1448   ) is
     1449      function Region_Extend_Base (
     1450         ID               : RTEMS.ID;
     1451         Starting_Address : RTEMS.Address;
     1452         Length           : RTEMS.Unsigned32
     1453      )  return RTEMS.Status_Codes;
     1454      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
     1455   begin
     1456 
     1457      Result := Region_Extend_Base ( ID, Starting_Address, Length );
     1458
     1459   end Region_Extend;
     1460 
     1461   procedure Region_Get_Segment (
     1462      ID         : in     RTEMS.ID;
     1463      Size       : in     RTEMS.Unsigned32;
     1464      Option_Set : in     RTEMS.Option;
     1465      Timeout    : in     RTEMS.Interval;
     1466      Segment    :    out RTEMS.Address;
     1467      Result     :    out RTEMS.Status_Codes
     1468   ) is
     1469      function Region_Get_Segment_Base (
     1470         ID         : RTEMS.ID;
     1471         Size       : RTEMS.Unsigned32;
     1472         Option_Set : RTEMS.Option;
     1473         Timeout    : RTEMS.Interval;
     1474         Segment    : access RTEMS.Address
     1475      )  return RTEMS.Status_Codes;
     1476      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
     1477      Segment_Base : aliased RTEMS.Address;
     1478   begin
     1479 
     1480      Result := Region_Get_Segment_Base (
     1481         ID,
     1482         Size,
     1483         Option_Set,
     1484         Timeout,
     1485         Segment_Base'Unchecked_Access
     1486      );
     1487      Segment := SEGMENT_Base;
     1488
     1489   end Region_Get_Segment;
     1490 
     1491   procedure Region_Get_Segment_Size (
     1492      ID      : in     RTEMS.ID;
     1493      Segment : in     RTEMS.Address;
     1494      Size    :    out RTEMS.Unsigned32;
     1495      Result  :    out RTEMS.Status_Codes
     1496   ) is
     1497      function Region_Get_Segment_Size_Base (
     1498         ID      : RTEMS.ID;
     1499         Segment : RTEMS.Address;
     1500         Size    : access RTEMS.Unsigned32
     1501      )  return RTEMS.Status_Codes;
     1502      pragma Import (C, Region_Get_Segment_Size_Base,
     1503         "rtems_region_get_segment_size");
     1504      Size_Base : aliased RTEMS.Unsigned32;
     1505   begin
     1506 
     1507      Result := Region_Get_Segment_Size_Base (
     1508         ID,
     1509         Segment,
     1510         Size_Base'Unchecked_Access
     1511      );
     1512      Size := SIZE_Base;
     1513
     1514   end Region_Get_Segment_Size;
     1515 
     1516   procedure Region_Return_Segment (
     1517      ID      : in     RTEMS.ID;
     1518      Segment : in     RTEMS.Address;
     1519      Result  :    out RTEMS.Status_Codes
     1520   ) is
     1521      function Region_Return_Segment_Base (
     1522         ID      : RTEMS.ID;
     1523         Segment : RTEMS.Address
     1524      )  return RTEMS.Status_Codes;
     1525      pragma Import (C, Region_Return_Segment_Base,
     1526         "rtems_region_return_segment");
     1527   begin
     1528 
     1529      Result := Region_Return_Segment_Base ( ID, Segment );
     1530
     1531   end Region_Return_Segment;
     1532 
     1533   procedure Region_Resize_Segment (
     1534      ID         : in     RTEMS.ID;
     1535      Segment    : in     RTEMS.Address;
     1536      Size       : in     RTEMS.Unsigned32;
     1537      Old_Size   :    out RTEMS.Unsigned32;
     1538      Result     :    out RTEMS.Status_Codes
     1539   ) is
     1540      function Region_Resize_Segment_Base (
     1541         ID       : RTEMS.ID;
     1542         Segment  : RTEMS.Address;
     1543         Size     : RTEMS.Unsigned32;
     1544         Old_Size : access RTEMS.Unsigned32
     1545      )  return RTEMS.Status_Codes;
     1546      pragma Import (C, Region_Resize_Segment_Base,
     1547         "rtems_region_resize_segment");
     1548      Old_Size_Base : aliased RTEMS.Unsigned32;
     1549   begin
     1550 
     1551      Result := Region_Resize_Segment_Base (
     1552         ID,
     1553         Segment,
     1554         Size,
     1555         Old_Size_Base'Unchecked_Access
     1556      );
     1557      Old_Size := Old_Size_Base;
     1558
     1559   end Region_Resize_Segment;
     1560
     1561   --
     1562   -- Dual Ported Memory Manager
     1563   --
     1564 
     1565   procedure Port_Create (
     1566      Name           : in     RTEMS.Name;
     1567      Internal_Start : in     RTEMS.Address;
     1568      External_Start : in     RTEMS.Address;
     1569      Length         : in     RTEMS.Unsigned32;
     1570      ID             :    out RTEMS.ID;
     1571      Result         :    out RTEMS.Status_Codes
     1572   ) is
     1573      function Port_Create_Base (
     1574         Name           : RTEMS.Name;
     1575         Internal_Start : RTEMS.Address;
     1576         External_Start : RTEMS.Address;
     1577         Length         : RTEMS.Unsigned32;
     1578         ID             : access RTEMS.ID
     1579      )  return RTEMS.Status_Codes;
     1580      pragma Import (C, Port_Create_Base, "rtems_port_create");
     1581      ID_Base : aliased RTEMS.ID;
     1582   begin
     1583 
     1584      Result := Port_Create_Base (
     1585         Name,
     1586         Internal_Start,
     1587         External_Start,
     1588         Length,
     1589         ID_Base'Unchecked_Access
     1590      );
     1591      ID := ID_Base;
     1592
     1593   end Port_Create;
     1594 
     1595   procedure Port_Ident (
     1596      Name   : in     RTEMS.Name;
     1597      ID     :    out RTEMS.ID;
     1598      Result :    out RTEMS.Status_Codes
     1599   ) is
     1600      function Port_Ident_Base (
     1601         Name : RTEMS.Name;
     1602         ID   : access RTEMS.ID
     1603      )  return RTEMS.Status_Codes;
     1604      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
     1605      ID_Base : aliased RTEMS.ID;
     1606   begin
     1607 
     1608      Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
     1609      ID := ID_Base;
     1610
     1611   end Port_Ident;
     1612 
     1613   procedure Port_Delete (
     1614      ID     : in     RTEMS.ID;
     1615      Result :    out RTEMS.Status_Codes
     1616   ) is
     1617      function Port_Delete_Base (
     1618         ID : RTEMS.ID
     1619      )  return RTEMS.Status_Codes;
     1620      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
     1621   begin
     1622 
     1623      Result := Port_Delete_Base ( ID );
     1624
     1625   end Port_Delete;
     1626 
     1627   procedure Port_External_To_Internal (
     1628      ID       : in     RTEMS.ID;
     1629      External : in     RTEMS.Address;
     1630      Internal :    out RTEMS.Address;
     1631      Result   :    out RTEMS.Status_Codes
     1632   ) is
     1633      function Port_External_To_Internal_Base (
     1634         ID       : RTEMS.ID;
     1635         External : RTEMS.Address;
     1636         Internal : access RTEMS.Address
     1637      )  return RTEMS.Status_Codes;
     1638      pragma Import (C, Port_External_To_Internal_Base,
     1639         "rtems_port_external_to_internal");
     1640      Internal_Base : aliased RTEMS.Address;
     1641   begin
     1642 
     1643      Result := Port_External_To_Internal_Base (
     1644         ID,
     1645         External,
     1646         Internal_Base'Unchecked_Access
     1647      );
     1648      Internal := INTERNAL_Base;
     1649
     1650   end Port_External_To_Internal;
     1651 
     1652   procedure Port_Internal_To_External (
     1653      ID       : in     RTEMS.ID;
     1654      Internal : in     RTEMS.Address;
     1655      External :    out RTEMS.Address;
     1656      Result   :    out RTEMS.Status_Codes
     1657   ) is
     1658      function Port_Internal_To_External_Base (
     1659         ID       : RTEMS.ID;
     1660         Internal : RTEMS.Address;
     1661         External : access RTEMS.Address
     1662      )  return RTEMS.Status_Codes;
     1663      pragma Import (C, Port_Internal_To_External_Base,
     1664         "rtems_port_internal_to_external");
     1665      External_Base : aliased RTEMS.Address;
     1666   begin
     1667 
     1668      Result := Port_Internal_To_External_Base (
     1669         ID,
     1670         Internal,
     1671         External_Base'Unchecked_Access
     1672      );
     1673      External := EXTERNAL_Base;
     1674
     1675   end Port_Internal_To_External;
     1676 
     1677 
     1678   --
     1679   -- Fatal Error Manager
     1680   --
     1681 
     1682   procedure Fatal_Error_Occurred (
     1683      The_Error : in     RTEMS.Unsigned32
     1684   ) is
     1685      procedure Fatal_Error_Occurred_Base (
     1686         The_Error : RTEMS.Unsigned32
     1687      );
     1688   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
     1689   begin
     1690 
     1691      Fatal_Error_Occurred_Base ( The_Error );
     1692
     1693   end Fatal_Error_Occurred;
     1694
     1695
     1696   --
     1697   -- Rate Monotonic Manager
     1698   --
     1699 
     1700   procedure Rate_Monotonic_Create (
     1701      Name   : in     RTEMS.Name;
     1702      ID     :    out RTEMS.ID;
     1703      Result :    out RTEMS.Status_Codes
     1704   ) is
     1705      function Rate_Monotonic_Create_Base (
     1706         Name   : RTEMS.Name;
     1707         ID     : access RTEMS.ID
     1708      )  return RTEMS.Status_Codes;
     1709      pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create");
     1710      ID_Base : aliased RTEMS.ID;
     1711   begin
     1712 
     1713      Result := Rate_Monotonic_Create_Base ( Name, ID_Base'Unchecked_Access );
     1714      ID := ID_Base;
     1715
     1716   end Rate_Monotonic_Create;
     1717 
     1718   procedure Rate_Monotonic_Ident (
     1719      Name   : in     RTEMS.Name;
     1720      ID     :    out RTEMS.ID;
     1721      Result :    out RTEMS.Status_Codes
     1722   ) is
     1723      function Rate_Monotonic_Ident_Base (
     1724         Name   : RTEMS.Name;
     1725         ID     : access RTEMS.ID
     1726      )  return RTEMS.Status_Codes;
     1727      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
     1728      ID_Base : aliased RTEMS.ID;
     1729   begin
     1730 
     1731      Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
     1732 
     1733      ID := ID_Base;
     1734
     1735   end Rate_Monotonic_Ident;
     1736 
     1737   procedure Rate_Monotonic_Delete (
     1738      ID     : in     RTEMS.ID;
     1739      Result :    out RTEMS.Status_Codes
     1740   ) is
     1741      function Rate_Monotonic_Delete_Base (
     1742         ID : RTEMS.ID
     1743      )  return RTEMS.Status_Codes;
     1744      pragma Import (C, Rate_Monotonic_Delete_Base,
     1745         "rtems_rate_monotonic_delete");
     1746   begin
     1747 
     1748      Result := Rate_Monotonic_Delete_Base ( ID );
     1749
     1750   end Rate_Monotonic_Delete;
     1751 
     1752   procedure Rate_Monotonic_Cancel (
     1753      ID     : in     RTEMS.ID;
     1754      Result :    out RTEMS.Status_Codes
     1755   ) is
     1756      function Rate_Monotonic_Cancel_Base (
     1757         ID : RTEMS.ID
     1758      )  return RTEMS.Status_Codes;
     1759      pragma Import (C, Rate_Monotonic_Cancel_Base,
     1760         "rtems_rate_monotonic_cancel");
     1761   begin
     1762 
     1763      Result := Rate_Monotonic_Cancel_Base ( ID );
     1764
     1765   end Rate_Monotonic_Cancel;
     1766 
     1767   procedure Rate_Monotonic_Period (
     1768      ID      : in     RTEMS.ID;
     1769      Length  : in     RTEMS.Interval;
     1770      Result  :    out RTEMS.Status_Codes
     1771   ) is
     1772      function Rate_Monotonic_Period_Base (
     1773         ID     : RTEMS.ID;
     1774         Length : RTEMS.Interval
     1775      )  return RTEMS.Status_Codes;
     1776      pragma Import (C, Rate_Monotonic_Period_Base,
     1777         "rtems_rate_monotonic_period");
     1778   begin
     1779 
     1780      Result := Rate_Monotonic_Period_Base ( ID, Length );
     1781
     1782   end Rate_Monotonic_Period;
     1783 
     1784   procedure Rate_Monotonic_Get_Status (
     1785      ID      : in     RTEMS.ID;
     1786      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
     1787      Result  :    out RTEMS.Status_Codes
     1788   ) is
     1789      function Rate_Monotonic_Get_Status_Base (
     1790         ID      : RTEMS.ID;
     1791         Status  : access RTEMS.Rate_Monotonic_Period_Status
     1792      )  return RTEMS.Status_Codes;
     1793      pragma Import (C, Rate_Monotonic_Get_Status_Base,
     1794         "rtems_rate_monotonic_get_status");
     1795
     1796      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
     1797   begin
     1798
     1799      Result := Rate_Monotonic_Get_Status_Base (
     1800         ID,
     1801         Status_Base'Unchecked_Access
     1802      );
     1803
     1804      Status := Status_Base;
     1805
     1806
     1807   end Rate_Monotonic_Get_Status;
     1808
     1809   procedure Rate_Monotonic_Reset_Statistics (
     1810      ID     : in     RTEMS.ID;
     1811      Result :    out RTEMS.Status_Codes
     1812   ) is
     1813      function Rate_Monotonic_Reset_Statistics_Base (
     1814         ID : RTEMS.ID
     1815      )  return RTEMS.Status_Codes;
     1816      pragma Import (C, Rate_Monotonic_Reset_Statistics_Base,
     1817         "rtems_rate_monotonic_reset_statistics");
     1818   begin
     1819
     1820      Result := Rate_Monotonic_Reset_Statistics_Base ( ID );
     1821
     1822   end Rate_Monotonic_Reset_Statistics;
     1823
     1824
     1825   --
     1826   -- Barrier Manager
     1827   --
     1828
     1829   procedure Barrier_Create (
     1830      Name            : in     RTEMS.Name;
     1831      Attribute_Set   : in     RTEMS.Attribute;
     1832      Maximum_Waiters : in     RTEMS.Unsigned32;
     1833      ID              :    out RTEMS.ID;
     1834      Result          :    out RTEMS.Status_Codes
     1835   ) is
     1836      function Barrier_Create_Base (
     1837         Name            : RTEMS.Name;
     1838         Attribute_Set   : RTEMS.Attribute;
     1839         Maximum_Waiters : RTEMS.Unsigned32;
     1840         ID              : access RTEMS.ID
     1841      )  return RTEMS.Status_Codes;
     1842      pragma Import (C, Barrier_Create_Base, "rtems_barrier_create");
     1843      ID_Base : aliased RTEMS.ID;
     1844   begin
     1845
     1846      Result := Barrier_Create_Base (
     1847         Name,
     1848         Attribute_Set,
     1849         Maximum_Waiters,
     1850         ID_Base'Unchecked_Access
     1851      );
     1852      ID := ID_Base;
     1853
     1854   end Barrier_Create;
     1855
     1856   procedure Barrier_Ident (
     1857      Name   : in     RTEMS.Name;
     1858      ID     :    out RTEMS.ID;
     1859      Result :    out RTEMS.Status_Codes
     1860   ) is
     1861      function Barrier_Ident_Base (
     1862         Name : RTEMS.Name;
     1863         ID   : access RTEMS.ID
     1864      )  return RTEMS.Status_Codes;
     1865      pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident");
     1866      ID_Base : aliased RTEMS.ID;
     1867   begin
     1868
     1869      Result := Barrier_Ident_Base ( Name, ID_Base'Unchecked_Access );
     1870      ID := ID_Base;
     1871
     1872   end Barrier_Ident;
     1873
     1874   procedure Barrier_Delete (
     1875      ID     : in     RTEMS.ID;
     1876      Result :    out RTEMS.Status_Codes
     1877   ) is
     1878      function Barrier_Delete_Base (
     1879         ID : RTEMS.ID
     1880      )  return RTEMS.Status_Codes;
     1881      pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
     1882   begin
     1883
     1884      Result := Barrier_Delete_Base ( ID );
     1885
     1886   end Barrier_Delete;
     1887
     1888   procedure Barrier_Wait (
     1889      ID         : in     RTEMS.ID;
     1890      Timeout    : in     RTEMS.Interval;
     1891      Result     :    out RTEMS.Status_Codes
     1892   ) is
     1893      function Barrier_Wait_Base (
     1894         ID         : RTEMS.ID;
     1895         Timeout    : RTEMS.Interval
     1896      )  return RTEMS.Status_Codes;
     1897      pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
     1898   begin
     1899
     1900      Result := Barrier_Wait_Base ( ID, Timeout );
     1901
     1902   end Barrier_Wait;
     1903
     1904   procedure Barrier_Release (
     1905      ID       : in     RTEMS.ID;
     1906      Released :    out RTEMS.Unsigned32;
     1907      Result   :    out RTEMS.Status_Codes
     1908   ) is
     1909      function Barrier_Release_Base (
     1910         ID       : RTEMS.ID;
     1911         Released : access RTEMS.Unsigned32
     1912      )  return RTEMS.Status_Codes;
     1913      pragma Import (C, Barrier_Release_Base, "rtems_barrier_release");
     1914      Released_Base : aliased RTEMS.Unsigned32;
     1915   begin
     1916
     1917      Result := Barrier_Release_Base ( ID, Released_Base'Unchecked_Access );
     1918      Released := Released_Base;
     1919
     1920   end Barrier_Release;
     1921
     1922 
     1923   --
     1924   -- Debug Manager
     1925   --
     1926 
     1927   procedure Debug_Enable (
     1928      To_Be_Enabled : in     RTEMS.Debug_Set
     1929   ) is
     1930      procedure Debug_Enable_Base (
     1931         To_Be_Enabled : RTEMS.Debug_Set
     1932      );
     1933   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
     1934   begin
     1935 
     1936      Debug_Enable_Base ( To_Be_Enabled );
     1937
     1938   end Debug_Enable;
     1939 
     1940   procedure Debug_Disable (
     1941      To_Be_Disabled : in     RTEMS.Debug_Set
     1942   ) is
     1943      procedure Debug_Disable_Base (
     1944         To_Be_Disabled : RTEMS.Debug_Set
     1945      );
     1946   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
     1947   begin
     1948 
     1949      Debug_Disable_Base ( To_Be_Disabled );
     1950
     1951   end Debug_Disable;
     1952 
     1953   function Debug_Is_Enabled (
     1954      Level : in     RTEMS.Debug_Set
     1955   ) return RTEMS.Boolean is
     1956      function Debug_Is_Enabled_Base (
     1957         Level : RTEMS.Debug_Set
     1958      )  return RTEMS.Boolean;
     1959      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
     1960   begin
     1961 
     1962      return Debug_Is_Enabled_Base ( Level );
     1963
     1964   end Debug_Is_Enabled;
     1965
     1966   --
     1967   --  Object Services
     1968   --
    891969
    901970   function Build_Name (
     
    1121992   end Build_Name;
    1131993
    114    procedure Name_To_Characters (
    115       Name : in     RTEMS.Name;
    116       C1   :    out Character;
    117       C2   :    out Character;
    118       C3   :    out Character;
    119       C4   :    out Character
    120    ) is
    121       C1_Value : RTEMS.Unsigned32;
    122       C2_Value : RTEMS.Unsigned32;
    123       C3_Value : RTEMS.Unsigned32;
    124       C4_Value : RTEMS.Unsigned32;
    125    begin
    126 
    127      C1_Value := Interfaces.Shift_Right( Name, 24 );
    128      C2_Value := Interfaces.Shift_Right( Name, 16 );
    129      C3_Value := Interfaces.Shift_Right( Name, 8 );
    130      C4_Value := Name;
    131 
    132      C1_Value := C1_Value and 16#00FF#;
    133      C2_Value := C2_Value and 16#00FF#;
    134      C3_Value := C3_Value and 16#00FF#;
    135      C4_Value := C4_Value and 16#00FF#;
    136 
    137      C1 := Character'Val( C1_Value );
    138      C2 := Character'Val( C2_Value );
    139      C3 := Character'Val( C3_Value );
    140      C4 := Character'Val( C4_Value );
    141 
    142    end Name_To_Characters;
    143 
    144    function Get_Node (
    145       ID : in     RTEMS.ID
    146    ) return RTEMS.Unsigned32 is
    147    begin
    148 
    149       -- May not be right
    150       return Interfaces.Shift_Right( ID, 16 );
    151 
    152    end Get_Node;
    153 
    154    function Get_Index (
    155       ID : in     RTEMS.ID
    156    ) return RTEMS.Unsigned32 is
    157    begin
    158 
    159       -- May not be right
    160       return ID and 16#FFFF#;
    161 
    162    end Get_Index;
    163 
    164    function Are_Statuses_Equal (
    165       Status  : in     RTEMS.Status_Codes;
    166       Desired : in     RTEMS.Status_Codes
    167    ) return Standard.Boolean is
    168    begin
    169 
    170       if Status = Desired then
    171          return Standard.True;
    172       end if;
    173 
    174       return Standard.False;
    175 
    176    end Are_Statuses_Equal;
    177 
    178    function Is_Status_Successful (
    179       Status  : in     RTEMS.Status_Codes
    180    ) return Standard.Boolean is
    181    begin
    182 
    183       if Status = RTEMS.Successful then
    184          return Standard.True;
    185       end if;
    186 
    187       return Standard.False;
    188 
    189    end Is_Status_Successful;
    190 
    191    function Subtract (
    192       Left   : in     RTEMS.Address;
    193       Right  : in     RTEMS.Address
    194    ) return RTEMS.Unsigned32 is
    195       function To_Unsigned32 is
    196          new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
    197 
    198    begin
    199       return To_Unsigned32(Left) - To_Unsigned32(Right);
    200    end Subtract;
    201 
    202    function Are_Equal (
    203       Left   : in     RTEMS.Address;
    204       Right  : in     RTEMS.Address
    205    ) return Standard.Boolean is
    206       function To_Unsigned32 is
    207          new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
    208 
    209    begin
    210       return (To_Unsigned32(Left) = To_Unsigned32(Right));
    211    end Are_Equal;
    212 
    213    --
    214    --
    215    --  RTEMS API
    216    --
    217 
    218    --
    219    --  Initialization Manager -- Shutdown Only
    220    --
    221    procedure Shutdown_Executive (
    222       Status           : in     RTEMS.Unsigned32
    223    ) is
    224       procedure Shutdown_Executive_Base (
    225          Status : RTEMS.Unsigned32
    226       );
    227       pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
    228    begin
    229       Shutdown_Executive_Base (Status);
    230    end Shutdown_Executive;
    231  
    232 
    233    --
    234    --  Task Manager
    235    --
    236 
    237    procedure Task_Create (
    238       Name             : in     RTEMS.Name;
    239       Initial_Priority : in     RTEMS.Task_Priority;
    240       Stack_Size       : in     RTEMS.Unsigned32;
    241       Initial_Modes    : in     RTEMS.Mode;
    242       Attribute_Set    : in     RTEMS.Attribute;
    243       ID               :    out RTEMS.ID;
    244       Result           :    out RTEMS.Status_Codes
    245    ) is
    246       function Task_Create_Base (
    247          Name             : RTEMS.Name;
    248          Initial_Priority : RTEMS.Task_Priority;
    249          Stack_Size       : RTEMS.Unsigned32;
    250          Initial_Modes    : RTEMS.Mode;
    251          Attribute_Set    : RTEMS.Attribute;
    252          ID               : access RTEMS.ID
    253       )  return RTEMS.Status_Codes;
    254       pragma Import (C, Task_Create_Base, "rtems_task_create");
    255       ID_Base : aliased RTEMS.ID;
    256    begin
    257       Result := Task_Create_Base (
    258         Name,
    259         Initial_Priority,
    260         Stack_Size,
    261         Initial_Modes,
    262         Attribute_Set,
    263         ID_Base'Unchecked_Access
    264       );
    265       ID := ID_Base;
    266    end Task_Create;
    267 
    268    procedure Task_Ident (
    269       Name             : in     RTEMS.Name;
    270       Node             : in     RTEMS.Node;
    271       ID               :    out RTEMS.ID;
    272       Result           :    out RTEMS.Status_Codes
    273    ) is
    274 
    275       function Task_Ident_Base (
    276          Name             : RTEMS.Name;
    277          Node             : RTEMS.Node;
    278          ID               : access RTEMS.ID
    279       )  return RTEMS.Status_Codes;
    280       pragma Import (C, Task_Ident_Base, "rtems_task_ident");
    281       ID_Base     : aliased RTEMS.ID;
    282 
    283    begin
    284 
    285       Result := Task_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
    286       ID := ID_Base;
    287 
    288    end Task_Ident;
    289 
    290    procedure Task_Start (
    291       ID          : in     RTEMS.ID;
    292       Entry_Point : in     RTEMS.Task_Entry;
    293       Argument    : in     RTEMS.Task_Argument;
    294       Result      :    out RTEMS.Status_Codes
    295    ) is
    296       function Task_Start_Base (
    297          ID          : RTEMS.ID;
    298          Entry_Point : RTEMS.Task_Entry;
    299          Argument    : RTEMS.Task_Argument
    300       )  return RTEMS.Status_Codes;
    301       pragma Import (C, Task_Start_Base, "rtems_task_start");
    302    begin
    303 
    304       Result := Task_Start_Base ( ID, Entry_Point, Argument );
    305 
    306    end Task_Start;
    307 
    308    procedure Task_Restart (
    309       ID       : in     RTEMS.ID;
    310       Argument : in     RTEMS.Task_Argument;
    311       Result   :    out RTEMS.Status_Codes
    312    ) is
    313       function Task_Restart_Base (
    314          ID       : RTEMS.ID;
    315          Argument : RTEMS.Task_Argument
    316       )  return RTEMS.Status_Codes;
    317       pragma Import (C, Task_Restart_Base, "rtems_task_restart");
    318    begin
    319 
    320       Result := Task_Restart_Base ( ID, Argument );
    321  
    322    end Task_Restart;
    323  
    324    procedure Task_Delete (
    325       ID     : in     RTEMS.ID;
    326       Result :    out RTEMS.Status_Codes
    327    ) is
    328       function Task_Delete_Base (
     1994   procedure Object_Get_Classic_Name(
     1995      ID     : in     RTEMS.ID;
     1996      Name   :    out RTEMS.Name;
     1997      Result :    out RTEMS.Status_Codes
     1998   ) is
     1999      function Object_Get_Classic_Name_Base (
     2000         ID   : RTEMS.ID;
     2001         Name : access RTEMS.Name
     2002      )  return RTEMS.Status_Codes;
     2003      pragma Import
     2004         (C, Object_Get_Classic_Name_Base, "rtems_object_get_classic_name");
     2005      Tmp_Name : aliased RTEMS.Name;
     2006   begin
     2007      -- TBD
     2008      Result := Object_Get_Classic_Name_Base (ID, Tmp_Name'Access);
     2009      Name := Tmp_Name;
     2010   end Object_Get_Classic_Name;
     2011   
     2012
     2013   procedure Object_Get_Name(
     2014      ID     : in     RTEMS.ID;
     2015      Length : in     RTEMS.Unsigned32;
     2016      Name   :    out String;
     2017      Result :    out RTEMS.Status_Codes
     2018   ) is
     2019      function Object_Get_Name_Base (
     2020         ID     : RTEMS.ID;
     2021         -- Length : RTEMS.Unsigned32:
     2022         -- Name   : chars_ptr;
     2023         Length : RTEMS.Unsigned32
     2024      )  return RTEMS.Status_Codes;
     2025      pragma Import (C, Object_Get_Name_Base, "rtems_object_get_name");
     2026   begin
     2027      -- TBD
     2028      Name := "";
     2029      Result := Object_Get_Name_Base (Id, Length);
     2030   end Object_Get_Name;
     2031
     2032   procedure Object_Set_Name(
     2033      ID     : in     RTEMS.ID;
     2034      Name   : in     String;
     2035      Result :    out RTEMS.Status_Codes
     2036   ) is
     2037      function Object_Set_Name_Base (
     2038         ID     : RTEMS.ID;
     2039         Name   : chars_ptr
     2040      )  return RTEMS.Status_Codes;
     2041      pragma Import (C, Object_Set_Name_Base, "rtems_object_set_name");
     2042      NameAsCString : chars_ptr := New_String(Name);
     2043   begin
     2044      Result := Object_Set_Name_Base (ID, NameAsCString);
     2045   end Object_Set_Name;
     2046
     2047   procedure Object_Id_Get_API(
     2048      ID  : in     RTEMS.ID;
     2049      API :    out RTEMS.Unsigned32
     2050   ) is
     2051      function Object_Id_Get_API_Base (
     2052         ID     : RTEMS.ID
     2053      )  return RTEMS.Unsigned32;
     2054      pragma Import (C, Object_Id_Get_API_Base, "rtems_object_id_get_api");
     2055   begin
     2056      API := Object_Id_Get_API_Base (ID);
     2057   end Object_Id_Get_API;
     2058
     2059   procedure Object_Id_Get_Class(
     2060      ID        : in     RTEMS.ID;
     2061      The_Class :    out RTEMS.Unsigned32
     2062   ) is
     2063      function Object_Id_Get_Class_Base (
    3292064         ID : RTEMS.ID
    330       )  return RTEMS.Status_Codes;
    331       pragma Import (C, Task_Delete_Base, "rtems_task_delete");
    332    begin
    333 
    334       Result := Task_Delete_Base ( ID );
    335  
    336    end Task_Delete;
    337  
    338    procedure Task_Suspend (
    339       ID     : in     RTEMS.ID;
    340       Result :    out RTEMS.Status_Codes
    341    ) is
    342       function Task_Suspend_Base (
    343          ID : RTEMS.ID
    344       )  return RTEMS.Status_Codes;
    345       pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
    346    begin
    347 
    348       Result := Task_Suspend_Base ( ID );
    349  
    350    end Task_Suspend;
    351  
    352    procedure Task_Resume (
    353       ID     : in     RTEMS.ID;
    354       Result :    out RTEMS.Status_Codes
    355    ) is
    356       function Task_Resume_Base (
    357          ID : RTEMS.ID
    358       )  return RTEMS.Status_Codes;
    359       pragma Import (C, Task_Resume_Base, "rtems_task_resume");
    360    begin
    361 
    362       Result := Task_Resume_Base ( ID );
    363 
    364    end Task_Resume;
    365  
    366    procedure Task_Is_Suspended (
    367       ID     : in     RTEMS.ID;
    368       Result :    out RTEMS.Status_Codes
    369    ) is
    370       function Task_Is_Suspended_Base (
    371          ID : RTEMS.ID
    372       )  return RTEMS.Status_Codes;
    373       pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended");
    374    begin
    375 
    376       Result := Task_Is_Suspended_Base ( ID );
    377 
    378    end Task_Is_Suspended;
    379  
    380    procedure Task_Set_Priority (
    381       ID           : in     RTEMS.ID;
    382       New_Priority : in     RTEMS.Task_Priority;
    383       Old_Priority :    out RTEMS.Task_Priority;
    384       Result       :    out RTEMS.Status_Codes
    385    ) is
    386       function Task_Set_Priority_Base (
    387          ID           : RTEMS.ID;
    388          New_Priority : RTEMS.Task_Priority;
    389          Old_Priority : access RTEMS.Task_Priority
    390       )  return RTEMS.Status_Codes;
    391       pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority");
    392       Old_Priority_Base : aliased RTEMS.Task_Priority;
    393    begin
    394  
    395       Result := Task_Set_Priority_Base (
    396          ID,
    397          New_Priority,
    398          Old_Priority_Base'Unchecked_Access
    399       );
    400       Old_Priority := Old_Priority_Base;
    401 
    402    end Task_Set_Priority;
    403  
    404    procedure Task_Mode (
    405       Mode_Set          : in     RTEMS.Mode;
    406       Mask              : in     RTEMS.Mode;
    407       Previous_Mode_Set :    out RTEMS.Mode;
    408       Result            :    out RTEMS.Status_Codes
    409    ) is
    410       function Task_Mode_Base (
    411          Mode_Set          : RTEMS.Mode;
    412          Mask              : RTEMS.Mode;
    413          Previous_Mode_Set : access RTEMS.Mode
    414       )  return RTEMS.Status_Codes;
    415       pragma Import (C, Task_Mode_Base, "rtems_task_mode");
    416       Previous_Mode_Set_Base : aliased RTEMS.Mode;
    417    begin
    418 
    419       Result := Task_Mode_Base (
    420          Mode_Set,
    421          Mask,
    422          Previous_Mode_Set_Base'Unchecked_Access
    423       );
    424       Previous_Mode_Set := Previous_Mode_Set_Base;
    425 
    426    end Task_Mode;
    427  
    428    procedure Task_Get_Note (
    429       ID      : in     RTEMS.ID;
    430       Notepad : in     RTEMS.Notepad_Index;
    431       Note    :    out RTEMS.Unsigned32;
    432       Result  :    out RTEMS.Status_Codes
    433    ) is
    434       function Task_Get_Note_Base (
    435          ID      : RTEMS.ID;
    436          Notepad : RTEMS.Notepad_Index;
    437          Note    : access RTEMS.Unsigned32
    438       )  return RTEMS.Status_Codes;
    439       pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
    440       Note_Base : aliased RTEMS.Unsigned32;
    441    begin
    442 
    443       Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access );
    444       Note := NOTE_Base;
    445 
    446    end Task_Get_Note;
    447  
    448    procedure Task_Set_Note (
    449       ID      : in     RTEMS.ID;
    450       Notepad : in     RTEMS.Notepad_Index;
    451       Note    : in     RTEMS.Unsigned32;
    452       Result  :    out RTEMS.Status_Codes
    453    ) is
    454       function Task_Set_Note_Base (
    455          ID      : RTEMS.ID;
    456          Notepad : RTEMS.Notepad_Index;
    457          Note    : RTEMS.Unsigned32
    458       )  return RTEMS.Status_Codes;
    459       pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
    460    begin
    461 
    462       Result := Task_Set_Note_Base ( ID, Notepad, Note );
    463 
    464    end Task_Set_Note;
    465  
    466    procedure Task_Variable_Add (
    467       ID            : in     RTEMS.ID;
    468       Task_Variable : in     RTEMS.Address;
    469       Dtor          : in     RTEMS.Task_Variable_Dtor;
    470       Result        :    out RTEMS.Status_Codes
    471    ) is
    472       function Task_Variable_Add_Base (
    473          ID            : RTEMS.ID;
    474          Task_Variable : RTEMS.Address;
    475          Dtor          : RTEMS.Task_Variable_Dtor
    476       )  return RTEMS.Status_Codes;
    477       pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
    478    begin
    479 
    480       Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
    481 
    482    end Task_Variable_Add;
    483 
    484    procedure Task_Variable_Get (
    485       ID                  : in     RTEMS.ID;
    486       Task_Variable       :    out RTEMS.Address;
    487       Task_Variable_Value :    out RTEMS.Address;
    488       Result              :    out RTEMS.Status_Codes
    489    ) is
    490       function Task_Variable_Get_Base (
    491          ID                  : RTEMS.ID;
    492          Task_Variable       : access RTEMS.Address;
    493          Task_Variable_Value : access RTEMS.Address
    494       )  return RTEMS.Status_Codes;
    495       pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
    496       Task_Variable_Base       : aliased RTEMS.Address;
    497       Task_Variable_Value_Base : aliased RTEMS.Address;
    498    begin
    499 
    500       Result := Task_Variable_Get_Base (
    501          ID,
    502          Task_Variable_Base'Unchecked_Access,
    503          Task_Variable_Value_Base'Unchecked_Access
    504       );
    505       Task_Variable := Task_Variable_Base;
    506       Task_Variable_Value := Task_Variable_Value_Base;
    507 
    508    end Task_Variable_Get;
    509 
    510    procedure Task_Variable_Delete (
    511       ID                  : in     RTEMS.ID;
    512       Task_Variable       :    out RTEMS.Address;
    513       Result              :    out RTEMS.Status_Codes
    514    ) is
    515       function Task_Variable_Delete_Base (
    516          ID                  : RTEMS.ID;
    517          Task_Variable       : access RTEMS.Address
    518       )  return RTEMS.Status_Codes;
    519       pragma Import (
    520          C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
    521       );
    522       Task_Variable_Base : aliased RTEMS.Address;
    523    begin
    524 
    525       Result := Task_Variable_Delete_Base (
    526          ID, Task_Variable_Base'Unchecked_Access
    527       );
    528       Task_Variable := Task_Variable_Base;
    529 
    530    end Task_Variable_Delete;
    531 
    532    procedure Task_Wake_When (
    533       Time_Buffer : in     RTEMS.Time_Of_Day;
    534       Result      :    out RTEMS.Status_Codes
    535    ) is
    536       function Task_Wake_When_Base (
    537          Time_Buffer : RTEMS.Time_Of_Day
    538       )  return RTEMS.Status_Codes;
    539       pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
    540    begin
    541 
    542       Result := Task_Wake_When_Base ( Time_Buffer );
    543 
    544    end Task_Wake_When;
    545  
    546    procedure Task_Wake_After (
    547       Ticks  : in     RTEMS.Interval;
    548       Result :    out RTEMS.Status_Codes
    549    ) is
    550       function Task_Wake_After_Base (
    551          Ticks : RTEMS.Interval
    552       )  return RTEMS.Status_Codes;
    553       pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
    554    begin
    555 
    556       Result := Task_Wake_After_Base ( Ticks );
    557 
    558    end Task_Wake_After;
    559  
    560    --
    561    -- Interrupt Manager
    562    --
    563 
    564    -- Interrupt_Disable is interfaced in the specification
    565    -- Interrupt_Enable is interfaced in the specification
    566    -- Interrupt_Flash is interfaced in the specification
    567    -- Interrupt_Is_In_Progress is interfaced in the specification
    568 
    569    --
    570    -- Clock Manager
    571    --
    572  
    573    procedure Clock_Set (
    574       Time_Buffer : in     RTEMS.Time_Of_Day;
    575       Result      :    out RTEMS.Status_Codes
    576    ) is
    577       function Clock_Set_Base (
    578          Time_Buffer : RTEMS.Time_Of_Day
    579       )  return RTEMS.Status_Codes;
    580       pragma Import (C, Clock_Set_Base, "rtems_clock_set");
    581    begin
    582  
    583       Result := Clock_Set_Base ( Time_Buffer );
    584 
    585    end Clock_Set;
    586  
    587    procedure Clock_Get (
    588       Option      : in     RTEMS.Clock_Get_Options;
    589       Time_Buffer : in     RTEMS.Address;
    590       Result      :    out RTEMS.Status_Codes
    591    ) is
    592       function Clock_Get_Base (
    593          Option      : RTEMS.Clock_Get_Options;
    594          Time_Buffer : RTEMS.Address
    595       )  return RTEMS.Status_Codes;
    596       pragma Import (C, Clock_Get_Base, "rtems_clock_get");
    597    begin
    598 
    599       Result := Clock_Get_Base ( Option, Time_Buffer );
    600 
    601    end Clock_Get;
    602  
    603    procedure Clock_Get_Uptime (
    604       Uptime :    out RTEMS.Timespec;
    605       Result :    out RTEMS.Status_Codes
    606    ) is
    607       function Clock_Get_Uptime_Base (
    608          Uptime : access RTEMS.Timespec
    609       )  return RTEMS.Status_Codes;
    610       pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime");
    611       Uptime_Base : aliased RTEMS.Timespec;
    612    begin
    613 
    614       Result := Clock_Get_Uptime_Base (
    615          Uptime_Base'Unchecked_Access
    616       );
    617       Uptime := Uptime_Base;
    618 
    619    end Clock_Get_Uptime;
    620  
    621    procedure Clock_Tick (
    622       Result :    out RTEMS.Status_Codes
    623    ) is
    624       function Clock_Tick_Base return RTEMS.Status_Codes;
    625       pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
    626    begin
    627 
    628       Result := Clock_Tick_Base;
    629 
    630    end Clock_Tick;
    631 
    632    --
    633    -- Extension Manager
    634    --
    635  
    636    procedure Extension_Create (
    637       Name   : in     RTEMS.Name;
    638       Table  : in     RTEMS.Extensions_Table_Pointer;
    639       ID     :    out RTEMS.ID;
    640       Result :    out RTEMS.Status_Codes
    641    ) is
    642       function Extension_Create_Base (
    643          Name   : RTEMS.Name;
    644          Table  : RTEMS.Extensions_Table_Pointer;
    645          ID     : access RTEMS.ID
    646       )  return RTEMS.Status_Codes;
    647       pragma Import (C, Extension_Create_Base, "rtems_extension_create");
    648       ID_Base : aliased RTEMS.ID;
    649    begin
    650  
    651       Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
    652       ID := ID_Base;
    653 
    654    end Extension_Create;
    655  
    656    procedure Extension_Ident (
    657       Name   : in     RTEMS.Name;
    658       ID     :    out RTEMS.ID;
    659       Result :    out RTEMS.Status_Codes
    660    ) is
    661       function Extension_Ident_Base (
    662          Name   : RTEMS.Name;
    663          ID     : access RTEMS.ID
    664       )  return RTEMS.Status_Codes;
    665       pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
    666       ID_Base : aliased RTEMS.ID;
    667    begin
    668  
    669       Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access );
    670       ID := ID_Base;
    671 
    672    end Extension_Ident;
    673  
    674    procedure Extension_Delete (
    675       ID     : in     RTEMS.ID;
    676       Result :    out RTEMS.Status_Codes
    677    ) is
    678       function Extension_Delete_Base (
    679          ID : RTEMS.ID
    680       )  return RTEMS.Status_Codes;
    681       pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
    682    begin
    683  
    684       Result := Extension_Delete_Base ( ID );
    685 
    686    end Extension_Delete;
    687  
    688    --
    689    -- Timer Manager
    690    --
    691  
    692    procedure Timer_Create (
    693       Name   : in     RTEMS.Name;
    694       ID     :    out RTEMS.ID;
    695       Result :    out RTEMS.Status_Codes
    696    ) is
    697       function Timer_Create_Base (
    698          Name   : RTEMS.Name;
    699          ID     : access RTEMS.ID
    700       )  return RTEMS.Status_Codes;
    701       pragma Import (C, Timer_Create_Base, "rtems_timer_create");
    702       ID_Base : aliased RTEMS.ID;
    703    begin
    704  
    705       Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
    706       ID := ID_Base;
    707 
    708    end Timer_Create;
    709  
    710    procedure Timer_Ident (
    711       Name   : in     RTEMS.Name;
    712       ID     :    out RTEMS.ID;
    713       Result :    out RTEMS.Status_Codes
    714    ) is
    715       function Timer_Ident_Base (
    716          Name   : RTEMS.Name;
    717          ID     : access RTEMS.ID
    718       )  return RTEMS.Status_Codes;
    719       pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
    720       ID_Base : aliased RTEMS.ID;
    721    begin
    722  
    723       Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
    724       ID := ID_Base;
    725 
    726    end Timer_Ident;
    727  
    728    procedure Timer_Delete (
    729       ID     : in     RTEMS.ID;
    730       Result :    out RTEMS.Status_Codes
    731    ) is
    732       function Timer_Delete_Base (
    733          ID : RTEMS.ID
    734       )  return RTEMS.Status_Codes;
    735       pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
    736    begin
    737  
    738       Result := Timer_Delete_Base ( ID );
    739 
    740    end Timer_Delete;
    741  
    742    procedure Timer_Fire_After (
    743       ID        : in     RTEMS.ID;
    744       Ticks     : in     RTEMS.Interval;
    745       Routine   : in     RTEMS.Timer_Service_Routine;
    746       User_Data : in     RTEMS.Address;
     2065      )  return RTEMS.Unsigned32;
     2066      pragma Import (C, Object_Id_Get_Class_Base, "rtems_object_id_get_class");
     2067   begin
     2068      The_Class := Object_Id_Get_Class_Base (ID);
     2069   end Object_Id_Get_Class;
     2070
     2071   procedure Object_Id_Get_Node(
     2072      ID   : in     RTEMS.ID;
     2073      Node :    out RTEMS.Unsigned32
     2074   ) is
     2075      function Object_Id_Get_Node_Base (
     2076         ID     : RTEMS.ID
     2077      )  return RTEMS.Unsigned32;
     2078      pragma Import (C, Object_Id_Get_Node_Base, "rtems_object_id_get_node");
     2079   begin
     2080      Node := Object_Id_Get_Node_Base (ID);
     2081   end Object_Id_Get_Node;
     2082
     2083   procedure Object_Id_Get_Index(
     2084      ID    : in     RTEMS.ID;
     2085      Index :    out RTEMS.Unsigned32
     2086   ) is
     2087      function Object_Id_Get_Index_Base (
     2088         ID     : RTEMS.ID
     2089      )  return RTEMS.Unsigned32;
     2090      pragma Import (C, Object_Id_Get_Index_Base, "rtems_object_id_get_index");
     2091   begin
     2092      Index := Object_Id_Get_Index_Base (ID);
     2093   end Object_Id_Get_Index;
     2094
     2095   function Build_Id(
     2096      The_API   : in     RTEMS.Unsigned32;
     2097      The_Class : in     RTEMS.Unsigned32;
     2098      The_Node  : in     RTEMS.Unsigned32;
     2099      The_Index : in     RTEMS.Unsigned32
     2100   ) return RTEMS.Id is
     2101      function Build_Id_Base (
     2102        The_API   : RTEMS.Unsigned32;
     2103        The_Class : RTEMS.Unsigned32;
     2104        The_Node  : RTEMS.Unsigned32;
     2105        The_Index : RTEMS.Unsigned32
     2106      )  return RTEMS.Id;
     2107      pragma Import (C, Build_Id_Base, "rtems_build_id");
     2108   begin
     2109      return Build_Id_Base (The_API, The_Class, The_Node, The_Index);
     2110   end Build_Id;
     2111
     2112   function Object_Id_API_Minimum
     2113   return RTEMS.Unsigned32 is
     2114      function Object_Id_API_Minimum_Base return RTEMS.Unsigned32;
     2115      pragma Import
     2116         (C, Object_Id_API_Minimum_Base, "rtems_object_id_api_minimum");
     2117   begin
     2118      return Object_Id_API_Minimum_Base;
     2119   end Object_Id_API_Minimum;
     2120
     2121   function Object_Id_API_Maximum
     2122   return RTEMS.Unsigned32 is
     2123      function Object_Id_API_Maximum_Base return RTEMS.Unsigned32;
     2124      pragma Import
     2125         (C, Object_Id_API_Maximum_Base, "rtems_object_id_api_maximum");
     2126   begin
     2127      return Object_Id_API_Maximum_Base;
     2128   end Object_Id_API_Maximum;
     2129
     2130   procedure Object_API_Minimum_Class(
     2131      API     : in     RTEMS.Unsigned32;
     2132      Minimum :    out RTEMS.Unsigned32
     2133   ) is
     2134      function  Object_API_Minimum_Class_Base (
     2135         API : RTEMS.Unsigned32
     2136      )  return RTEMS.Unsigned32;
     2137      pragma Import
     2138         (C, Object_API_Minimum_Class_Base, "rtems_object_api_minimum_class");
     2139   begin
     2140      Minimum := Object_API_Minimum_Class_Base (API);
     2141   end Object_API_Minimum_Class;
     2142
     2143   procedure Object_API_Maximum_Class(
     2144      API     : in     RTEMS.Unsigned32;
     2145      Maximum :    out RTEMS.Unsigned32
     2146   ) is
     2147      function  Object_API_Maximum_Class_Base (
     2148         API : RTEMS.Unsigned32
     2149      )  return RTEMS.Unsigned32;
     2150      pragma Import
     2151         (C, Object_API_Maximum_Class_Base, "rtems_object_api_maximum_class");
     2152   begin
     2153      Maximum := Object_API_Maximum_Class_Base (API);
     2154   end Object_API_Maximum_Class;
     2155
     2156   -- Translate S from a C-style char* into an Ada String.
     2157   -- If S is Null_Ptr, return "", don't raise an exception.
     2158   -- Copied from Lovelace Tutorial
     2159   function Value_Without_Exception(S : chars_ptr) return String is
     2160   begin
     2161     if S = Null_Ptr then return "";
     2162      else return Value(S);
     2163     end if;
     2164   end Value_Without_Exception;
     2165   pragma Inline(Value_Without_Exception);
     2166
     2167   procedure Object_Get_API_Name(
     2168      API  : in     RTEMS.Unsigned32;
     2169      Name :    out String
     2170   ) is
     2171      function  Object_Get_API_Name_Base (
     2172        API : RTEMS.Unsigned32
     2173      )  return chars_ptr;
     2174      pragma Import (C, Object_Get_API_Name_Base, "rtems_object_get_api_name");
     2175      Result : chars_ptr := Object_Get_API_Name_Base (API);
     2176      APIName : String :=  Value_Without_Exception (Result);
     2177   begin
     2178      Name := APIName;
     2179   end Object_Get_API_Name;
     2180
     2181   procedure Object_Get_API_Class_Name(
     2182      The_API   : in     RTEMS.Unsigned32;
     2183      The_Class : in     RTEMS.Unsigned32;
     2184      Name      :    out String
     2185   ) is
     2186      function  Object_Get_API_Class_Name_Base (
     2187        API   : RTEMS.Unsigned32;
     2188        Class : RTEMS.Unsigned32
     2189      )  return chars_ptr;
     2190      pragma Import
     2191         (C, Object_Get_API_Class_Name_Base, "rtems_object_get_api_class_name");
     2192      Result : chars_ptr := Object_Get_API_Class_Name_Base (The_API, The_Class);
     2193      ClassName : String :=  Value_Without_Exception (Result);
     2194   begin
     2195      Name := ClassName;
     2196   end Object_Get_API_Class_Name;
     2197
     2198   procedure Object_Get_Class_Information(
     2199      The_API   : in     RTEMS.Unsigned32;
     2200      The_Class : in     RTEMS.Unsigned32;
     2201      Info      :    out RTEMS.Object_API_Class_Information;
    7472202      Result    :    out RTEMS.Status_Codes
    7482203   ) is
    749       function Timer_Fire_After_Base (
    750          ID        : RTEMS.ID;
    751          Ticks     : RTEMS.Interval;
    752          Routine   : RTEMS.Timer_Service_Routine;
    753          User_Data : RTEMS.Address
    754       )  return RTEMS.Status_Codes;
    755       pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
    756    begin
    757  
    758       Result := Timer_Fire_After_Base ( ID, Ticks, Routine, User_Data );
    759 
    760    end Timer_Fire_After;
    761  
    762    procedure Timer_Server_Fire_After (
    763       ID        : in     RTEMS.ID;
    764       Ticks     : in     RTEMS.Interval;
    765       Routine   : in     RTEMS.Timer_Service_Routine;
    766       User_Data : in     RTEMS.Address;
    767       Result    :    out RTEMS.Status_Codes
    768    ) is
    769       function Timer_Server_Fire_After_Base (
    770          ID        : RTEMS.ID;
    771          Ticks     : RTEMS.Interval;
    772          Routine   : RTEMS.Timer_Service_Routine;
    773          User_Data : RTEMS.Address
    774       )  return RTEMS.Status_Codes;
    775       pragma Import (
    776         C,
    777         Timer_Server_Fire_After_Base,
    778         "rtems_timer_server_fire_after"
    779       );
    780    begin
    781  
    782       Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data );
    783 
    784    end Timer_Server_Fire_After;
    785  
    786    procedure Timer_Fire_When (
    787       ID        : in     RTEMS.ID;
    788       Wall_Time : in     RTEMS.Time_Of_Day;
    789       Routine   : in     RTEMS.Timer_Service_Routine;
    790       User_Data : in     RTEMS.Address;
    791       Result    :    out RTEMS.Status_Codes
    792    ) is
    793       function Timer_Fire_When_Base (
    794          ID        : RTEMS.ID;
    795          Wall_Time : RTEMS.Time_Of_Day;
    796          Routine   : RTEMS.Timer_Service_Routine;
    797          User_Data : RTEMS.Address
    798       )  return RTEMS.Status_Codes;
    799       pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
    800    begin
    801  
    802       Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
    803 
    804    end Timer_Fire_When;
    805  
    806    procedure Timer_Server_Fire_When (
    807       ID        : in     RTEMS.ID;
    808       Wall_Time : in     RTEMS.Time_Of_Day;
    809       Routine   : in     RTEMS.Timer_Service_Routine;
    810       User_Data : in     RTEMS.Address;
    811       Result    :    out RTEMS.Status_Codes
    812    ) is
    813       function Timer_Server_Fire_When_Base (
    814          ID        : RTEMS.ID;
    815          Wall_Time : RTEMS.Time_Of_Day;
    816          Routine   : RTEMS.Timer_Service_Routine;
    817          User_Data : RTEMS.Address
     2204      function  Object_Get_Class_Information_Base (
     2205        The_API   : RTEMS.Unsigned32;
     2206        The_Class : RTEMS.Unsigned32;
     2207        Info      : access RTEMS.Object_API_Class_Information
    8182208      )  return RTEMS.Status_Codes;
    8192209      pragma Import (
    8202210         C,
    821          Timer_Server_Fire_When_Base,
    822          "rtems_timer_server_fire_when"
    823       );
    824    begin
    825  
    826       Result :=
    827          Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
    828    end Timer_Server_Fire_When;
    829  
    830    procedure Timer_Reset (
    831       ID     : in     RTEMS.ID;
    832       Result :    out RTEMS.Status_Codes
    833    ) is
    834       function Timer_Reset_Base (
    835          ID : RTEMS.ID
    836       )  return RTEMS.Status_Codes;
    837       pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
    838    begin
    839  
    840       Result := Timer_Reset_Base ( ID );
    841 
    842    end Timer_Reset;
    843  
    844    procedure Timer_Cancel (
    845       ID     : in     RTEMS.ID;
    846       Result :    out RTEMS.Status_Codes
    847    ) is
    848       function Timer_Cancel_Base (
    849          ID : RTEMS.ID
    850       )  return RTEMS.Status_Codes;
    851       pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
    852    begin
    853  
    854       Result := Timer_Cancel_Base ( ID );
    855 
    856    end Timer_Cancel;
    857  
    858    procedure Timer_Initiate_Server (
    859       Server_Priority : in     RTEMS.Task_Priority;
    860       Stack_Size      : in     RTEMS.Unsigned32;
    861       Attribute_Set   : in     RTEMS.Attribute;
    862       Result          :    out RTEMS.Status_Codes
    863    ) is
    864       function Timer_Initiate_Server_Base (
    865          Server_Priority : RTEMS.Task_Priority;
    866          Stack_Size      : RTEMS.Unsigned32;
    867          Attribute_Set   : RTEMS.Attribute
    868       )  return RTEMS.Status_Codes;
    869       pragma Import (
    870          C,
    871          Timer_Initiate_Server_Base,
    872          "rtems_timer_initiate_server"
    873       );
    874    begin
    875       Result := Timer_Initiate_Server_Base (
    876          Server_Priority,
    877          Stack_Size,
    878          Attribute_Set
    879       );
    880    end Timer_Initiate_Server;
    881 
    882    --
    883    -- Semaphore Manager
    884    --
    885  
    886    procedure Semaphore_Create (
    887       Name             : in     RTEMS.Name;
    888       Count            : in     RTEMS.Unsigned32;
    889       Attribute_Set    : in     RTEMS.Attribute;
    890       Priority_Ceiling : in     RTEMS.Task_Priority;
    891       ID               :    out RTEMS.ID;
    892       Result           :    out RTEMS.Status_Codes
    893    ) is
    894       function Semaphore_Create_Base (
    895          Name             : RTEMS.Name;
    896          Count            : RTEMS.Unsigned32;
    897          Attribute_Set    : RTEMS.Attribute;
    898          Priority_Ceiling : RTEMS.Task_Priority;
    899          ID               : access RTEMS.ID
    900       )  return RTEMS.Status_Codes;
    901       pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
    902       ID_Base : aliased RTEMS.ID;
    903    begin
    904  
    905       Result := Semaphore_Create_Base (
    906          Name,
    907          Count,
    908          Attribute_Set,
    909          Priority_Ceiling,
    910          ID_Base'Unchecked_Access
    911       );
    912       ID := ID_Base;
    913 
    914    end Semaphore_Create;
    915  
    916    procedure Semaphore_Delete (
    917       ID     : in     RTEMS.ID;
    918       Result :    out RTEMS.Status_Codes
    919    ) is
    920       function Semaphore_Delete_Base (
    921          ID : RTEMS.ID
    922       )  return RTEMS.Status_Codes;
    923       pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
    924    begin
    925  
    926       Result := Semaphore_Delete_Base ( ID );
    927 
    928    end Semaphore_Delete;
    929  
    930    procedure Semaphore_Ident (
    931       Name   : in     RTEMS.Name;
    932       Node   : in     RTEMS.Unsigned32;
    933       ID     :    out RTEMS.ID;
    934       Result :    out RTEMS.Status_Codes
    935    ) is
    936       function Semaphore_Ident_Base (
    937          Name : RTEMS.Name;
    938          Node : RTEMS.Unsigned32;
    939          ID   : access RTEMS.ID
    940       )  return RTEMS.Status_Codes;
    941       pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
    942       ID_Base : aliased RTEMS.ID;
    943    begin
    944  
    945       Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
    946       ID := ID_Base;
    947 
    948    end Semaphore_Ident;
    949  
    950    procedure Semaphore_Obtain (
    951       ID         : in     RTEMS.ID;
    952       Option_Set : in     RTEMS.Option;
    953       Timeout    : in     RTEMS.Interval;
    954       Result     :    out RTEMS.Status_Codes
    955    ) is
    956       function Semaphore_Obtain_Base (
    957          ID         : RTEMS.ID;
    958          Option_Set : RTEMS.Option;
    959          Timeout    : RTEMS.Interval
    960       )  return RTEMS.Status_Codes;
    961       pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
    962    begin
    963  
    964       Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout );
    965 
    966    end Semaphore_Obtain;
    967  
    968    procedure Semaphore_Release (
    969       ID     : in     RTEMS.ID;
    970       Result :    out RTEMS.Status_Codes
    971    ) is
    972       function Semaphore_Release_Base (
    973          ID : RTEMS.ID
    974       )  return RTEMS.Status_Codes;
    975       pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
    976    begin
    977  
    978       Result := Semaphore_Release_Base ( ID );
    979 
    980    end Semaphore_Release;
    981  
    982    procedure Semaphore_Flush (
    983       ID     : in     RTEMS.ID;
    984       Result :    out RTEMS.Status_Codes
    985    ) is
    986       function Semaphore_Flush_Base (
    987          ID : RTEMS.ID
    988       )  return RTEMS.Status_Codes;
    989       pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
    990    begin
    991  
    992       Result := Semaphore_Flush_Base ( ID );
    993 
    994    end Semaphore_Flush;
    995  
    996    --
    997    -- Message Queue Manager
    998    --
    999  
    1000    procedure Message_Queue_Create (
    1001       Name             : in     RTEMS.Name;
    1002       Count            : in     RTEMS.Unsigned32;
    1003       Max_Message_Size : in     RTEMS.Unsigned32;
    1004       Attribute_Set    : in     RTEMS.Attribute;
    1005       ID               :    out RTEMS.ID;
    1006       Result           :    out RTEMS.Status_Codes
    1007    ) is
    1008       --  XXX broken
    1009       function Message_Queue_Create_Base (
    1010          Name             : RTEMS.Name;
    1011          Count            : RTEMS.Unsigned32;
    1012          Max_Message_Size : RTEMS.Unsigned32;
    1013          Attribute_Set    : RTEMS.Attribute;
    1014          ID               : access RTEMS.ID
    1015       )  return RTEMS.Status_Codes;
    1016       pragma Import (C,
    1017         Message_Queue_Create_Base, "rtems_message_queue_create");
    1018       ID_Base : aliased RTEMS.ID;
    1019    begin
    1020  
    1021       Result := Message_Queue_Create_Base (
    1022          Name,
    1023          Count,
    1024          Max_Message_Size,
    1025          Attribute_Set,
    1026          ID_Base'Unchecked_Access
    1027       );
    1028       ID := ID_Base;
    1029 
    1030    end Message_Queue_Create;
    1031  
    1032    procedure Message_Queue_Ident (
    1033       Name   : in     RTEMS.Name;
    1034       Node   : in     RTEMS.Unsigned32;
    1035       ID     :    out RTEMS.ID;
    1036       Result :    out RTEMS.Status_Codes
    1037    ) is
    1038       function Message_Queue_Ident_Base (
    1039          Name : RTEMS.Name;
    1040          Node : RTEMS.Unsigned32;
    1041          ID   : access RTEMS.ID
    1042       )  return RTEMS.Status_Codes;
    1043       pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
    1044       ID_Base : aliased RTEMS.ID;
    1045    begin
    1046  
    1047       Result :=
    1048          Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
    1049       ID := ID_Base;
    1050 
    1051    end Message_Queue_Ident;
    1052  
    1053    procedure Message_Queue_Delete (
    1054       ID     : in     RTEMS.ID;
    1055       Result :    out RTEMS.Status_Codes
    1056    ) is
    1057       function Message_Queue_Delete_Base (
    1058          ID : RTEMS.ID
    1059       )  return RTEMS.Status_Codes;
    1060       pragma Import (
    1061          C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
    1062    begin
    1063  
    1064       Result := Message_Queue_Delete_Base ( ID );
    1065 
    1066    end Message_Queue_Delete;
    1067  
    1068    procedure Message_Queue_Send (
    1069       ID     : in     RTEMS.ID;
    1070       Buffer : in     RTEMS.Address;
    1071       Size   : in     RTEMS.Unsigned32;
    1072       Result :    out RTEMS.Status_Codes
    1073    ) is
    1074       function Message_Queue_Send_Base (
    1075          ID     : RTEMS.ID;
    1076          Buffer : RTEMS.Address;
    1077          Size   : RTEMS.Unsigned32
    1078       )  return RTEMS.Status_Codes;
    1079       pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
    1080    begin
    1081  
    1082       Result := Message_Queue_Send_Base ( ID, Buffer, Size );
    1083 
    1084    end Message_Queue_Send;
    1085  
    1086    procedure Message_Queue_Urgent (
    1087       ID     : in     RTEMS.ID;
    1088       Buffer : in     RTEMS.Address;
    1089       Size   : in     RTEMS.Unsigned32;
    1090       Result :    out RTEMS.Status_Codes
    1091    ) is
    1092       function Message_Queue_Urgent_Base (
    1093          ID     : RTEMS.ID;
    1094          Buffer : RTEMS.Address;
    1095          Size   : RTEMS.Unsigned32
    1096       )  return RTEMS.Status_Codes;
    1097       pragma Import (C, Message_Queue_Urgent_Base,
    1098          "rtems_message_queue_urgent");
    1099    begin
    1100  
    1101       Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
    1102 
    1103    end Message_Queue_Urgent;
    1104  
    1105    procedure Message_Queue_Broadcast (
    1106       ID     : in     RTEMS.ID;
    1107       Buffer : in     RTEMS.Address;
    1108       Size   : in     RTEMS.Unsigned32;
    1109       Count  :    out RTEMS.Unsigned32;
    1110       Result :    out RTEMS.Status_Codes
    1111    ) is
    1112       function Message_Queue_Broadcast_Base (
    1113          ID     : RTEMS.ID;
    1114          Buffer : RTEMS.Address;
    1115          Size   : RTEMS.Unsigned32;
    1116          Count  : access RTEMS.Unsigned32
    1117       )  return RTEMS.Status_Codes;
    1118       pragma Import (C, Message_Queue_Broadcast_Base,
    1119          "rtems_message_queue_broadcast");
    1120       Count_Base : aliased RTEMS.Unsigned32;
    1121    begin
    1122  
    1123       Result := Message_Queue_Broadcast_Base (
    1124          ID,
    1125          Buffer,
    1126          Size,
    1127          Count_Base'Unchecked_Access
    1128       );
    1129       Count := Count_Base;
    1130 
    1131    end Message_Queue_Broadcast;
    1132  
    1133    procedure Message_Queue_Receive (
    1134       ID         : in     RTEMS.ID;
    1135       Buffer     : in     RTEMS.Address;
    1136       Option_Set : in     RTEMS.Option;
    1137       Timeout    : in     RTEMS.Interval;
    1138       Size       :    out RTEMS.Unsigned32;
    1139       Result     :    out RTEMS.Status_Codes
    1140    ) is
    1141       function Message_Queue_Receive_Base (
    1142          ID         : RTEMS.ID;
    1143          Buffer     : RTEMS.Address;
    1144          Size       : access RTEMS.Unsigned32;
    1145          Option_Set : RTEMS.Option;
    1146          Timeout    : RTEMS.Interval
    1147       )  return RTEMS.Status_Codes;
    1148       pragma Import (C, Message_Queue_Receive_Base,
    1149          "rtems_message_queue_receive");
    1150       Size_Base : aliased RTEMS.Unsigned32;
    1151    begin
    1152  
    1153       Result := Message_Queue_Receive_Base (
    1154          ID,
    1155          Buffer,
    1156          Size_Base'Unchecked_Access,
    1157          Option_Set,
    1158          Timeout
    1159       );
    1160       Size := Size_Base;
    1161 
    1162    end Message_Queue_Receive;
    1163  
    1164    procedure Message_Queue_Get_Number_Pending (
    1165       ID     : in     RTEMS.ID;
    1166       Count  :    out RTEMS.Unsigned32;
    1167       Result :    out RTEMS.Status_Codes
    1168    ) is
    1169       function Message_Queue_Get_Number_Pending_Base (
    1170          ID    : RTEMS.ID;
    1171          Count : access RTEMS.Unsigned32
    1172       )  return RTEMS.Status_Codes;
    1173       pragma Import (
    1174          C,
    1175          Message_Queue_Get_Number_Pending_Base,
    1176          "rtems_message_queue_get_number_pending"
    1177       );
    1178       COUNT_Base : aliased RTEMS.Unsigned32;
    1179    begin
    1180  
    1181       Result := Message_Queue_Get_Number_Pending_Base (
    1182          ID, COUNT_Base'Unchecked_Access
    1183       );
    1184       Count := COUNT_Base;
    1185 
    1186    end Message_Queue_Get_Number_Pending;
    1187  
    1188    procedure Message_Queue_Flush (
    1189       ID     : in     RTEMS.ID;
    1190       Count  :    out RTEMS.Unsigned32;
    1191       Result :    out RTEMS.Status_Codes
    1192    ) is
    1193       function Message_Queue_Flush_Base (
    1194          ID    : RTEMS.ID;
    1195          Count : access RTEMS.Unsigned32
    1196       )  return RTEMS.Status_Codes;
    1197       pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
    1198       COUNT_Base : aliased RTEMS.Unsigned32;
    1199    begin
    1200  
    1201       Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
    1202       Count := COUNT_Base;
    1203 
    1204    end Message_Queue_Flush;
    1205  
    1206    --
    1207    -- Event Manager
    1208    --
    1209 
    1210    procedure Event_Send (
    1211       ID       : in     RTEMS.ID;
    1212       Event_In : in     RTEMS.Event_Set;
    1213       Result   :    out RTEMS.Status_Codes
    1214    ) is
    1215       function Event_Send_Base (
    1216          ID       : RTEMS.ID;
    1217          Event_In : RTEMS.Event_Set
    1218       )  return RTEMS.Status_Codes;
    1219       pragma Import (C, Event_Send_Base, "rtems_event_send");
    1220    begin
    1221 
    1222       Result := Event_Send_Base ( ID, Event_In );
    1223 
    1224    end Event_Send;
    1225 
    1226    procedure Event_Receive (
    1227       Event_In   : in     RTEMS.Event_Set;
    1228       Option_Set : in     RTEMS.Option;
    1229       Ticks      : in     RTEMS.Interval;
    1230       Event_Out  :    out RTEMS.Event_Set;
    1231       Result     :    out RTEMS.Status_Codes
    1232    ) is
    1233       function Event_Receive_Base (
    1234          Event_In   : RTEMS.Event_Set;
    1235          Option_Set : RTEMS.Option;
    1236          Ticks      : RTEMS.Interval;
    1237          Event_Out  : access RTEMS.Event_Set
    1238       )  return RTEMS.Status_Codes;
    1239       pragma Import (C, Event_Receive_Base, "rtems_event_receive");
    1240       Event_Out_Base : aliased RTEMS.Event_Set;
    1241    begin
    1242 
    1243       Result := Event_Receive_Base (
    1244          Event_In,
    1245          Option_Set,
    1246          Ticks,
    1247          Event_Out_Base'Access
    1248       );
    1249       Event_Out := Event_Out_Base;
    1250 
    1251    end Event_Receive;
    1252 
    1253    --
    1254    -- Signal Manager
    1255    --
    1256  
    1257    procedure Signal_Catch (
    1258       ASR_Handler : in     RTEMS.ASR_Handler;
    1259       Mode_Set    : in     RTEMS.Mode;
    1260       Result      :    out RTEMS.Status_Codes
    1261    ) is
    1262       function Signal_Catch_Base (
    1263          ASR_Handler : RTEMS.ASR_Handler;
    1264          Mode_Set    : RTEMS.Mode
    1265       )  return RTEMS.Status_Codes;
    1266       pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
    1267    begin
    1268 
    1269       Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
    1270 
    1271    end Signal_Catch;
    1272  
    1273    procedure Signal_Send (
    1274       ID         : in     RTEMS.ID;
    1275       Signal_Set : in     RTEMS.Signal_Set;
    1276       Result     :    out RTEMS.Status_Codes
    1277    ) is
    1278       function Signal_Send_Base (
    1279          ID         : RTEMS.ID;
    1280          Signal_Set : RTEMS.Signal_Set
    1281       )  return RTEMS.Status_Codes;
    1282       pragma Import (C, Signal_Send_Base, "rtems_signal_send");
    1283    begin
    1284  
    1285       Result := Signal_Send_Base ( ID, Signal_Set );
    1286 
    1287    end Signal_Send;
    1288  
    1289  
    1290    --
    1291    -- Partition Manager
    1292    --
    1293  
    1294    procedure Partition_Create (
    1295       Name             : in     RTEMS.Name;
    1296       Starting_Address : in     RTEMS.Address;
    1297       Length           : in     RTEMS.Unsigned32;
    1298       Buffer_Size      : in     RTEMS.Unsigned32;
    1299       Attribute_Set    : in     RTEMS.Attribute;
    1300       ID               :    out RTEMS.ID;
    1301       Result           :    out RTEMS.Status_Codes
    1302    ) is
    1303       function Partition_Create_Base (
    1304          Name             : RTEMS.Name;
    1305          Starting_Address : RTEMS.Address;
    1306          Length           : RTEMS.Unsigned32;
    1307          Buffer_Size      : RTEMS.Unsigned32;
    1308          Attribute_Set    : RTEMS.Attribute;
    1309          ID               : access RTEMS.Event_Set
    1310       )  return RTEMS.Status_Codes;
    1311       pragma Import (C, Partition_Create_Base, "rtems_partition_create");
    1312       ID_Base : aliased RTEMS.ID;
    1313    begin
    1314  
    1315       Result := Partition_Create_Base (
    1316          Name,
    1317          Starting_Address,
    1318          Length,
    1319          Buffer_Size,
    1320          Attribute_Set,
    1321          ID_Base'Unchecked_Access
    1322       );
    1323       ID := ID_Base;
    1324  
    1325    end Partition_Create;
    1326  
    1327    procedure Partition_Ident (
    1328       Name   : in     RTEMS.Name;
    1329       Node   : in     RTEMS.Unsigned32;
    1330       ID     :    out RTEMS.ID;
    1331       Result :    out RTEMS.Status_Codes
    1332    ) is
    1333       function Partition_Ident_Base (
    1334          Name : RTEMS.Name;
    1335          Node : RTEMS.Unsigned32;
    1336          ID   : access RTEMS.Event_Set
    1337       )  return RTEMS.Status_Codes;
    1338       pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
    1339       ID_Base : aliased RTEMS.ID;
    1340    begin
    1341  
    1342       Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
    1343       ID := ID_Base;
    1344 
    1345    end Partition_Ident;
    1346  
    1347    procedure Partition_Delete (
    1348       ID     : in     RTEMS.ID;
    1349       Result :    out RTEMS.Status_Codes
    1350    ) is
    1351       function Partition_Delete_Base (
    1352          ID : RTEMS.ID
    1353       )  return RTEMS.Status_Codes;
    1354       pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
    1355    begin
    1356  
    1357       Result := Partition_Delete_Base ( ID );
    1358 
    1359    end Partition_Delete;
    1360  
    1361    procedure Partition_Get_Buffer (
    1362       ID     : in     RTEMS.ID;
    1363       Buffer :    out RTEMS.Address;
    1364       Result :    out RTEMS.Status_Codes
    1365    ) is
    1366       function Partition_Get_Buffer_Base (
    1367          ID     : RTEMS.ID;
    1368          Buffer : access RTEMS.Address
    1369       )  return RTEMS.Status_Codes;
    1370       pragma Import (C, Partition_Get_Buffer_Base,
    1371          "rtems_partition_get_buffer");
    1372       Buffer_Base : aliased RTEMS.Address;
    1373    begin
    1374  
    1375       Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
    1376       Buffer := Buffer_Base;
    1377 
    1378    end Partition_Get_Buffer;
    1379  
    1380    procedure Partition_Return_Buffer (
    1381       ID     : in     RTEMS.ID;
    1382       Buffer : in     RTEMS.Address;
    1383       Result :    out RTEMS.Status_Codes
    1384    ) is
    1385       function Partition_Return_Buffer_Base (
    1386          ID     : RTEMS.Name;
    1387          Buffer : RTEMS.Address
    1388       )  return RTEMS.Status_Codes;
    1389       pragma Import (C, Partition_Return_Buffer_Base,
    1390          "rtems_partition_return_buffer");
    1391    begin
    1392  
    1393       Result := Partition_Return_Buffer_Base ( ID, Buffer );
    1394 
    1395    end Partition_Return_Buffer;
    1396 
    1397    --
    1398    -- Region Manager
    1399    --
    1400  
    1401    procedure Region_Create (
    1402       Name             : in     RTEMS.Name;
    1403       Starting_Address : in     RTEMS.Address;
    1404       Length           : in     RTEMS.Unsigned32;
    1405       Page_Size        : in     RTEMS.Unsigned32;
    1406       Attribute_Set    : in     RTEMS.Attribute;
    1407       ID               :    out RTEMS.ID;
    1408       Result           :    out RTEMS.Status_Codes
    1409    ) is
    1410       function Region_Create_Base (
    1411          Name             : RTEMS.Name;
    1412          Starting_Address : RTEMS.Address;
    1413          Length           : RTEMS.Unsigned32;
    1414          Page_Size        : RTEMS.Unsigned32;
    1415          Attribute_Set    : RTEMS.Attribute;
    1416          ID               : access RTEMS.ID
    1417       )  return RTEMS.Status_Codes;
    1418       pragma Import (C, Region_Create_Base, "rtems_region_create");
    1419       ID_Base : aliased RTEMS.ID;
    1420    begin
    1421  
    1422       Result := Region_Create_Base (
    1423          Name,
    1424          Starting_Address,
    1425          Length,
    1426          Page_Size,
    1427          Attribute_Set,
    1428          ID_Base'Unchecked_Access
    1429       );
    1430       ID := ID_Base;
    1431 
    1432    end Region_Create;
    1433  
    1434    procedure Region_Ident (
    1435       Name   : in     RTEMS.Name;
    1436       ID     :    out RTEMS.ID;
    1437       Result :    out RTEMS.Status_Codes
    1438    ) is
    1439       function Region_Ident_Base (
    1440          Name   : RTEMS.Name;
    1441          ID     : access RTEMS.ID
    1442       )  return RTEMS.Status_Codes;
    1443       pragma Import (C, Region_Ident_Base, "rtems_region_ident");
    1444       ID_Base : aliased RTEMS.ID;
    1445    begin
    1446  
    1447       Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
    1448       ID := ID_Base;
    1449 
    1450    end Region_Ident;
    1451  
    1452    procedure Region_Delete (
    1453       ID     : in     RTEMS.ID;
    1454       Result :    out RTEMS.Status_Codes
    1455    ) is
    1456       function Region_Delete_Base (
    1457          ID : RTEMS.ID
    1458       )  return RTEMS.Status_Codes;
    1459       pragma Import (C, Region_Delete_Base, "rtems_region_delete");
    1460    begin
    1461  
    1462       Result := Region_Delete_Base ( ID );
    1463 
    1464    end Region_Delete;
    1465  
    1466    procedure Region_Extend (
    1467       ID               : in     RTEMS.ID;
    1468       Starting_Address : in     RTEMS.Address;
    1469       Length           : in     RTEMS.Unsigned32;
    1470       Result           :    out RTEMS.Status_Codes
    1471    ) is
    1472       function Region_Extend_Base (
    1473          ID               : RTEMS.ID;
    1474          Starting_Address : RTEMS.Address;
    1475          Length           : RTEMS.Unsigned32
    1476       )  return RTEMS.Status_Codes;
    1477       pragma Import (C, Region_Extend_Base, "rtems_region_extend");
    1478    begin
    1479  
    1480       Result := Region_Extend_Base ( ID, Starting_Address, Length );
    1481 
    1482    end Region_Extend;
    1483  
    1484    procedure Region_Get_Segment (
    1485       ID         : in     RTEMS.ID;
    1486       Size       : in     RTEMS.Unsigned32;
    1487       Option_Set : in     RTEMS.Option;
    1488       Timeout    : in     RTEMS.Interval;
    1489       Segment    :    out RTEMS.Address;
    1490       Result     :    out RTEMS.Status_Codes
    1491    ) is
    1492       function Region_Get_Segment_Base (
    1493          ID         : RTEMS.ID;
    1494          Size       : RTEMS.Unsigned32;
    1495          Option_Set : RTEMS.Option;
    1496          Timeout    : RTEMS.Interval;
    1497          Segment    : access RTEMS.Address
    1498       )  return RTEMS.Status_Codes;
    1499       pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
    1500       Segment_Base : aliased RTEMS.Address;
    1501    begin
    1502  
    1503       Result := Region_Get_Segment_Base (
    1504          ID,
    1505          Size,
    1506          Option_Set,
    1507          Timeout,
    1508          Segment_Base'Unchecked_Access
    1509       );
    1510       Segment := SEGMENT_Base;
    1511 
    1512    end Region_Get_Segment;
    1513  
    1514    procedure Region_Get_Segment_Size (
    1515       ID      : in     RTEMS.ID;
    1516       Segment : in     RTEMS.Address;
    1517       Size    :    out RTEMS.Unsigned32;
    1518       Result  :    out RTEMS.Status_Codes
    1519    ) is
    1520       function Region_Get_Segment_Size_Base (
    1521          ID      : RTEMS.ID;
    1522          Segment : RTEMS.Address;
    1523          Size    : access RTEMS.Unsigned32
    1524       )  return RTEMS.Status_Codes;
    1525       pragma Import (C, Region_Get_Segment_Size_Base,
    1526          "rtems_region_get_segment_size");
    1527       Size_Base : aliased RTEMS.Unsigned32;
    1528    begin
    1529  
    1530       Result := Region_Get_Segment_Size_Base (
    1531          ID,
    1532          Segment,
    1533          Size_Base'Unchecked_Access
    1534       );
    1535       Size := SIZE_Base;
    1536 
    1537    end Region_Get_Segment_Size;
    1538  
    1539    procedure Region_Return_Segment (
    1540       ID      : in     RTEMS.ID;
    1541       Segment : in     RTEMS.Address;
    1542       Result  :    out RTEMS.Status_Codes
    1543    ) is
    1544       function Region_Return_Segment_Base (
    1545          ID      : RTEMS.ID;
    1546          Segment : RTEMS.Address
    1547       )  return RTEMS.Status_Codes;
    1548       pragma Import (C, Region_Return_Segment_Base,
    1549          "rtems_region_return_segment");
    1550    begin
    1551  
    1552       Result := Region_Return_Segment_Base ( ID, Segment );
    1553 
    1554    end Region_Return_Segment;
    1555  
    1556    procedure Region_Resize_Segment (
    1557       ID         : in     RTEMS.ID;
    1558       Segment    : in     RTEMS.Address;
    1559       Size       : in     RTEMS.Unsigned32;
    1560       Old_Size   :    out RTEMS.Unsigned32;
    1561       Result     :    out RTEMS.Status_Codes
    1562    ) is
    1563       function Region_Resize_Segment_Base (
    1564          ID       : RTEMS.ID;
    1565          Segment  : RTEMS.Address;
    1566          Size     : RTEMS.Unsigned32;
    1567          Old_Size : access RTEMS.Unsigned32
    1568       )  return RTEMS.Status_Codes;
    1569       pragma Import (C, Region_Resize_Segment_Base,
    1570          "rtems_region_resize_segment");
    1571       Old_Size_Base : aliased RTEMS.Unsigned32;
    1572    begin
    1573  
    1574       Result := Region_Resize_Segment_Base (
    1575          ID,
    1576          Segment,
    1577          Size,
    1578          Old_Size_Base'Unchecked_Access
    1579       );
    1580       Old_Size := Old_Size_Base;
    1581 
    1582    end Region_Resize_Segment;
    1583 
    1584    --
    1585    -- Dual Ported Memory Manager
    1586    --
    1587  
    1588    procedure Port_Create (
    1589       Name           : in     RTEMS.Name;
    1590       Internal_Start : in     RTEMS.Address;
    1591       External_Start : in     RTEMS.Address;
    1592       Length         : in     RTEMS.Unsigned32;
    1593       ID             :    out RTEMS.ID;
    1594       Result         :    out RTEMS.Status_Codes
    1595    ) is
    1596       function Port_Create_Base (
    1597          Name           : RTEMS.Name;
    1598          Internal_Start : RTEMS.Address;
    1599          External_Start : RTEMS.Address;
    1600          Length         : RTEMS.Unsigned32;
    1601          ID             : access RTEMS.ID
    1602       )  return RTEMS.Status_Codes;
    1603       pragma Import (C, Port_Create_Base, "rtems_port_create");
    1604       ID_Base : aliased RTEMS.ID;
    1605    begin
    1606  
    1607       Result := Port_Create_Base (
    1608          Name,
    1609          Internal_Start,
    1610          External_Start,
    1611          Length,
    1612          ID_Base'Unchecked_Access
    1613       );
    1614       ID := ID_Base;
    1615 
    1616    end Port_Create;
    1617  
    1618    procedure Port_Ident (
    1619       Name   : in     RTEMS.Name;
    1620       ID     :    out RTEMS.ID;
    1621       Result :    out RTEMS.Status_Codes
    1622    ) is
    1623       function Port_Ident_Base (
    1624          Name : RTEMS.Name;
    1625          ID   : access RTEMS.ID
    1626       )  return RTEMS.Status_Codes;
    1627       pragma Import (C, Port_Ident_Base, "rtems_port_ident");
    1628       ID_Base : aliased RTEMS.ID;
    1629    begin
    1630  
    1631       Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
    1632       ID := ID_Base;
    1633 
    1634    end Port_Ident;
    1635  
    1636    procedure Port_Delete (
    1637       ID     : in     RTEMS.ID;
    1638       Result :    out RTEMS.Status_Codes
    1639    ) is
    1640       function Port_Delete_Base (
    1641          ID : RTEMS.ID
    1642       )  return RTEMS.Status_Codes;
    1643       pragma Import (C, Port_Delete_Base, "rtems_port_delete");
    1644    begin
    1645  
    1646       Result := Port_Delete_Base ( ID );
    1647 
    1648    end Port_Delete;
    1649  
    1650    procedure Port_External_To_Internal (
    1651       ID       : in     RTEMS.ID;
    1652       External : in     RTEMS.Address;
    1653       Internal :    out RTEMS.Address;
    1654       Result   :    out RTEMS.Status_Codes
    1655    ) is
    1656       function Port_External_To_Internal_Base (
    1657          ID       : RTEMS.ID;
    1658          External : RTEMS.Address;
    1659          Internal : access RTEMS.Address
    1660       )  return RTEMS.Status_Codes;
    1661       pragma Import (C, Port_External_To_Internal_Base,
    1662          "rtems_port_external_to_internal");
    1663       Internal_Base : aliased RTEMS.Address;
    1664    begin
    1665  
    1666       Result := Port_External_To_Internal_Base (
    1667          ID,
    1668          External,
    1669          Internal_Base'Unchecked_Access
    1670       );
    1671       Internal := INTERNAL_Base;
    1672 
    1673    end Port_External_To_Internal;
    1674  
    1675    procedure Port_Internal_To_External (
    1676       ID       : in     RTEMS.ID;
    1677       Internal : in     RTEMS.Address;
    1678       External :    out RTEMS.Address;
    1679       Result   :    out RTEMS.Status_Codes
    1680    ) is
    1681       function Port_Internal_To_External_Base (
    1682          ID       : RTEMS.ID;
    1683          Internal : RTEMS.Address;
    1684          External : access RTEMS.Address
    1685       )  return RTEMS.Status_Codes;
    1686       pragma Import (C, Port_Internal_To_External_Base,
    1687          "rtems_port_internal_to_external");
    1688       External_Base : aliased RTEMS.Address;
    1689    begin
    1690  
    1691       Result := Port_Internal_To_External_Base (
    1692          ID,
    1693          Internal,
    1694          External_Base'Unchecked_Access
    1695       );
    1696       External := EXTERNAL_Base;
    1697 
    1698    end Port_Internal_To_External;
    1699  
    1700  
    1701    --
    1702    -- Fatal Error Manager
    1703    --
    1704  
    1705    procedure Fatal_Error_Occurred (
    1706       The_Error : in     RTEMS.Unsigned32
    1707    ) is
    1708       procedure Fatal_Error_Occurred_Base (
    1709          The_Error : RTEMS.Unsigned32
    1710       );
    1711    pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
    1712    begin
    1713  
    1714       Fatal_Error_Occurred_Base ( The_Error );
    1715 
    1716    end Fatal_Error_Occurred;
    1717 
    1718 
    1719    --
    1720    -- Rate Monotonic Manager
    1721    --
    1722  
    1723    procedure Rate_Monotonic_Create (
    1724       Name   : in     RTEMS.Name;
    1725       ID     :    out RTEMS.ID;
    1726       Result :    out RTEMS.Status_Codes
    1727    ) is
    1728       function Rate_Monotonic_Create_Base (
    1729          Name   : RTEMS.Name;
    1730          ID     : access RTEMS.ID
    1731       )  return RTEMS.Status_Codes;
    1732       pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create");
    1733       ID_Base : aliased RTEMS.ID;
    1734    begin
    1735  
    1736       Result := Rate_Monotonic_Create_Base ( Name, ID_Base'Unchecked_Access );
    1737       ID := ID_Base;
    1738 
    1739    end Rate_Monotonic_Create;
    1740  
    1741    procedure Rate_Monotonic_Ident (
    1742       Name   : in     RTEMS.Name;
    1743       ID     :    out RTEMS.ID;
    1744       Result :    out RTEMS.Status_Codes
    1745    ) is
    1746       function Rate_Monotonic_Ident_Base (
    1747          Name   : RTEMS.Name;
    1748          ID     : access RTEMS.ID
    1749       )  return RTEMS.Status_Codes;
    1750       pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
    1751       ID_Base : aliased RTEMS.ID;
    1752    begin
    1753  
    1754       Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
    1755  
    1756       ID := ID_Base;
    1757 
    1758    end Rate_Monotonic_Ident;
    1759  
    1760    procedure Rate_Monotonic_Delete (
    1761       ID     : in     RTEMS.ID;
    1762       Result :    out RTEMS.Status_Codes
    1763    ) is
    1764       function Rate_Monotonic_Delete_Base (
    1765          ID : RTEMS.ID
    1766       )  return RTEMS.Status_Codes;
    1767       pragma Import (C, Rate_Monotonic_Delete_Base,
    1768          "rtems_rate_monotonic_delete");
    1769    begin
    1770  
    1771       Result := Rate_Monotonic_Delete_Base ( ID );
    1772 
    1773    end Rate_Monotonic_Delete;
    1774  
    1775    procedure Rate_Monotonic_Cancel (
    1776       ID     : in     RTEMS.ID;
    1777       Result :    out RTEMS.Status_Codes
    1778    ) is
    1779       function Rate_Monotonic_Cancel_Base (
    1780          ID : RTEMS.ID
    1781       )  return RTEMS.Status_Codes;
    1782       pragma Import (C, Rate_Monotonic_Cancel_Base,
    1783          "rtems_rate_monotonic_cancel");
    1784    begin
    1785  
    1786       Result := Rate_Monotonic_Cancel_Base ( ID );
    1787 
    1788    end Rate_Monotonic_Cancel;
    1789  
    1790    procedure Rate_Monotonic_Period (
    1791       ID      : in     RTEMS.ID;
    1792       Length  : in     RTEMS.Interval;
    1793       Result  :    out RTEMS.Status_Codes
    1794    ) is
    1795       function Rate_Monotonic_Period_Base (
    1796          ID     : RTEMS.ID;
    1797          Length : RTEMS.Interval
    1798       )  return RTEMS.Status_Codes;
    1799       pragma Import (C, Rate_Monotonic_Period_Base,
    1800          "rtems_rate_monotonic_period");
    1801    begin
    1802  
    1803       Result := Rate_Monotonic_Period_Base ( ID, Length );
    1804 
    1805    end Rate_Monotonic_Period;
    1806  
    1807    procedure Rate_Monotonic_Get_Status (
    1808       ID      : in     RTEMS.ID;
    1809       Status  :    out RTEMS.Rate_Monotonic_Period_Status;
    1810       Result  :    out RTEMS.Status_Codes
    1811    ) is
    1812       function Rate_Monotonic_Get_Status_Base (
    1813          ID      : RTEMS.ID;
    1814          Status  : access RTEMS.Rate_Monotonic_Period_Status
    1815       )  return RTEMS.Status_Codes;
    1816       pragma Import (C, Rate_Monotonic_Get_Status_Base,
    1817          "rtems_rate_monotonic_get_status");
    1818 
    1819       Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
    1820    begin
    1821 
    1822       Result := Rate_Monotonic_Get_Status_Base (
    1823          ID,
    1824          Status_Base'Unchecked_Access
    1825       );
    1826 
    1827       Status := Status_Base;
    1828 
    1829 
    1830    end Rate_Monotonic_Get_Status;
    1831 
    1832    procedure Rate_Monotonic_Reset_Statistics (
    1833       ID     : in     RTEMS.ID;
    1834       Result :    out RTEMS.Status_Codes
    1835    ) is
    1836       function Rate_Monotonic_Reset_Statistics_Base (
    1837          ID : RTEMS.ID
    1838       )  return RTEMS.Status_Codes;
    1839       pragma Import (C, Rate_Monotonic_Reset_Statistics_Base,
    1840          "rtems_rate_monotonic_reset_statistics");
    1841    begin
    1842 
    1843       Result := Rate_Monotonic_Reset_Statistics_Base ( ID );
    1844 
    1845    end Rate_Monotonic_Reset_Statistics;
    1846 
    1847 
    1848    --
    1849    -- Barrier Manager
    1850    --
    1851 
    1852    procedure Barrier_Create (
    1853       Name            : in     RTEMS.Name;
    1854       Attribute_Set   : in     RTEMS.Attribute;
    1855       Maximum_Waiters : in     RTEMS.Unsigned32;
    1856       ID              :    out RTEMS.ID;
    1857       Result          :    out RTEMS.Status_Codes
    1858    ) is
    1859       function Barrier_Create_Base (
    1860          Name            : RTEMS.Name;
    1861          Attribute_Set   : RTEMS.Attribute;
    1862          Maximum_Waiters : RTEMS.Unsigned32;
    1863          ID              : access RTEMS.ID
    1864       )  return RTEMS.Status_Codes;
    1865       pragma Import (C, Barrier_Create_Base, "rtems_barrier_create");
    1866       ID_Base : aliased RTEMS.ID;
    1867    begin
    1868 
    1869       Result := Barrier_Create_Base (
    1870          Name,
    1871          Attribute_Set,
    1872          Maximum_Waiters,
    1873          ID_Base'Unchecked_Access
    1874       );
    1875       ID := ID_Base;
    1876 
    1877    end Barrier_Create;
    1878 
    1879    procedure Barrier_Ident (
    1880       Name   : in     RTEMS.Name;
    1881       ID     :    out RTEMS.ID;
    1882       Result :    out RTEMS.Status_Codes
    1883    ) is
    1884       function Barrier_Ident_Base (
    1885          Name : RTEMS.Name;
    1886          ID   : access RTEMS.ID
    1887       )  return RTEMS.Status_Codes;
    1888       pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident");
    1889       ID_Base : aliased RTEMS.ID;
    1890    begin
    1891 
    1892       Result := Barrier_Ident_Base ( Name, ID_Base'Unchecked_Access );
    1893       ID := ID_Base;
    1894 
    1895    end Barrier_Ident;
    1896 
    1897    procedure Barrier_Delete (
    1898       ID     : in     RTEMS.ID;
    1899       Result :    out RTEMS.Status_Codes
    1900    ) is
    1901       function Barrier_Delete_Base (
    1902          ID : RTEMS.ID
    1903       )  return RTEMS.Status_Codes;
    1904       pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
    1905    begin
    1906 
    1907       Result := Barrier_Delete_Base ( ID );
    1908 
    1909    end Barrier_Delete;
    1910 
    1911    procedure Barrier_Wait (
    1912       ID         : in     RTEMS.ID;
    1913       Timeout    : in     RTEMS.Interval;
    1914       Result     :    out RTEMS.Status_Codes
    1915    ) is
    1916       function Barrier_Wait_Base (
    1917          ID         : RTEMS.ID;
    1918          Timeout    : RTEMS.Interval
    1919       )  return RTEMS.Status_Codes;
    1920       pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
    1921    begin
    1922 
    1923       Result := Barrier_Wait_Base ( ID, Timeout );
    1924 
    1925    end Barrier_Wait;
    1926 
    1927    procedure Barrier_Release (
    1928       ID       : in     RTEMS.ID;
    1929       Released :    out RTEMS.Unsigned32;
    1930       Result   :    out RTEMS.Status_Codes
    1931    ) is
    1932       function Barrier_Release_Base (
    1933          ID       : RTEMS.ID;
    1934          Released : access RTEMS.Unsigned32
    1935       )  return RTEMS.Status_Codes;
    1936       pragma Import (C, Barrier_Release_Base, "rtems_barrier_release");
    1937       Released_Base : aliased RTEMS.Unsigned32;
    1938    begin
    1939 
    1940       Result := Barrier_Release_Base ( ID, Released_Base'Unchecked_Access );
    1941       Released := Released_Base;
    1942 
    1943    end Barrier_Release;
    1944 
    1945  
    1946    --
    1947    -- Debug Manager
    1948    --
    1949  
    1950    procedure Debug_Enable (
    1951       To_Be_Enabled : in     RTEMS.Debug_Set
    1952    ) is
    1953       procedure Debug_Enable_Base (
    1954          To_Be_Enabled : RTEMS.Debug_Set
    1955       );
    1956    pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
    1957    begin
    1958  
    1959       Debug_Enable_Base ( To_Be_Enabled );
    1960 
    1961    end Debug_Enable;
    1962  
    1963    procedure Debug_Disable (
    1964       To_Be_Disabled : in     RTEMS.Debug_Set
    1965    ) is
    1966       procedure Debug_Disable_Base (
    1967          To_Be_Disabled : RTEMS.Debug_Set
    1968       );
    1969    pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
    1970    begin
    1971  
    1972       Debug_Disable_Base ( To_Be_Disabled );
    1973 
    1974    end Debug_Disable;
    1975  
    1976    function Debug_Is_Enabled (
    1977       Level : in     RTEMS.Debug_Set
    1978    ) return RTEMS.Boolean is
    1979       function Debug_Is_Enabled_Base (
    1980          Level : RTEMS.Debug_Set
    1981       )  return RTEMS.Boolean;
    1982       pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
    1983    begin
    1984  
    1985       return Debug_Is_Enabled_Base ( Level );
    1986 
    1987    end Debug_Is_Enabled;
     2211         Object_Get_Class_Information_Base,
     2212         "rtems_object_get_class_information"
     2213      );
     2214      TmpInfo : aliased RTEMS.Object_API_Class_Information;
     2215   begin
     2216      Result :=  Object_Get_Class_Information_Base
     2217         (The_API, The_Class, TmpInfo'Access);
     2218      Info := TmpInfo;
     2219   end Object_Get_Class_Information;
    19882220
    19892221end RTEMS;
  • c/src/ada/rtems.ads

    r0bc8e5c r8407b5e  
    1212--    the BSP side, therefore should never be called from ADA.
    1313--
    14 --  COPYRIGHT (c) 1997-2007.
     14--  COPYRIGHT (c) 1997-2008.
    1515--  On-Line Applications Research Corporation (OAR).
    1616--
     
    532532   ) return RTEMS.Interval;
    533533
    534    function Build_Name (
    535       C1 : in     Character;
    536       C2 : in     Character;
    537       C3 : in     Character;
    538       C4 : in     Character
    539    ) return RTEMS.Name;
    540 
    541534   procedure Name_To_Characters (
    542535      Name : in     RTEMS.Name;
     
    667660      Result  :    out RTEMS.Status_Codes
    668661   );
    669    
     662
    670663   type Task_Variable_Dtor is access procedure (
    671664      Argument : in     RTEMS.Address
     
    12681261   ) return RTEMS.Boolean;
    12691262
     1263   --
     1264   --  Object Services
     1265   --
     1266
     1267   function Build_Name (
     1268      C1 : in     Character;
     1269      C2 : in     Character;
     1270      C3 : in     Character;
     1271      C4 : in     Character
     1272   ) return RTEMS.Name;
     1273
     1274   procedure Object_Get_Classic_Name(
     1275      ID     : in     RTEMS.ID;
     1276      Name   :    out RTEMS.Name;
     1277      Result :    out RTEMS.Status_Codes
     1278   );
     1279
     1280   procedure Object_Get_Name(
     1281      ID     : in     RTEMS.ID;
     1282      Length : in     RTEMS.Unsigned32;
     1283      Name   :    out String;
     1284      Result :    out RTEMS.Status_Codes
     1285   );
     1286
     1287   procedure Object_Set_Name(
     1288      ID     : in     RTEMS.ID;
     1289      Name   : in     String;
     1290      Result :    out RTEMS.Status_Codes
     1291   );
     1292
     1293   procedure Object_Id_Get_API(
     1294      ID  : in     RTEMS.ID;
     1295      API :    out RTEMS.Unsigned32
     1296   );
     1297
     1298   procedure Object_Id_Get_Class(
     1299      ID        : in     RTEMS.ID;
     1300      The_Class :    out RTEMS.Unsigned32
     1301   );
     1302
     1303   procedure Object_Id_Get_Node(
     1304      ID   : in     RTEMS.ID;
     1305      Node :    out RTEMS.Unsigned32
     1306   );
     1307
     1308   procedure Object_Id_Get_Index(
     1309      ID    : in     RTEMS.ID;
     1310      Index :    out RTEMS.Unsigned32
     1311   );
     1312
     1313   function Build_Id(
     1314      The_API   : in     RTEMS.Unsigned32;
     1315      The_Class : in     RTEMS.Unsigned32;
     1316      The_Node  : in     RTEMS.Unsigned32;
     1317      The_Index : in     RTEMS.Unsigned32
     1318   ) return RTEMS.Id;
     1319
     1320   function Object_Id_API_Minimum return RTEMS.Unsigned32;
     1321
     1322   function Object_Id_API_Maximum return RTEMS.Unsigned32;
     1323
     1324   procedure Object_API_Minimum_Class(
     1325      API     : in     RTEMS.Unsigned32;
     1326      Minimum :    out RTEMS.Unsigned32
     1327   );
     1328
     1329   procedure Object_API_Maximum_Class(
     1330      API     : in     RTEMS.Unsigned32;
     1331      Maximum :    out RTEMS.Unsigned32
     1332   );
     1333
     1334   procedure Object_Get_API_Name(
     1335      API  : in     RTEMS.Unsigned32;
     1336      Name :    out String
     1337   );
     1338
     1339   procedure Object_Get_API_Class_Name(
     1340      The_API   : in     RTEMS.Unsigned32;
     1341      The_Class : in     RTEMS.Unsigned32;
     1342      Name      :    out String
     1343   );
     1344
     1345   type Object_API_Class_Information is
     1346     record
     1347        Minimum_Id    : RTEMS.Id;
     1348        Maximum_Id    : RTEMS.Id;
     1349        Maximum       : RTEMS.Unsigned32;
     1350        AutoExtend    : RTEMS.Boolean;
     1351        Unallocated   : RTEMS.Unsigned32;
     1352     end record;
     1353
     1354   procedure Object_Get_Class_Information(
     1355      The_API   : in     RTEMS.Unsigned32;
     1356      The_Class : in     RTEMS.Unsigned32;
     1357      Info      :    out RTEMS.Object_API_Class_Information;
     1358      Result    :    out RTEMS.Status_Codes
     1359   );
     1360
    12701361end RTEMS;
Note: See TracChangeset for help on using the changeset viewer.