source: rtems/c/src/ada/rtems.adb @ 8407b5e

4.104.114.95
Last change on this file since 8407b5e was 8407b5e, checked in by Joel Sherrill <joel.sherrill@…>, on 02/01/08 at 21:24:18

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

  • rtems.adb, rtems.ads: Add Ada binding for Object Services.
  • Property mode set to 100644
File size: 61.8 KB
Line 
1--
2--  RTEMS / Body
3--
4--  DESCRIPTION:
5--
6--  This package provides the interface to the RTEMS API.
7-- 
8--
9--  DEPENDENCIES:
10--
11--
12--
13--  COPYRIGHT (c) 1997-2008.
14--  On-Line Applications Research Corporation (OAR).
15--
16--  The license and distribution terms for this file may in
17--  the file LICENSE in this distribution or at
18--  http://www.rtems.com/license/LICENSE.
19--
20--  $Id$
21--
22
23with Ada;
24with Ada.Unchecked_Conversion;
25with System;
26with Interfaces; use Interfaces;
27with Interfaces.C; use Interfaces.C;
28with Interfaces.C.Strings; use Interfaces.C.Strings;
29
30package body RTEMS is
31
32   --
33   --  Utility Functions
34   --
35 
36   function From_Ada_Boolean (
37      Ada_Boolean : Standard.Boolean
38   ) return RTEMS.Boolean is
39   begin
40
41      if Ada_Boolean = Standard.True then
42         return RTEMS.True;
43      end if;
44
45      return RTEMS.False;
46
47   end From_Ada_Boolean;
48 
49   function To_Ada_Boolean (
50      RTEMS_Boolean : RTEMS.Boolean
51   ) return Standard.Boolean is
52   begin
53
54      if RTEMS_Boolean = RTEMS.True then
55         return Standard.True;
56      end if;
57
58      return Standard.False;
59
60   end To_Ada_Boolean;
61
62   function Milliseconds_To_Microseconds (
63      Milliseconds : RTEMS.Unsigned32
64   ) return RTEMS.Unsigned32 is
65   begin
66
67      return Milliseconds * 1000;
68
69   end Milliseconds_To_Microseconds;
70
71   function Microseconds_To_Ticks (
72      Microseconds : RTEMS.Unsigned32
73   ) return RTEMS.Interval is
74      Microseconds_Per_Tick : RTEMS.Interval;
75      pragma Import (C, Microseconds_Per_Tick, "_TOD_Microseconds_per_tick");
76   begin
77
78      return Microseconds / Microseconds_Per_Tick;
79
80   end Microseconds_To_Ticks;
81
82   function Milliseconds_To_Ticks (
83      Milliseconds : RTEMS.Unsigned32
84   ) return RTEMS.Interval is
85   begin
86
87      return Microseconds_To_Ticks(Milliseconds_To_Microseconds(Milliseconds));
88
89   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   --
1969
1970   function Build_Name (
1971      C1 : in     Character;
1972      C2 : in     Character;
1973      C3 : in     Character;
1974      C4 : in     Character
1975   ) return RTEMS.Name is
1976      C1_Value : RTEMS.Unsigned32;
1977      C2_Value : RTEMS.Unsigned32;
1978      C3_Value : RTEMS.Unsigned32;
1979      C4_Value : RTEMS.Unsigned32;
1980   begin
1981
1982     C1_Value := Character'Pos( C1 );
1983     C2_Value := Character'Pos( C2 );
1984     C3_Value := Character'Pos( C3 );
1985     C4_Value := Character'Pos( C4 );
1986
1987     return Interfaces.Shift_Left( C1_Value, 24 ) or
1988            Interfaces.Shift_Left( C2_Value, 16 ) or
1989            Interfaces.Shift_Left( C3_Value, 8 )  or
1990            C4_Value;
1991
1992   end Build_Name;
1993
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 (
2064         ID : RTEMS.ID
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;
2202      Result    :    out RTEMS.Status_Codes
2203   ) is
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
2208      )  return RTEMS.Status_Codes;
2209      pragma Import (
2210         C,
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;
2220
2221end RTEMS;
Note: See TracBrowser for help on using the repository browser.