source: rtems/c/src/ada/rtems.adb @ 4771ec9b

4.104.115
Last change on this file since 4771ec9b was 0442eed, checked in by Joel Sherrill <joel.sherrill@…>, on 05/06/08 at 23:17:28

2008-05-06 Joel Sherrill <joel.sherrill@…>

  • rtems.adb, rtems.ads: Fix prototype.
  • Property mode set to 100644
File size: 62.9 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'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'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'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'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'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'Access,
480         Task_Variable_Value_Base'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'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 : access RTEMS.Time_Of_Day
556      )  return RTEMS.Status_Codes;
557      pragma Import (C, Clock_Set_Base, "rtems_clock_set");
558
559      Tmp_Time : aliased RTEMS.Time_Of_Day;
560   begin
561
562      Tmp_Time := Time_Buffer;
563      Result := Clock_Set_Base (Tmp_Time'Access);
564
565   end Clock_Set;
566
567   procedure Clock_Get (
568      Option      : in     RTEMS.Clock_Get_Options;
569      Time_Buffer : in     RTEMS.Address;
570      Result      :    out RTEMS.Status_Codes
571   ) is
572      function Clock_Get_Base (
573         Option      : RTEMS.Clock_Get_Options;
574         Time_Buffer : RTEMS.Address
575      )  return RTEMS.Status_Codes;
576      pragma Import (C, Clock_Get_Base, "rtems_clock_get");
577   begin
578
579      Result := Clock_Get_Base (Option, Time_Buffer);
580
581   end Clock_Get;
582
583   procedure Clock_Get_TOD (
584      Time    :    out RTEMS.Time_Of_Day;
585      Result  :    out RTEMS.Status_Codes
586   ) is
587      function Clock_Get_TOD_Base (
588        Time  : access RTEMS.Time_Of_Day
589      )  return RTEMS.Status_Codes;
590      pragma Import (C, Clock_Get_TOD_Base, "rtems_clock_get_tod");
591
592      Tmp_Time : aliased RTEMS.Time_Of_Day;
593   begin
594      Result := Clock_Get_TOD_Base (Tmp_Time'Access);
595      Time := Tmp_Time;
596   end Clock_Get_TOD;
597
598   procedure Clock_Get_TOD_Time_Value (
599      Time   :    out RTEMS.Clock_Time_Value;
600      Result :    out RTEMS.Status_Codes
601   ) is
602      function Clock_Get_TOD_Time_Value_Base (
603        Time  : access RTEMS.Clock_Time_Value
604      )  return RTEMS.Status_Codes;
605      pragma Import (
606         C,
607         Clock_Get_TOD_Time_Value_Base,
608         "rtems_clock_get_tod_timeval"
609      );
610
611      Tmp_Time : aliased RTEMS.Clock_Time_Value;
612   begin
613      Result := Clock_Get_TOD_Time_Value_Base (Tmp_Time'Access);
614      Time := Tmp_Time;
615   end Clock_Get_TOD_Time_Value;
616
617   procedure Clock_Get_Seconds_Since_Epoch(
618      The_Interval :    out RTEMS.Interval;
619      Result       :    out RTEMS.Status_Codes
620   ) is
621      function Clock_Get_Seconds_Since_Epoch_Base (
622        The_Interval  : access RTEMS.Interval
623      )  return RTEMS.Status_Codes;
624      pragma Import (
625         C,
626         Clock_Get_Seconds_Since_Epoch_Base,
627         "rtems_clock_get_seconds_since_epoch"
628      );
629
630      Tmp_Interval : aliased RTEMS.Interval;
631   begin
632      Result := Clock_Get_Seconds_Since_Epoch_Base (Tmp_Interval'Access);
633      The_Interval := Tmp_Interval;
634   end Clock_Get_Seconds_Since_Epoch;
635
636   -- Clock_Get_Ticks_Per_Second is in rtems.ads
637
638   -- Clock_Get_Ticks_Since_Boot is in rtems.ads
639
640   procedure Clock_Get_Uptime (
641      Uptime :    out RTEMS.Timespec;
642      Result :    out RTEMS.Status_Codes
643   ) is
644      function Clock_Get_Uptime_Base (
645         Uptime : access RTEMS.Timespec
646      )  return RTEMS.Status_Codes;
647      pragma Import (C, Clock_Get_Uptime_Base, "rtems_clock_get_uptime");
648      Uptime_Base : aliased RTEMS.Timespec;
649   begin
650
651      Result := Clock_Get_Uptime_Base (Uptime_Base'Access);
652      Uptime := Uptime_Base;
653
654   end Clock_Get_Uptime;
655
656   procedure Clock_Tick (
657      Result :    out RTEMS.Status_Codes
658   ) is
659      function Clock_Tick_Base return RTEMS.Status_Codes;
660      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
661   begin
662
663      Result := Clock_Tick_Base;
664
665   end Clock_Tick;
666
667   --
668   -- Extension Manager
669   --
670
671   procedure Extension_Create (
672      Name   : in     RTEMS.Name;
673      Table  : in     RTEMS.Extensions_Table_Pointer;
674      ID     :    out RTEMS.ID;
675      Result :    out RTEMS.Status_Codes
676   ) is
677      function Extension_Create_Base (
678         Name   : RTEMS.Name;
679         Table  : RTEMS.Extensions_Table_Pointer;
680         ID     : access RTEMS.ID
681      )  return RTEMS.Status_Codes;
682      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
683      ID_Base : aliased RTEMS.ID;
684   begin
685
686      Result := Extension_Create_Base (Name, Table, ID_Base'Access);
687      ID := ID_Base;
688
689   end Extension_Create;
690
691   procedure Extension_Ident (
692      Name   : in     RTEMS.Name;
693      ID     :    out RTEMS.ID;
694      Result :    out RTEMS.Status_Codes
695   ) is
696      function Extension_Ident_Base (
697         Name   : RTEMS.Name;
698         ID     : access RTEMS.ID
699      )  return RTEMS.Status_Codes;
700      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
701      ID_Base : aliased RTEMS.ID;
702   begin
703
704      Result := Extension_Ident_Base (Name, ID_Base'Access);
705      ID := ID_Base;
706
707   end Extension_Ident;
708
709   procedure Extension_Delete (
710      ID     : in     RTEMS.ID;
711      Result :    out RTEMS.Status_Codes
712   ) is
713      function Extension_Delete_Base (
714         ID : RTEMS.ID
715      )  return RTEMS.Status_Codes;
716      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
717   begin
718
719      Result := Extension_Delete_Base (ID);
720
721   end Extension_Delete;
722
723   --
724   -- Timer Manager
725   --
726
727   procedure Timer_Create (
728      Name   : in     RTEMS.Name;
729      ID     :    out RTEMS.ID;
730      Result :    out RTEMS.Status_Codes
731   ) is
732      function Timer_Create_Base (
733         Name   : RTEMS.Name;
734         ID     : access RTEMS.ID
735      )  return RTEMS.Status_Codes;
736      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
737      ID_Base : aliased RTEMS.ID;
738   begin
739
740      Result := Timer_Create_Base (Name, ID_Base'Access);
741      ID := ID_Base;
742
743   end Timer_Create;
744
745   procedure Timer_Ident (
746      Name   : in     RTEMS.Name;
747      ID     :    out RTEMS.ID;
748      Result :    out RTEMS.Status_Codes
749   ) is
750      function Timer_Ident_Base (
751         Name   : RTEMS.Name;
752         ID     : access RTEMS.ID
753      )  return RTEMS.Status_Codes;
754      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
755      ID_Base : aliased RTEMS.ID;
756   begin
757
758      Result := Timer_Ident_Base (Name, ID_Base'Access);
759      ID := ID_Base;
760
761   end Timer_Ident;
762
763   procedure Timer_Delete (
764      ID     : in     RTEMS.ID;
765      Result :    out RTEMS.Status_Codes
766   ) is
767      function Timer_Delete_Base (
768         ID : RTEMS.ID
769      )  return RTEMS.Status_Codes;
770      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
771   begin
772
773      Result := Timer_Delete_Base (ID);
774
775   end Timer_Delete;
776
777   procedure Timer_Fire_After (
778      ID        : in     RTEMS.ID;
779      Ticks     : in     RTEMS.Interval;
780      Routine   : in     RTEMS.Timer_Service_Routine;
781      User_Data : in     RTEMS.Address;
782      Result    :    out RTEMS.Status_Codes
783   ) is
784      function Timer_Fire_After_Base (
785         ID        : RTEMS.ID;
786         Ticks     : RTEMS.Interval;
787         Routine   : RTEMS.Timer_Service_Routine;
788         User_Data : RTEMS.Address
789      )  return RTEMS.Status_Codes;
790      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
791   begin
792
793      Result := Timer_Fire_After_Base (ID, Ticks, Routine, User_Data);
794
795   end Timer_Fire_After;
796
797   procedure Timer_Server_Fire_After (
798      ID        : in     RTEMS.ID;
799      Ticks     : in     RTEMS.Interval;
800      Routine   : in     RTEMS.Timer_Service_Routine;
801      User_Data : in     RTEMS.Address;
802      Result    :    out RTEMS.Status_Codes
803   ) is
804      function Timer_Server_Fire_After_Base (
805         ID        : RTEMS.ID;
806         Ticks     : RTEMS.Interval;
807         Routine   : RTEMS.Timer_Service_Routine;
808         User_Data : RTEMS.Address
809      )  return RTEMS.Status_Codes;
810      pragma Import (
811        C,
812        Timer_Server_Fire_After_Base,
813        "rtems_timer_server_fire_after"
814      );
815   begin
816
817      Result := Timer_Server_Fire_After_Base (ID, Ticks, Routine, User_Data);
818
819   end Timer_Server_Fire_After;
820
821   procedure Timer_Fire_When (
822      ID        : in     RTEMS.ID;
823      Wall_Time : in     RTEMS.Time_Of_Day;
824      Routine   : in     RTEMS.Timer_Service_Routine;
825      User_Data : in     RTEMS.Address;
826      Result    :    out RTEMS.Status_Codes
827   ) is
828      function Timer_Fire_When_Base (
829         ID        : RTEMS.ID;
830         Wall_Time : RTEMS.Time_Of_Day;
831         Routine   : RTEMS.Timer_Service_Routine;
832         User_Data : RTEMS.Address
833      )  return RTEMS.Status_Codes;
834      pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
835   begin
836
837      Result := Timer_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
838
839   end Timer_Fire_When;
840
841   procedure Timer_Server_Fire_When (
842      ID        : in     RTEMS.ID;
843      Wall_Time : in     RTEMS.Time_Of_Day;
844      Routine   : in     RTEMS.Timer_Service_Routine;
845      User_Data : in     RTEMS.Address;
846      Result    :    out RTEMS.Status_Codes
847   ) is
848      function Timer_Server_Fire_When_Base (
849         ID        : RTEMS.ID;
850         Wall_Time : RTEMS.Time_Of_Day;
851         Routine   : RTEMS.Timer_Service_Routine;
852         User_Data : RTEMS.Address
853      )  return RTEMS.Status_Codes;
854      pragma Import (
855         C,
856         Timer_Server_Fire_When_Base,
857         "rtems_timer_server_fire_when"
858      );
859   begin
860
861      Result :=
862         Timer_Server_Fire_When_Base (ID, Wall_Time, Routine, User_Data);
863   end Timer_Server_Fire_When;
864
865   procedure Timer_Reset (
866      ID     : in     RTEMS.ID;
867      Result :    out RTEMS.Status_Codes
868   ) is
869      function Timer_Reset_Base (
870         ID : RTEMS.ID
871      )  return RTEMS.Status_Codes;
872      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
873   begin
874
875      Result := Timer_Reset_Base (ID);
876
877   end Timer_Reset;
878
879   procedure Timer_Cancel (
880      ID     : in     RTEMS.ID;
881      Result :    out RTEMS.Status_Codes
882   ) is
883      function Timer_Cancel_Base (
884         ID : RTEMS.ID
885      )  return RTEMS.Status_Codes;
886      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
887   begin
888
889      Result := Timer_Cancel_Base (ID);
890
891   end Timer_Cancel;
892
893   procedure Timer_Initiate_Server (
894      Server_Priority : in     RTEMS.Task_Priority;
895      Stack_Size      : in     RTEMS.Unsigned32;
896      Attribute_Set   : in     RTEMS.Attribute;
897      Result          :    out RTEMS.Status_Codes
898   ) is
899      function Timer_Initiate_Server_Base (
900         Server_Priority : RTEMS.Task_Priority;
901         Stack_Size      : RTEMS.Unsigned32;
902         Attribute_Set   : RTEMS.Attribute
903      )  return RTEMS.Status_Codes;
904      pragma Import (
905         C,
906         Timer_Initiate_Server_Base,
907         "rtems_timer_initiate_server"
908      );
909   begin
910      Result := Timer_Initiate_Server_Base (
911         Server_Priority,
912         Stack_Size,
913         Attribute_Set
914      );
915   end Timer_Initiate_Server;
916
917   --
918   -- Semaphore Manager
919   --
920
921   procedure Semaphore_Create (
922      Name             : in     RTEMS.Name;
923      Count            : in     RTEMS.Unsigned32;
924      Attribute_Set    : in     RTEMS.Attribute;
925      Priority_Ceiling : in     RTEMS.Task_Priority;
926      ID               :    out RTEMS.ID;
927      Result           :    out RTEMS.Status_Codes
928   ) is
929      function Semaphore_Create_Base (
930         Name             : RTEMS.Name;
931         Count            : RTEMS.Unsigned32;
932         Attribute_Set    : RTEMS.Attribute;
933         Priority_Ceiling : RTEMS.Task_Priority;
934         ID               : access RTEMS.ID
935      )  return RTEMS.Status_Codes;
936      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
937      ID_Base : aliased RTEMS.ID;
938   begin
939
940      Result := Semaphore_Create_Base (
941         Name,
942         Count,
943         Attribute_Set,
944         Priority_Ceiling,
945         ID_Base'Access
946      );
947      ID := ID_Base;
948
949   end Semaphore_Create;
950
951   procedure Semaphore_Delete (
952      ID     : in     RTEMS.ID;
953      Result :    out RTEMS.Status_Codes
954   ) is
955      function Semaphore_Delete_Base (
956         ID : RTEMS.ID
957      )  return RTEMS.Status_Codes;
958      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
959   begin
960
961      Result := Semaphore_Delete_Base (ID);
962
963   end Semaphore_Delete;
964
965   procedure Semaphore_Ident (
966      Name   : in     RTEMS.Name;
967      Node   : in     RTEMS.Unsigned32;
968      ID     :    out RTEMS.ID;
969      Result :    out RTEMS.Status_Codes
970   ) is
971      function Semaphore_Ident_Base (
972         Name : RTEMS.Name;
973         Node : RTEMS.Unsigned32;
974         ID   : access RTEMS.ID
975      )  return RTEMS.Status_Codes;
976      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
977      ID_Base : aliased RTEMS.ID;
978   begin
979
980      Result := Semaphore_Ident_Base (Name, Node, ID_Base'Access);
981      ID := ID_Base;
982
983   end Semaphore_Ident;
984
985   procedure Semaphore_Obtain (
986      ID         : in     RTEMS.ID;
987      Option_Set : in     RTEMS.Option;
988      Timeout    : in     RTEMS.Interval;
989      Result     :    out RTEMS.Status_Codes
990   ) is
991      function Semaphore_Obtain_Base (
992         ID         : RTEMS.ID;
993         Option_Set : RTEMS.Option;
994         Timeout    : RTEMS.Interval
995      )  return RTEMS.Status_Codes;
996      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
997   begin
998
999      Result := Semaphore_Obtain_Base (ID, Option_Set, Timeout);
1000
1001   end Semaphore_Obtain;
1002
1003   procedure Semaphore_Release (
1004      ID     : in     RTEMS.ID;
1005      Result :    out RTEMS.Status_Codes
1006   ) is
1007      function Semaphore_Release_Base (
1008         ID : RTEMS.ID
1009      )  return RTEMS.Status_Codes;
1010      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
1011   begin
1012
1013      Result := Semaphore_Release_Base (ID);
1014
1015   end Semaphore_Release;
1016
1017   procedure Semaphore_Flush (
1018      ID     : in     RTEMS.ID;
1019      Result :    out RTEMS.Status_Codes
1020   ) is
1021      function Semaphore_Flush_Base (
1022         ID : RTEMS.ID
1023      )  return RTEMS.Status_Codes;
1024      pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
1025   begin
1026
1027      Result := Semaphore_Flush_Base (ID);
1028
1029   end Semaphore_Flush;
1030
1031   --
1032   -- Message Queue Manager
1033   --
1034
1035   procedure Message_Queue_Create (
1036      Name             : in     RTEMS.Name;
1037      Count            : in     RTEMS.Unsigned32;
1038      Max_Message_Size : in     RTEMS.Unsigned32;
1039      Attribute_Set    : in     RTEMS.Attribute;
1040      ID               :    out RTEMS.ID;
1041      Result           :    out RTEMS.Status_Codes
1042   ) is
1043      --  XXX broken
1044      function Message_Queue_Create_Base (
1045         Name             : RTEMS.Name;
1046         Count            : RTEMS.Unsigned32;
1047         Max_Message_Size : RTEMS.Unsigned32;
1048         Attribute_Set    : RTEMS.Attribute;
1049         ID               : access RTEMS.ID
1050      )  return RTEMS.Status_Codes;
1051      pragma Import (C,
1052        Message_Queue_Create_Base, "rtems_message_queue_create");
1053      ID_Base : aliased RTEMS.ID;
1054   begin
1055
1056      Result := Message_Queue_Create_Base (
1057         Name,
1058         Count,
1059         Max_Message_Size,
1060         Attribute_Set,
1061         ID_Base'Access
1062      );
1063      ID := ID_Base;
1064
1065   end Message_Queue_Create;
1066
1067   procedure Message_Queue_Ident (
1068      Name   : in     RTEMS.Name;
1069      Node   : in     RTEMS.Unsigned32;
1070      ID     :    out RTEMS.ID;
1071      Result :    out RTEMS.Status_Codes
1072   ) is
1073      function Message_Queue_Ident_Base (
1074         Name : RTEMS.Name;
1075         Node : RTEMS.Unsigned32;
1076         ID   : access RTEMS.ID
1077      )  return RTEMS.Status_Codes;
1078      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
1079      ID_Base : aliased RTEMS.ID;
1080   begin
1081
1082      Result :=
1083         Message_Queue_Ident_Base (Name, Node, ID_Base'Access);
1084      ID := ID_Base;
1085
1086   end Message_Queue_Ident;
1087
1088   procedure Message_Queue_Delete (
1089      ID     : in     RTEMS.ID;
1090      Result :    out RTEMS.Status_Codes
1091   ) is
1092      function Message_Queue_Delete_Base (
1093         ID : RTEMS.ID
1094      )  return RTEMS.Status_Codes;
1095      pragma Import (
1096         C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
1097   begin
1098
1099      Result := Message_Queue_Delete_Base (ID);
1100
1101   end Message_Queue_Delete;
1102
1103   procedure Message_Queue_Send (
1104      ID     : in     RTEMS.ID;
1105      Buffer : in     RTEMS.Address;
1106      Size   : in     RTEMS.Unsigned32;
1107      Result :    out RTEMS.Status_Codes
1108   ) is
1109      function Message_Queue_Send_Base (
1110         ID     : RTEMS.ID;
1111         Buffer : RTEMS.Address;
1112         Size   : RTEMS.Unsigned32
1113      )  return RTEMS.Status_Codes;
1114      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
1115   begin
1116
1117      Result := Message_Queue_Send_Base (ID, Buffer, Size);
1118
1119   end Message_Queue_Send;
1120
1121   procedure Message_Queue_Urgent (
1122      ID     : in     RTEMS.ID;
1123      Buffer : in     RTEMS.Address;
1124      Size   : in     RTEMS.Unsigned32;
1125      Result :    out RTEMS.Status_Codes
1126   ) is
1127      function Message_Queue_Urgent_Base (
1128         ID     : RTEMS.ID;
1129         Buffer : RTEMS.Address;
1130         Size   : RTEMS.Unsigned32
1131      )  return RTEMS.Status_Codes;
1132      pragma Import (C, Message_Queue_Urgent_Base,
1133         "rtems_message_queue_urgent");
1134   begin
1135
1136      Result := Message_Queue_Urgent_Base (ID, Buffer, Size);
1137
1138   end Message_Queue_Urgent;
1139
1140   procedure Message_Queue_Broadcast (
1141      ID     : in     RTEMS.ID;
1142      Buffer : in     RTEMS.Address;
1143      Size   : in     RTEMS.Unsigned32;
1144      Count  :    out RTEMS.Unsigned32;
1145      Result :    out RTEMS.Status_Codes
1146   ) is
1147      function Message_Queue_Broadcast_Base (
1148         ID     : RTEMS.ID;
1149         Buffer : RTEMS.Address;
1150         Size   : RTEMS.Unsigned32;
1151         Count  : access RTEMS.Unsigned32
1152      )  return RTEMS.Status_Codes;
1153      pragma Import (C, Message_Queue_Broadcast_Base,
1154         "rtems_message_queue_broadcast");
1155      Count_Base : aliased RTEMS.Unsigned32;
1156   begin
1157
1158      Result := Message_Queue_Broadcast_Base (
1159         ID,
1160         Buffer,
1161         Size,
1162         Count_Base'Access
1163     );
1164      Count := Count_Base;
1165
1166   end Message_Queue_Broadcast;
1167
1168   procedure Message_Queue_Receive (
1169      ID         : in     RTEMS.ID;
1170      Buffer     : in     RTEMS.Address;
1171      Option_Set : in     RTEMS.Option;
1172      Timeout    : in     RTEMS.Interval;
1173      Size       : in out RTEMS.Unsigned32;
1174      Result     :    out RTEMS.Status_Codes
1175   ) is
1176      function Message_Queue_Receive_Base (
1177         ID         : RTEMS.ID;
1178         Buffer     : RTEMS.Address;
1179         Size       : access RTEMS.Unsigned32;
1180         Option_Set : RTEMS.Option;
1181         Timeout    : RTEMS.Interval
1182      )  return RTEMS.Status_Codes;
1183      pragma Import (C, Message_Queue_Receive_Base,
1184         "rtems_message_queue_receive");
1185      Size_Base : aliased RTEMS.Unsigned32;
1186   begin
1187
1188      Size_Base := Size;
1189
1190      Result := Message_Queue_Receive_Base (
1191         ID,
1192         Buffer,
1193         Size_Base'Access,
1194         Option_Set,
1195         Timeout
1196      );
1197      Size := Size_Base;
1198
1199   end Message_Queue_Receive;
1200
1201   procedure Message_Queue_Get_Number_Pending (
1202      ID     : in     RTEMS.ID;
1203      Count  :    out RTEMS.Unsigned32;
1204      Result :    out RTEMS.Status_Codes
1205   ) is
1206      function Message_Queue_Get_Number_Pending_Base (
1207         ID    : RTEMS.ID;
1208         Count : access RTEMS.Unsigned32
1209      )  return RTEMS.Status_Codes;
1210      pragma Import (
1211         C,
1212         Message_Queue_Get_Number_Pending_Base,
1213         "rtems_message_queue_get_number_pending"
1214      );
1215      COUNT_Base : aliased RTEMS.Unsigned32;
1216   begin
1217
1218      Result := Message_Queue_Get_Number_Pending_Base (
1219         ID, COUNT_Base'Access
1220      );
1221      Count := COUNT_Base;
1222
1223   end Message_Queue_Get_Number_Pending;
1224
1225   procedure Message_Queue_Flush (
1226      ID     : in     RTEMS.ID;
1227      Count  :    out RTEMS.Unsigned32;
1228      Result :    out RTEMS.Status_Codes
1229   ) is
1230      function Message_Queue_Flush_Base (
1231         ID    : RTEMS.ID;
1232         Count : access RTEMS.Unsigned32
1233      )  return RTEMS.Status_Codes;
1234      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1235      COUNT_Base : aliased RTEMS.Unsigned32;
1236   begin
1237
1238      Result := Message_Queue_Flush_Base (ID, COUNT_Base'Access);
1239      Count := COUNT_Base;
1240
1241   end Message_Queue_Flush;
1242
1243   --
1244   -- Event Manager
1245   --
1246
1247   procedure Event_Send (
1248      ID       : in     RTEMS.ID;
1249      Event_In : in     RTEMS.Event_Set;
1250      Result   :    out RTEMS.Status_Codes
1251   ) is
1252      function Event_Send_Base (
1253         ID       : RTEMS.ID;
1254         Event_In : RTEMS.Event_Set
1255      )  return RTEMS.Status_Codes;
1256      pragma Import (C, Event_Send_Base, "rtems_event_send");
1257   begin
1258
1259      Result := Event_Send_Base (ID, Event_In);
1260
1261   end Event_Send;
1262
1263   procedure Event_Receive (
1264      Event_In   : in     RTEMS.Event_Set;
1265      Option_Set : in     RTEMS.Option;
1266      Ticks      : in     RTEMS.Interval;
1267      Event_Out  :    out RTEMS.Event_Set;
1268      Result     :    out RTEMS.Status_Codes
1269   ) is
1270      function Event_Receive_Base (
1271         Event_In   : RTEMS.Event_Set;
1272         Option_Set : RTEMS.Option;
1273         Ticks      : RTEMS.Interval;
1274         Event_Out  : access RTEMS.Event_Set
1275      )  return RTEMS.Status_Codes;
1276      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1277      Event_Out_Base : aliased RTEMS.Event_Set;
1278   begin
1279
1280      Result := Event_Receive_Base (
1281         Event_In,
1282         Option_Set,
1283         Ticks,
1284         Event_Out_Base'Access
1285      );
1286      Event_Out := Event_Out_Base;
1287
1288   end Event_Receive;
1289
1290   --
1291   -- Signal Manager
1292   --
1293
1294   procedure Signal_Catch (
1295      ASR_Handler : in     RTEMS.ASR_Handler;
1296      Mode_Set    : in     RTEMS.Mode;
1297      Result      :    out RTEMS.Status_Codes
1298   ) is
1299      function Signal_Catch_Base (
1300         ASR_Handler : RTEMS.ASR_Handler;
1301         Mode_Set    : RTEMS.Mode
1302      )  return RTEMS.Status_Codes;
1303      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1304   begin
1305
1306      Result := Signal_Catch_Base (ASR_Handler, Mode_Set);
1307
1308   end Signal_Catch;
1309
1310   procedure Signal_Send (
1311      ID         : in     RTEMS.ID;
1312      Signal_Set : in     RTEMS.Signal_Set;
1313      Result     :    out RTEMS.Status_Codes
1314   ) is
1315      function Signal_Send_Base (
1316         ID         : RTEMS.ID;
1317         Signal_Set : RTEMS.Signal_Set
1318      )  return RTEMS.Status_Codes;
1319      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1320   begin
1321
1322      Result := Signal_Send_Base (ID, Signal_Set);
1323
1324   end Signal_Send;
1325
1326
1327   --
1328   -- Partition Manager
1329   --
1330
1331   procedure Partition_Create (
1332      Name             : in     RTEMS.Name;
1333      Starting_Address : in     RTEMS.Address;
1334      Length           : in     RTEMS.Unsigned32;
1335      Buffer_Size      : in     RTEMS.Unsigned32;
1336      Attribute_Set    : in     RTEMS.Attribute;
1337      ID               :    out RTEMS.ID;
1338      Result           :    out RTEMS.Status_Codes
1339   ) is
1340      function Partition_Create_Base (
1341         Name             : RTEMS.Name;
1342         Starting_Address : RTEMS.Address;
1343         Length           : RTEMS.Unsigned32;
1344         Buffer_Size      : RTEMS.Unsigned32;
1345         Attribute_Set    : RTEMS.Attribute;
1346         ID               : access RTEMS.Event_Set
1347      )  return RTEMS.Status_Codes;
1348      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1349      ID_Base : aliased RTEMS.ID;
1350   begin
1351
1352      Result := Partition_Create_Base (
1353         Name,
1354         Starting_Address,
1355         Length,
1356         Buffer_Size,
1357         Attribute_Set,
1358         ID_Base'Access
1359      );
1360      ID := ID_Base;
1361
1362   end Partition_Create;
1363
1364   procedure Partition_Ident (
1365      Name   : in     RTEMS.Name;
1366      Node   : in     RTEMS.Unsigned32;
1367      ID     :    out RTEMS.ID;
1368      Result :    out RTEMS.Status_Codes
1369   ) is
1370      function Partition_Ident_Base (
1371         Name : RTEMS.Name;
1372         Node : RTEMS.Unsigned32;
1373         ID   : access RTEMS.Event_Set
1374      )  return RTEMS.Status_Codes;
1375      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1376      ID_Base : aliased RTEMS.ID;
1377   begin
1378
1379      Result := Partition_Ident_Base (Name, Node, ID_Base'Access);
1380      ID := ID_Base;
1381
1382   end Partition_Ident;
1383
1384   procedure Partition_Delete (
1385      ID     : in     RTEMS.ID;
1386      Result :    out RTEMS.Status_Codes
1387   ) is
1388      function Partition_Delete_Base (
1389         ID : RTEMS.ID
1390      )  return RTEMS.Status_Codes;
1391      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1392   begin
1393
1394      Result := Partition_Delete_Base (ID);
1395
1396   end Partition_Delete;
1397
1398   procedure Partition_Get_Buffer (
1399      ID     : in     RTEMS.ID;
1400      Buffer :    out RTEMS.Address;
1401      Result :    out RTEMS.Status_Codes
1402   ) is
1403      function Partition_Get_Buffer_Base (
1404         ID     : RTEMS.ID;
1405         Buffer : access RTEMS.Address
1406      )  return RTEMS.Status_Codes;
1407      pragma Import (C, Partition_Get_Buffer_Base,
1408         "rtems_partition_get_buffer");
1409      Buffer_Base : aliased RTEMS.Address;
1410   begin
1411
1412      Result := Partition_Get_Buffer_Base (ID, Buffer_Base'Access);
1413      Buffer := Buffer_Base;
1414
1415   end Partition_Get_Buffer;
1416
1417   procedure Partition_Return_Buffer (
1418      ID     : in     RTEMS.ID;
1419      Buffer : in     RTEMS.Address;
1420      Result :    out RTEMS.Status_Codes
1421   ) is
1422      function Partition_Return_Buffer_Base (
1423         ID     : RTEMS.Name;
1424         Buffer : RTEMS.Address
1425      )  return RTEMS.Status_Codes;
1426      pragma Import (C, Partition_Return_Buffer_Base,
1427         "rtems_partition_return_buffer");
1428   begin
1429
1430      Result := Partition_Return_Buffer_Base (ID, Buffer);
1431
1432   end Partition_Return_Buffer;
1433
1434   --
1435   -- Region Manager
1436   --
1437
1438   procedure Region_Create (
1439      Name             : in     RTEMS.Name;
1440      Starting_Address : in     RTEMS.Address;
1441      Length           : in     RTEMS.Unsigned32;
1442      Page_Size        : in     RTEMS.Unsigned32;
1443      Attribute_Set    : in     RTEMS.Attribute;
1444      ID               :    out RTEMS.ID;
1445      Result           :    out RTEMS.Status_Codes
1446   ) is
1447      function Region_Create_Base (
1448         Name             : RTEMS.Name;
1449         Starting_Address : RTEMS.Address;
1450         Length           : RTEMS.Unsigned32;
1451         Page_Size        : RTEMS.Unsigned32;
1452         Attribute_Set    : RTEMS.Attribute;
1453         ID               : access RTEMS.ID
1454      )  return RTEMS.Status_Codes;
1455      pragma Import (C, Region_Create_Base, "rtems_region_create");
1456      ID_Base : aliased RTEMS.ID;
1457   begin
1458
1459      Result := Region_Create_Base (
1460         Name,
1461         Starting_Address,
1462         Length,
1463         Page_Size,
1464         Attribute_Set,
1465         ID_Base'Access
1466      );
1467      ID := ID_Base;
1468
1469   end Region_Create;
1470
1471   procedure Region_Ident (
1472      Name   : in     RTEMS.Name;
1473      ID     :    out RTEMS.ID;
1474      Result :    out RTEMS.Status_Codes
1475   ) is
1476      function Region_Ident_Base (
1477         Name   : RTEMS.Name;
1478         ID     : access RTEMS.ID
1479      )  return RTEMS.Status_Codes;
1480      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1481      ID_Base : aliased RTEMS.ID;
1482   begin
1483
1484      Result := Region_Ident_Base (Name, ID_Base'Access);
1485      ID := ID_Base;
1486
1487   end Region_Ident;
1488
1489   procedure Region_Delete (
1490      ID     : in     RTEMS.ID;
1491      Result :    out RTEMS.Status_Codes
1492   ) is
1493      function Region_Delete_Base (
1494         ID : RTEMS.ID
1495      )  return RTEMS.Status_Codes;
1496      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1497   begin
1498
1499      Result := Region_Delete_Base (ID);
1500
1501   end Region_Delete;
1502
1503   procedure Region_Extend (
1504      ID               : in     RTEMS.ID;
1505      Starting_Address : in     RTEMS.Address;
1506      Length           : in     RTEMS.Unsigned32;
1507      Result           :    out RTEMS.Status_Codes
1508   ) is
1509      function Region_Extend_Base (
1510         ID               : RTEMS.ID;
1511         Starting_Address : RTEMS.Address;
1512         Length           : RTEMS.Unsigned32
1513      )  return RTEMS.Status_Codes;
1514      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1515   begin
1516
1517      Result := Region_Extend_Base (ID, Starting_Address, Length);
1518
1519   end Region_Extend;
1520
1521   procedure Region_Get_Segment (
1522      ID         : in     RTEMS.ID;
1523      Size       : in     RTEMS.Unsigned32;
1524      Option_Set : in     RTEMS.Option;
1525      Timeout    : in     RTEMS.Interval;
1526      Segment    :    out RTEMS.Address;
1527      Result     :    out RTEMS.Status_Codes
1528   ) is
1529      function Region_Get_Segment_Base (
1530         ID         : RTEMS.ID;
1531         Size       : RTEMS.Unsigned32;
1532         Option_Set : RTEMS.Option;
1533         Timeout    : RTEMS.Interval;
1534         Segment    : access RTEMS.Address
1535      )  return RTEMS.Status_Codes;
1536      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1537      Segment_Base : aliased RTEMS.Address;
1538   begin
1539
1540      Result := Region_Get_Segment_Base (
1541         ID,
1542         Size,
1543         Option_Set,
1544         Timeout,
1545         Segment_Base'Access
1546      );
1547      Segment := SEGMENT_Base;
1548
1549   end Region_Get_Segment;
1550
1551   procedure Region_Get_Segment_Size (
1552      ID      : in     RTEMS.ID;
1553      Segment : in     RTEMS.Address;
1554      Size    :    out RTEMS.Unsigned32;
1555      Result  :    out RTEMS.Status_Codes
1556   ) is
1557      function Region_Get_Segment_Size_Base (
1558         ID      : RTEMS.ID;
1559         Segment : RTEMS.Address;
1560         Size    : access RTEMS.Unsigned32
1561      )  return RTEMS.Status_Codes;
1562      pragma Import (C, Region_Get_Segment_Size_Base,
1563         "rtems_region_get_segment_size");
1564      Size_Base : aliased RTEMS.Unsigned32;
1565   begin
1566
1567      Result := Region_Get_Segment_Size_Base (
1568         ID,
1569         Segment,
1570         Size_Base'Access
1571      );
1572      Size := SIZE_Base;
1573
1574   end Region_Get_Segment_Size;
1575
1576   procedure Region_Return_Segment (
1577      ID      : in     RTEMS.ID;
1578      Segment : in     RTEMS.Address;
1579      Result  :    out RTEMS.Status_Codes
1580   ) is
1581      function Region_Return_Segment_Base (
1582         ID      : RTEMS.ID;
1583         Segment : RTEMS.Address
1584      )  return RTEMS.Status_Codes;
1585      pragma Import (C, Region_Return_Segment_Base,
1586         "rtems_region_return_segment");
1587   begin
1588
1589      Result := Region_Return_Segment_Base (ID, Segment);
1590
1591   end Region_Return_Segment;
1592
1593   procedure Region_Resize_Segment (
1594      ID         : in     RTEMS.ID;
1595      Segment    : in     RTEMS.Address;
1596      Size       : in     RTEMS.Unsigned32;
1597      Old_Size   :    out RTEMS.Unsigned32;
1598      Result     :    out RTEMS.Status_Codes
1599   ) is
1600      function Region_Resize_Segment_Base (
1601         ID       : RTEMS.ID;
1602         Segment  : RTEMS.Address;
1603         Size     : RTEMS.Unsigned32;
1604         Old_Size : access RTEMS.Unsigned32
1605      )  return RTEMS.Status_Codes;
1606      pragma Import (C, Region_Resize_Segment_Base,
1607         "rtems_region_resize_segment");
1608      Old_Size_Base : aliased RTEMS.Unsigned32;
1609   begin
1610
1611      Result := Region_Resize_Segment_Base (
1612         ID,
1613         Segment,
1614         Size,
1615         Old_Size_Base'Access
1616      );
1617      Old_Size := Old_Size_Base;
1618
1619   end Region_Resize_Segment;
1620
1621   --
1622   -- Dual Ported Memory Manager
1623   --
1624
1625   procedure Port_Create (
1626      Name           : in     RTEMS.Name;
1627      Internal_Start : in     RTEMS.Address;
1628      External_Start : in     RTEMS.Address;
1629      Length         : in     RTEMS.Unsigned32;
1630      ID             :    out RTEMS.ID;
1631      Result         :    out RTEMS.Status_Codes
1632   ) is
1633      function Port_Create_Base (
1634         Name           : RTEMS.Name;
1635         Internal_Start : RTEMS.Address;
1636         External_Start : RTEMS.Address;
1637         Length         : RTEMS.Unsigned32;
1638         ID             : access RTEMS.ID
1639      )  return RTEMS.Status_Codes;
1640      pragma Import (C, Port_Create_Base, "rtems_port_create");
1641      ID_Base : aliased RTEMS.ID;
1642   begin
1643
1644      Result := Port_Create_Base (
1645         Name,
1646         Internal_Start,
1647         External_Start,
1648         Length,
1649         ID_Base'Access
1650      );
1651      ID := ID_Base;
1652
1653   end Port_Create;
1654
1655   procedure Port_Ident (
1656      Name   : in     RTEMS.Name;
1657      ID     :    out RTEMS.ID;
1658      Result :    out RTEMS.Status_Codes
1659   ) is
1660      function Port_Ident_Base (
1661         Name : RTEMS.Name;
1662         ID   : access RTEMS.ID
1663      )  return RTEMS.Status_Codes;
1664      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1665      ID_Base : aliased RTEMS.ID;
1666   begin
1667
1668      Result := Port_Ident_Base (Name, ID_Base'Access);
1669      ID := ID_Base;
1670
1671   end Port_Ident;
1672
1673   procedure Port_Delete (
1674      ID     : in     RTEMS.ID;
1675      Result :    out RTEMS.Status_Codes
1676   ) is
1677      function Port_Delete_Base (
1678         ID : RTEMS.ID
1679      )  return RTEMS.Status_Codes;
1680      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1681   begin
1682
1683      Result := Port_Delete_Base (ID);
1684
1685   end Port_Delete;
1686
1687   procedure Port_External_To_Internal (
1688      ID       : in     RTEMS.ID;
1689      External : in     RTEMS.Address;
1690      Internal :    out RTEMS.Address;
1691      Result   :    out RTEMS.Status_Codes
1692   ) is
1693      function Port_External_To_Internal_Base (
1694         ID       : RTEMS.ID;
1695         External : RTEMS.Address;
1696         Internal : access RTEMS.Address
1697      )  return RTEMS.Status_Codes;
1698      pragma Import (C, Port_External_To_Internal_Base,
1699         "rtems_port_external_to_internal");
1700      Internal_Base : aliased RTEMS.Address;
1701   begin
1702
1703      Result := Port_External_To_Internal_Base (
1704         ID,
1705         External,
1706         Internal_Base'Access
1707      );
1708      Internal := INTERNAL_Base;
1709
1710   end Port_External_To_Internal;
1711
1712   procedure Port_Internal_To_External (
1713      ID       : in     RTEMS.ID;
1714      Internal : in     RTEMS.Address;
1715      External :    out RTEMS.Address;
1716      Result   :    out RTEMS.Status_Codes
1717   ) is
1718      function Port_Internal_To_External_Base (
1719         ID       : RTEMS.ID;
1720         Internal : RTEMS.Address;
1721         External : access RTEMS.Address
1722      )  return RTEMS.Status_Codes;
1723      pragma Import (C, Port_Internal_To_External_Base,
1724         "rtems_port_internal_to_external");
1725      External_Base : aliased RTEMS.Address;
1726   begin
1727
1728      Result := Port_Internal_To_External_Base (
1729         ID,
1730         Internal,
1731         External_Base'Access
1732      );
1733      External := EXTERNAL_Base;
1734
1735   end Port_Internal_To_External;
1736
1737
1738   --
1739   -- Fatal Error Manager
1740   --
1741
1742   procedure Fatal_Error_Occurred (
1743      The_Error : in     RTEMS.Unsigned32
1744   ) is
1745      procedure Fatal_Error_Occurred_Base (
1746         The_Error : RTEMS.Unsigned32
1747      );
1748   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1749   begin
1750
1751      Fatal_Error_Occurred_Base (The_Error);
1752
1753   end Fatal_Error_Occurred;
1754
1755
1756   --
1757   -- Rate Monotonic Manager
1758   --
1759
1760   procedure Rate_Monotonic_Create (
1761      Name   : in     RTEMS.Name;
1762      ID     :    out RTEMS.ID;
1763      Result :    out RTEMS.Status_Codes
1764   ) is
1765      function Rate_Monotonic_Create_Base (
1766         Name   : RTEMS.Name;
1767         ID     : access RTEMS.ID
1768      )  return RTEMS.Status_Codes;
1769      pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create");
1770      ID_Base : aliased RTEMS.ID;
1771   begin
1772
1773      Result := Rate_Monotonic_Create_Base (Name, ID_Base'Access);
1774      ID := ID_Base;
1775
1776   end Rate_Monotonic_Create;
1777
1778   procedure Rate_Monotonic_Ident (
1779      Name   : in     RTEMS.Name;
1780      ID     :    out RTEMS.ID;
1781      Result :    out RTEMS.Status_Codes
1782   ) is
1783      function Rate_Monotonic_Ident_Base (
1784         Name   : RTEMS.Name;
1785         ID     : access RTEMS.ID
1786      )  return RTEMS.Status_Codes;
1787      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1788      ID_Base : aliased RTEMS.ID;
1789   begin
1790
1791      Result := Rate_Monotonic_Ident_Base (Name, ID_Base'Access);
1792
1793      ID := ID_Base;
1794
1795   end Rate_Monotonic_Ident;
1796
1797   procedure Rate_Monotonic_Delete (
1798      ID     : in     RTEMS.ID;
1799      Result :    out RTEMS.Status_Codes
1800   ) is
1801      function Rate_Monotonic_Delete_Base (
1802         ID : RTEMS.ID
1803      )  return RTEMS.Status_Codes;
1804      pragma Import (C, Rate_Monotonic_Delete_Base,
1805         "rtems_rate_monotonic_delete");
1806   begin
1807
1808      Result := Rate_Monotonic_Delete_Base (ID);
1809
1810   end Rate_Monotonic_Delete;
1811
1812   procedure Rate_Monotonic_Cancel (
1813      ID     : in     RTEMS.ID;
1814      Result :    out RTEMS.Status_Codes
1815   ) is
1816      function Rate_Monotonic_Cancel_Base (
1817         ID : RTEMS.ID
1818      )  return RTEMS.Status_Codes;
1819      pragma Import (C, Rate_Monotonic_Cancel_Base,
1820         "rtems_rate_monotonic_cancel");
1821   begin
1822
1823      Result := Rate_Monotonic_Cancel_Base (ID);
1824
1825   end Rate_Monotonic_Cancel;
1826
1827   procedure Rate_Monotonic_Period (
1828      ID      : in     RTEMS.ID;
1829      Length  : in     RTEMS.Interval;
1830      Result  :    out RTEMS.Status_Codes
1831   ) is
1832      function Rate_Monotonic_Period_Base (
1833         ID     : RTEMS.ID;
1834         Length : RTEMS.Interval
1835      )  return RTEMS.Status_Codes;
1836      pragma Import (C, Rate_Monotonic_Period_Base,
1837         "rtems_rate_monotonic_period");
1838   begin
1839
1840      Result := Rate_Monotonic_Period_Base (ID, Length);
1841
1842   end Rate_Monotonic_Period;
1843
1844   procedure Rate_Monotonic_Get_Status (
1845      ID      : in     RTEMS.ID;
1846      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1847      Result  :    out RTEMS.Status_Codes
1848   ) is
1849      function Rate_Monotonic_Get_Status_Base (
1850         ID      : RTEMS.ID;
1851         Status  : access RTEMS.Rate_Monotonic_Period_Status
1852      )  return RTEMS.Status_Codes;
1853      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1854         "rtems_rate_monotonic_get_status");
1855
1856      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1857   begin
1858
1859      Result := Rate_Monotonic_Get_Status_Base (
1860         ID,
1861         Status_Base'Access
1862      );
1863
1864      Status := Status_Base;
1865
1866
1867   end Rate_Monotonic_Get_Status;
1868
1869   procedure Rate_Monotonic_Reset_Statistics (
1870      ID     : in     RTEMS.ID;
1871      Result :    out RTEMS.Status_Codes
1872   ) is
1873      function Rate_Monotonic_Reset_Statistics_Base (
1874         ID : RTEMS.ID
1875      )  return RTEMS.Status_Codes;
1876      pragma Import (C, Rate_Monotonic_Reset_Statistics_Base,
1877         "rtems_rate_monotonic_reset_statistics");
1878   begin
1879
1880      Result := Rate_Monotonic_Reset_Statistics_Base (ID);
1881
1882   end Rate_Monotonic_Reset_Statistics;
1883
1884
1885   --
1886   -- Barrier Manager
1887   --
1888
1889   procedure Barrier_Create (
1890      Name            : in     RTEMS.Name;
1891      Attribute_Set   : in     RTEMS.Attribute;
1892      Maximum_Waiters : in     RTEMS.Unsigned32;
1893      ID              :    out RTEMS.ID;
1894      Result          :    out RTEMS.Status_Codes
1895   ) is
1896      function Barrier_Create_Base (
1897         Name            : RTEMS.Name;
1898         Attribute_Set   : RTEMS.Attribute;
1899         Maximum_Waiters : RTEMS.Unsigned32;
1900         ID              : access RTEMS.ID
1901      )  return RTEMS.Status_Codes;
1902      pragma Import (C, Barrier_Create_Base, "rtems_barrier_create");
1903      ID_Base : aliased RTEMS.ID;
1904   begin
1905
1906      Result := Barrier_Create_Base (
1907         Name,
1908         Attribute_Set,
1909         Maximum_Waiters,
1910         ID_Base'Access
1911      );
1912      ID := ID_Base;
1913
1914   end Barrier_Create;
1915
1916   procedure Barrier_Ident (
1917      Name   : in     RTEMS.Name;
1918      ID     :    out RTEMS.ID;
1919      Result :    out RTEMS.Status_Codes
1920   ) is
1921      function Barrier_Ident_Base (
1922         Name : RTEMS.Name;
1923         ID   : access RTEMS.ID
1924      )  return RTEMS.Status_Codes;
1925      pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident");
1926      ID_Base : aliased RTEMS.ID;
1927   begin
1928
1929      Result := Barrier_Ident_Base (Name, ID_Base'Access);
1930      ID := ID_Base;
1931
1932   end Barrier_Ident;
1933
1934   procedure Barrier_Delete (
1935      ID     : in     RTEMS.ID;
1936      Result :    out RTEMS.Status_Codes
1937   ) is
1938      function Barrier_Delete_Base (
1939         ID : RTEMS.ID
1940      )  return RTEMS.Status_Codes;
1941      pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
1942   begin
1943
1944      Result := Barrier_Delete_Base (ID);
1945
1946   end Barrier_Delete;
1947
1948   procedure Barrier_Wait (
1949      ID         : in     RTEMS.ID;
1950      Timeout    : in     RTEMS.Interval;
1951      Result     :    out RTEMS.Status_Codes
1952   ) is
1953      function Barrier_Wait_Base (
1954         ID         : RTEMS.ID;
1955         Timeout    : RTEMS.Interval
1956      )  return RTEMS.Status_Codes;
1957      pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
1958   begin
1959
1960      Result := Barrier_Wait_Base (ID, Timeout);
1961
1962   end Barrier_Wait;
1963
1964   procedure Barrier_Release (
1965      ID       : in     RTEMS.ID;
1966      Released :    out RTEMS.Unsigned32;
1967      Result   :    out RTEMS.Status_Codes
1968   ) is
1969      function Barrier_Release_Base (
1970         ID       : RTEMS.ID;
1971         Released : access RTEMS.Unsigned32
1972      )  return RTEMS.Status_Codes;
1973      pragma Import (C, Barrier_Release_Base, "rtems_barrier_release");
1974      Released_Base : aliased RTEMS.Unsigned32;
1975   begin
1976
1977      Result := Barrier_Release_Base (ID, Released_Base'Access);
1978      Released := Released_Base;
1979
1980   end Barrier_Release;
1981
1982
1983   --
1984   -- Debug Manager
1985   --
1986
1987   procedure Debug_Enable (
1988      To_Be_Enabled : in     RTEMS.Debug_Set
1989   ) is
1990      procedure Debug_Enable_Base (
1991         To_Be_Enabled : RTEMS.Debug_Set
1992      );
1993   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
1994   begin
1995
1996      Debug_Enable_Base (To_Be_Enabled);
1997
1998   end Debug_Enable;
1999
2000   procedure Debug_Disable (
2001      To_Be_Disabled : in     RTEMS.Debug_Set
2002   ) is
2003      procedure Debug_Disable_Base (
2004         To_Be_Disabled : RTEMS.Debug_Set
2005      );
2006   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
2007   begin
2008
2009      Debug_Disable_Base (To_Be_Disabled);
2010
2011   end Debug_Disable;
2012
2013   function Debug_Is_Enabled (
2014      Level : in     RTEMS.Debug_Set
2015   ) return RTEMS.Boolean is
2016      function Debug_Is_Enabled_Base (
2017         Level : RTEMS.Debug_Set
2018      )  return RTEMS.Boolean;
2019      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
2020   begin
2021
2022      return Debug_Is_Enabled_Base (Level);
2023
2024   end Debug_Is_Enabled;
2025
2026   --
2027   --  Object Services
2028   --
2029
2030   function Build_Name (
2031      C1 : in     Character;
2032      C2 : in     Character;
2033      C3 : in     Character;
2034      C4 : in     Character
2035   ) return RTEMS.Name is
2036      C1_Value : RTEMS.Unsigned32;
2037      C2_Value : RTEMS.Unsigned32;
2038      C3_Value : RTEMS.Unsigned32;
2039      C4_Value : RTEMS.Unsigned32;
2040   begin
2041
2042     C1_Value := Character'Pos( C1 );
2043     C2_Value := Character'Pos( C2 );
2044     C3_Value := Character'Pos( C3 );
2045     C4_Value := Character'Pos( C4 );
2046
2047     return Interfaces.Shift_Left( C1_Value, 24 ) or
2048            Interfaces.Shift_Left( C2_Value, 16 ) or
2049            Interfaces.Shift_Left( C3_Value, 8 )  or
2050            C4_Value;
2051
2052   end Build_Name;
2053
2054   procedure Object_Get_Classic_Name(
2055      ID     : in     RTEMS.ID;
2056      Name   :    out RTEMS.Name;
2057      Result :    out RTEMS.Status_Codes
2058   ) is
2059      function Object_Get_Classic_Name_Base (
2060         ID   : RTEMS.ID;
2061         Name : access RTEMS.Name
2062      )  return RTEMS.Status_Codes;
2063      pragma Import
2064         (C, Object_Get_Classic_Name_Base, "rtems_object_get_classic_name");
2065      Tmp_Name : aliased RTEMS.Name;
2066   begin
2067      Result := Object_Get_Classic_Name_Base (ID, Tmp_Name'Access);
2068      Name := Tmp_Name;
2069   end Object_Get_Classic_Name;
2070
2071
2072   procedure Object_Get_Name(
2073      ID     : in     RTEMS.ID;
2074      Name   :    out String;
2075      Result :    out RTEMS.Address
2076   ) is
2077      function Object_Get_Name_Base (
2078         ID     : RTEMS.ID;
2079         Length : RTEMS.Unsigned32;
2080         Name   : RTEMS.Address
2081      )  return RTEMS.Address;
2082      pragma Import (C, Object_Get_Name_Base, "rtems_object_get_name");
2083   begin
2084      Name := (others => ASCII.Nul);
2085      Result := Object_Get_Name_Base (
2086         Id,
2087         Name'Length,
2088         Name(Name'First)'Address
2089      );
2090   end Object_Get_Name;
2091
2092   procedure Object_Set_Name(
2093      ID     : in     RTEMS.ID;
2094      Name   : in     String;
2095      Result :    out RTEMS.Status_Codes
2096   ) is
2097      function Object_Set_Name_Base (
2098         ID     : RTEMS.ID;
2099         Name   : chars_ptr
2100      )  return RTEMS.Status_Codes;
2101      pragma Import (C, Object_Set_Name_Base, "rtems_object_set_name");
2102      NameAsCString : chars_ptr := New_String(Name);
2103   begin
2104      Result := Object_Set_Name_Base (ID, NameAsCString);
2105   end Object_Set_Name;
2106
2107   procedure Object_Id_Get_API(
2108      ID  : in     RTEMS.ID;
2109      API :    out RTEMS.Unsigned32
2110   ) is
2111      function Object_Id_Get_API_Base (
2112         ID     : RTEMS.ID
2113      )  return RTEMS.Unsigned32;
2114      pragma Import (C, Object_Id_Get_API_Base, "rtems_object_id_get_api");
2115   begin
2116      API := Object_Id_Get_API_Base (ID);
2117   end Object_Id_Get_API;
2118
2119   procedure Object_Id_Get_Class(
2120      ID        : in     RTEMS.ID;
2121      The_Class :    out RTEMS.Unsigned32
2122   ) is
2123      function Object_Id_Get_Class_Base (
2124         ID : RTEMS.ID
2125      )  return RTEMS.Unsigned32;
2126      pragma Import (C, Object_Id_Get_Class_Base, "rtems_object_id_get_class");
2127   begin
2128      The_Class := Object_Id_Get_Class_Base (ID);
2129   end Object_Id_Get_Class;
2130
2131   procedure Object_Id_Get_Node(
2132      ID   : in     RTEMS.ID;
2133      Node :    out RTEMS.Unsigned32
2134   ) is
2135      function Object_Id_Get_Node_Base (
2136         ID     : RTEMS.ID
2137      )  return RTEMS.Unsigned32;
2138      pragma Import (C, Object_Id_Get_Node_Base, "rtems_object_id_get_node");
2139   begin
2140      Node := Object_Id_Get_Node_Base (ID);
2141   end Object_Id_Get_Node;
2142
2143   procedure Object_Id_Get_Index(
2144      ID    : in     RTEMS.ID;
2145      Index :    out RTEMS.Unsigned32
2146   ) is
2147      function Object_Id_Get_Index_Base (
2148         ID     : RTEMS.ID
2149      )  return RTEMS.Unsigned32;
2150      pragma Import (C, Object_Id_Get_Index_Base, "rtems_object_id_get_index");
2151   begin
2152      Index := Object_Id_Get_Index_Base (ID);
2153   end Object_Id_Get_Index;
2154
2155   function Build_Id(
2156      The_API   : in     RTEMS.Unsigned32;
2157      The_Class : in     RTEMS.Unsigned32;
2158      The_Node  : in     RTEMS.Unsigned32;
2159      The_Index : in     RTEMS.Unsigned32
2160   ) return RTEMS.Id is
2161      function Build_Id_Base (
2162        The_API   : RTEMS.Unsigned32;
2163        The_Class : RTEMS.Unsigned32;
2164        The_Node  : RTEMS.Unsigned32;
2165        The_Index : RTEMS.Unsigned32
2166      )  return RTEMS.Id;
2167      pragma Import (C, Build_Id_Base, "rtems_build_id");
2168   begin
2169      return Build_Id_Base (The_API, The_Class, The_Node, The_Index);
2170   end Build_Id;
2171
2172   function Object_Id_API_Minimum
2173   return RTEMS.Unsigned32 is
2174      function Object_Id_API_Minimum_Base return RTEMS.Unsigned32;
2175      pragma Import
2176         (C, Object_Id_API_Minimum_Base, "rtems_object_id_api_minimum");
2177   begin
2178      return Object_Id_API_Minimum_Base;
2179   end Object_Id_API_Minimum;
2180
2181   function Object_Id_API_Maximum
2182   return RTEMS.Unsigned32 is
2183      function Object_Id_API_Maximum_Base return RTEMS.Unsigned32;
2184      pragma Import
2185         (C, Object_Id_API_Maximum_Base, "rtems_object_id_api_maximum");
2186   begin
2187      return Object_Id_API_Maximum_Base;
2188   end Object_Id_API_Maximum;
2189
2190   procedure Object_API_Minimum_Class(
2191      API     : in     RTEMS.Unsigned32;
2192      Minimum :    out RTEMS.Unsigned32
2193   ) is
2194      function  Object_API_Minimum_Class_Base (
2195         API : RTEMS.Unsigned32
2196      )  return RTEMS.Unsigned32;
2197      pragma Import
2198         (C, Object_API_Minimum_Class_Base, "rtems_object_api_minimum_class");
2199   begin
2200      Minimum := Object_API_Minimum_Class_Base (API);
2201   end Object_API_Minimum_Class;
2202
2203   procedure Object_API_Maximum_Class(
2204      API     : in     RTEMS.Unsigned32;
2205      Maximum :    out RTEMS.Unsigned32
2206   ) is
2207      function  Object_API_Maximum_Class_Base (
2208         API : RTEMS.Unsigned32
2209      )  return RTEMS.Unsigned32;
2210      pragma Import
2211         (C, Object_API_Maximum_Class_Base, "rtems_object_api_maximum_class");
2212   begin
2213      Maximum := Object_API_Maximum_Class_Base (API);
2214   end Object_API_Maximum_Class;
2215
2216   -- Translate S from a C-style char* into an Ada String.
2217   -- If S is Null_Ptr, return "", don't raise an exception.
2218   -- Copied from Lovelace Tutorial
2219   function Value_Without_Exception(S : chars_ptr) return String is
2220   begin
2221     if S = Null_Ptr then return "";
2222      else return Value(S);
2223     end if;
2224   end Value_Without_Exception;
2225   pragma Inline(Value_Without_Exception);
2226
2227   procedure Object_Get_API_Name(
2228      API  : in     RTEMS.Unsigned32;
2229      Name :    out String
2230   ) is
2231      function  Object_Get_API_Name_Base (
2232        API : RTEMS.Unsigned32
2233      )  return chars_ptr;
2234      pragma Import (C, Object_Get_API_Name_Base, "rtems_object_get_api_name");
2235      Result : chars_ptr := Object_Get_API_Name_Base (API);
2236      APIName : String :=  Value_Without_Exception (Result);
2237   begin
2238      Name := APIName;
2239   end Object_Get_API_Name;
2240
2241   procedure Object_Get_API_Class_Name(
2242      The_API   : in     RTEMS.Unsigned32;
2243      The_Class : in     RTEMS.Unsigned32;
2244      Name      :    out String
2245   ) is
2246      function  Object_Get_API_Class_Name_Base (
2247        API   : RTEMS.Unsigned32;
2248        Class : RTEMS.Unsigned32
2249      )  return chars_ptr;
2250      pragma Import
2251         (C, Object_Get_API_Class_Name_Base, "rtems_object_get_api_class_name");
2252      Result : chars_ptr := Object_Get_API_Class_Name_Base (The_API, The_Class);
2253      ClassName : String :=  Value_Without_Exception (Result);
2254   begin
2255      Name := ClassName;
2256   end Object_Get_API_Class_Name;
2257
2258   procedure Object_Get_Class_Information(
2259      The_API   : in     RTEMS.Unsigned32;
2260      The_Class : in     RTEMS.Unsigned32;
2261      Info      :    out RTEMS.Object_API_Class_Information;
2262      Result    :    out RTEMS.Status_Codes
2263   ) is
2264      function  Object_Get_Class_Information_Base (
2265        The_API   : RTEMS.Unsigned32;
2266        The_Class : RTEMS.Unsigned32;
2267        Info      : access RTEMS.Object_API_Class_Information
2268      )  return RTEMS.Status_Codes;
2269      pragma Import (
2270         C,
2271         Object_Get_Class_Information_Base,
2272         "rtems_object_get_class_information"
2273      );
2274      TmpInfo : aliased RTEMS.Object_API_Class_Information;
2275   begin
2276      Result :=  Object_Get_Class_Information_Base
2277         (The_API, The_Class, TmpInfo'Access);
2278      Info := TmpInfo;
2279   end Object_Get_Class_Information;
2280
2281end RTEMS;
Note: See TracBrowser for help on using the repository browser.