source: rtems/c/src/ada/rtems.adb @ f5f4566

4.104.114.95
Last change on this file since f5f4566 was a2f56a44, checked in by Joel Sherrill <joel.sherrill@…>, on 03/11/08 at 20:12:09

2008-03-11 Joel Sherrill <joel.sherrill@…>

  • rtems.adb, rtems.ads: Refactored rtems_clock_get into 5 methods which are single purpose and more strongly typed. They are:

rtems_clock_get_tod - Get TOD in Classic API structure
rtems_clock_get_tod_timeval - Get TOD in struct timeval
rtems_clock_get_seconds_since_epoch - Get TOD as seconds since 1988
rtems_clock_get_ticks_since_boot - Get ticks since boot
rtems_clock_get_ticks_per_second - Get ticks per second

Also switch from using 'Unchecked_Access to 'Access.
Added pragma Convention C as required by gcc > 4.3.
Changed style of parenthese on subprogram calls to match GNAT.
  • 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       :    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      Result := Message_Queue_Receive_Base (
1189         ID,
1190         Buffer,
1191         Size_Base'Access,
1192         Option_Set,
1193         Timeout
1194      );
1195      Size := Size_Base;
1196
1197   end Message_Queue_Receive;
1198
1199   procedure Message_Queue_Get_Number_Pending (
1200      ID     : in     RTEMS.ID;
1201      Count  :    out RTEMS.Unsigned32;
1202      Result :    out RTEMS.Status_Codes
1203   ) is
1204      function Message_Queue_Get_Number_Pending_Base (
1205         ID    : RTEMS.ID;
1206         Count : access RTEMS.Unsigned32
1207      )  return RTEMS.Status_Codes;
1208      pragma Import (
1209         C,
1210         Message_Queue_Get_Number_Pending_Base,
1211         "rtems_message_queue_get_number_pending"
1212      );
1213      COUNT_Base : aliased RTEMS.Unsigned32;
1214   begin
1215
1216      Result := Message_Queue_Get_Number_Pending_Base (
1217         ID, COUNT_Base'Access
1218      );
1219      Count := COUNT_Base;
1220
1221   end Message_Queue_Get_Number_Pending;
1222
1223   procedure Message_Queue_Flush (
1224      ID     : in     RTEMS.ID;
1225      Count  :    out RTEMS.Unsigned32;
1226      Result :    out RTEMS.Status_Codes
1227   ) is
1228      function Message_Queue_Flush_Base (
1229         ID    : RTEMS.ID;
1230         Count : access RTEMS.Unsigned32
1231      )  return RTEMS.Status_Codes;
1232      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1233      COUNT_Base : aliased RTEMS.Unsigned32;
1234   begin
1235
1236      Result := Message_Queue_Flush_Base (ID, COUNT_Base'Access);
1237      Count := COUNT_Base;
1238
1239   end Message_Queue_Flush;
1240
1241   --
1242   -- Event Manager
1243   --
1244
1245   procedure Event_Send (
1246      ID       : in     RTEMS.ID;
1247      Event_In : in     RTEMS.Event_Set;
1248      Result   :    out RTEMS.Status_Codes
1249   ) is
1250      function Event_Send_Base (
1251         ID       : RTEMS.ID;
1252         Event_In : RTEMS.Event_Set
1253      )  return RTEMS.Status_Codes;
1254      pragma Import (C, Event_Send_Base, "rtems_event_send");
1255   begin
1256
1257      Result := Event_Send_Base (ID, Event_In);
1258
1259   end Event_Send;
1260
1261   procedure Event_Receive (
1262      Event_In   : in     RTEMS.Event_Set;
1263      Option_Set : in     RTEMS.Option;
1264      Ticks      : in     RTEMS.Interval;
1265      Event_Out  :    out RTEMS.Event_Set;
1266      Result     :    out RTEMS.Status_Codes
1267   ) is
1268      function Event_Receive_Base (
1269         Event_In   : RTEMS.Event_Set;
1270         Option_Set : RTEMS.Option;
1271         Ticks      : RTEMS.Interval;
1272         Event_Out  : access RTEMS.Event_Set
1273      )  return RTEMS.Status_Codes;
1274      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1275      Event_Out_Base : aliased RTEMS.Event_Set;
1276   begin
1277
1278      Result := Event_Receive_Base (
1279         Event_In,
1280         Option_Set,
1281         Ticks,
1282         Event_Out_Base'Access
1283      );
1284      Event_Out := Event_Out_Base;
1285
1286   end Event_Receive;
1287
1288   --
1289   -- Signal Manager
1290   --
1291
1292   procedure Signal_Catch (
1293      ASR_Handler : in     RTEMS.ASR_Handler;
1294      Mode_Set    : in     RTEMS.Mode;
1295      Result      :    out RTEMS.Status_Codes
1296   ) is
1297      function Signal_Catch_Base (
1298         ASR_Handler : RTEMS.ASR_Handler;
1299         Mode_Set    : RTEMS.Mode
1300      )  return RTEMS.Status_Codes;
1301      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1302   begin
1303
1304      Result := Signal_Catch_Base (ASR_Handler, Mode_Set);
1305
1306   end Signal_Catch;
1307
1308   procedure Signal_Send (
1309      ID         : in     RTEMS.ID;
1310      Signal_Set : in     RTEMS.Signal_Set;
1311      Result     :    out RTEMS.Status_Codes
1312   ) is
1313      function Signal_Send_Base (
1314         ID         : RTEMS.ID;
1315         Signal_Set : RTEMS.Signal_Set
1316      )  return RTEMS.Status_Codes;
1317      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1318   begin
1319
1320      Result := Signal_Send_Base (ID, Signal_Set);
1321
1322   end Signal_Send;
1323
1324
1325   --
1326   -- Partition Manager
1327   --
1328
1329   procedure Partition_Create (
1330      Name             : in     RTEMS.Name;
1331      Starting_Address : in     RTEMS.Address;
1332      Length           : in     RTEMS.Unsigned32;
1333      Buffer_Size      : in     RTEMS.Unsigned32;
1334      Attribute_Set    : in     RTEMS.Attribute;
1335      ID               :    out RTEMS.ID;
1336      Result           :    out RTEMS.Status_Codes
1337   ) is
1338      function Partition_Create_Base (
1339         Name             : RTEMS.Name;
1340         Starting_Address : RTEMS.Address;
1341         Length           : RTEMS.Unsigned32;
1342         Buffer_Size      : RTEMS.Unsigned32;
1343         Attribute_Set    : RTEMS.Attribute;
1344         ID               : access RTEMS.Event_Set
1345      )  return RTEMS.Status_Codes;
1346      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1347      ID_Base : aliased RTEMS.ID;
1348   begin
1349
1350      Result := Partition_Create_Base (
1351         Name,
1352         Starting_Address,
1353         Length,
1354         Buffer_Size,
1355         Attribute_Set,
1356         ID_Base'Access
1357      );
1358      ID := ID_Base;
1359
1360   end Partition_Create;
1361
1362   procedure Partition_Ident (
1363      Name   : in     RTEMS.Name;
1364      Node   : in     RTEMS.Unsigned32;
1365      ID     :    out RTEMS.ID;
1366      Result :    out RTEMS.Status_Codes
1367   ) is
1368      function Partition_Ident_Base (
1369         Name : RTEMS.Name;
1370         Node : RTEMS.Unsigned32;
1371         ID   : access RTEMS.Event_Set
1372      )  return RTEMS.Status_Codes;
1373      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1374      ID_Base : aliased RTEMS.ID;
1375   begin
1376
1377      Result := Partition_Ident_Base (Name, Node, ID_Base'Access);
1378      ID := ID_Base;
1379
1380   end Partition_Ident;
1381
1382   procedure Partition_Delete (
1383      ID     : in     RTEMS.ID;
1384      Result :    out RTEMS.Status_Codes
1385   ) is
1386      function Partition_Delete_Base (
1387         ID : RTEMS.ID
1388      )  return RTEMS.Status_Codes;
1389      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1390   begin
1391
1392      Result := Partition_Delete_Base (ID);
1393
1394   end Partition_Delete;
1395
1396   procedure Partition_Get_Buffer (
1397      ID     : in     RTEMS.ID;
1398      Buffer :    out RTEMS.Address;
1399      Result :    out RTEMS.Status_Codes
1400   ) is
1401      function Partition_Get_Buffer_Base (
1402         ID     : RTEMS.ID;
1403         Buffer : access RTEMS.Address
1404      )  return RTEMS.Status_Codes;
1405      pragma Import (C, Partition_Get_Buffer_Base,
1406         "rtems_partition_get_buffer");
1407      Buffer_Base : aliased RTEMS.Address;
1408   begin
1409
1410      Result := Partition_Get_Buffer_Base (ID, Buffer_Base'Access);
1411      Buffer := Buffer_Base;
1412
1413   end Partition_Get_Buffer;
1414
1415   procedure Partition_Return_Buffer (
1416      ID     : in     RTEMS.ID;
1417      Buffer : in     RTEMS.Address;
1418      Result :    out RTEMS.Status_Codes
1419   ) is
1420      function Partition_Return_Buffer_Base (
1421         ID     : RTEMS.Name;
1422         Buffer : RTEMS.Address
1423      )  return RTEMS.Status_Codes;
1424      pragma Import (C, Partition_Return_Buffer_Base,
1425         "rtems_partition_return_buffer");
1426   begin
1427
1428      Result := Partition_Return_Buffer_Base (ID, Buffer);
1429
1430   end Partition_Return_Buffer;
1431
1432   --
1433   -- Region Manager
1434   --
1435
1436   procedure Region_Create (
1437      Name             : in     RTEMS.Name;
1438      Starting_Address : in     RTEMS.Address;
1439      Length           : in     RTEMS.Unsigned32;
1440      Page_Size        : in     RTEMS.Unsigned32;
1441      Attribute_Set    : in     RTEMS.Attribute;
1442      ID               :    out RTEMS.ID;
1443      Result           :    out RTEMS.Status_Codes
1444   ) is
1445      function Region_Create_Base (
1446         Name             : RTEMS.Name;
1447         Starting_Address : RTEMS.Address;
1448         Length           : RTEMS.Unsigned32;
1449         Page_Size        : RTEMS.Unsigned32;
1450         Attribute_Set    : RTEMS.Attribute;
1451         ID               : access RTEMS.ID
1452      )  return RTEMS.Status_Codes;
1453      pragma Import (C, Region_Create_Base, "rtems_region_create");
1454      ID_Base : aliased RTEMS.ID;
1455   begin
1456
1457      Result := Region_Create_Base (
1458         Name,
1459         Starting_Address,
1460         Length,
1461         Page_Size,
1462         Attribute_Set,
1463         ID_Base'Access
1464      );
1465      ID := ID_Base;
1466
1467   end Region_Create;
1468
1469   procedure Region_Ident (
1470      Name   : in     RTEMS.Name;
1471      ID     :    out RTEMS.ID;
1472      Result :    out RTEMS.Status_Codes
1473   ) is
1474      function Region_Ident_Base (
1475         Name   : RTEMS.Name;
1476         ID     : access RTEMS.ID
1477      )  return RTEMS.Status_Codes;
1478      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1479      ID_Base : aliased RTEMS.ID;
1480   begin
1481
1482      Result := Region_Ident_Base (Name, ID_Base'Access);
1483      ID := ID_Base;
1484
1485   end Region_Ident;
1486
1487   procedure Region_Delete (
1488      ID     : in     RTEMS.ID;
1489      Result :    out RTEMS.Status_Codes
1490   ) is
1491      function Region_Delete_Base (
1492         ID : RTEMS.ID
1493      )  return RTEMS.Status_Codes;
1494      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1495   begin
1496
1497      Result := Region_Delete_Base (ID);
1498
1499   end Region_Delete;
1500
1501   procedure Region_Extend (
1502      ID               : in     RTEMS.ID;
1503      Starting_Address : in     RTEMS.Address;
1504      Length           : in     RTEMS.Unsigned32;
1505      Result           :    out RTEMS.Status_Codes
1506   ) is
1507      function Region_Extend_Base (
1508         ID               : RTEMS.ID;
1509         Starting_Address : RTEMS.Address;
1510         Length           : RTEMS.Unsigned32
1511      )  return RTEMS.Status_Codes;
1512      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1513   begin
1514
1515      Result := Region_Extend_Base (ID, Starting_Address, Length);
1516
1517   end Region_Extend;
1518
1519   procedure Region_Get_Segment (
1520      ID         : in     RTEMS.ID;
1521      Size       : in     RTEMS.Unsigned32;
1522      Option_Set : in     RTEMS.Option;
1523      Timeout    : in     RTEMS.Interval;
1524      Segment    :    out RTEMS.Address;
1525      Result     :    out RTEMS.Status_Codes
1526   ) is
1527      function Region_Get_Segment_Base (
1528         ID         : RTEMS.ID;
1529         Size       : RTEMS.Unsigned32;
1530         Option_Set : RTEMS.Option;
1531         Timeout    : RTEMS.Interval;
1532         Segment    : access RTEMS.Address
1533      )  return RTEMS.Status_Codes;
1534      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1535      Segment_Base : aliased RTEMS.Address;
1536   begin
1537
1538      Result := Region_Get_Segment_Base (
1539         ID,
1540         Size,
1541         Option_Set,
1542         Timeout,
1543         Segment_Base'Access
1544      );
1545      Segment := SEGMENT_Base;
1546
1547   end Region_Get_Segment;
1548
1549   procedure Region_Get_Segment_Size (
1550      ID      : in     RTEMS.ID;
1551      Segment : in     RTEMS.Address;
1552      Size    :    out RTEMS.Unsigned32;
1553      Result  :    out RTEMS.Status_Codes
1554   ) is
1555      function Region_Get_Segment_Size_Base (
1556         ID      : RTEMS.ID;
1557         Segment : RTEMS.Address;
1558         Size    : access RTEMS.Unsigned32
1559      )  return RTEMS.Status_Codes;
1560      pragma Import (C, Region_Get_Segment_Size_Base,
1561         "rtems_region_get_segment_size");
1562      Size_Base : aliased RTEMS.Unsigned32;
1563   begin
1564
1565      Result := Region_Get_Segment_Size_Base (
1566         ID,
1567         Segment,
1568         Size_Base'Access
1569      );
1570      Size := SIZE_Base;
1571
1572   end Region_Get_Segment_Size;
1573
1574   procedure Region_Return_Segment (
1575      ID      : in     RTEMS.ID;
1576      Segment : in     RTEMS.Address;
1577      Result  :    out RTEMS.Status_Codes
1578   ) is
1579      function Region_Return_Segment_Base (
1580         ID      : RTEMS.ID;
1581         Segment : RTEMS.Address
1582      )  return RTEMS.Status_Codes;
1583      pragma Import (C, Region_Return_Segment_Base,
1584         "rtems_region_return_segment");
1585   begin
1586
1587      Result := Region_Return_Segment_Base (ID, Segment);
1588
1589   end Region_Return_Segment;
1590
1591   procedure Region_Resize_Segment (
1592      ID         : in     RTEMS.ID;
1593      Segment    : in     RTEMS.Address;
1594      Size       : in     RTEMS.Unsigned32;
1595      Old_Size   :    out RTEMS.Unsigned32;
1596      Result     :    out RTEMS.Status_Codes
1597   ) is
1598      function Region_Resize_Segment_Base (
1599         ID       : RTEMS.ID;
1600         Segment  : RTEMS.Address;
1601         Size     : RTEMS.Unsigned32;
1602         Old_Size : access RTEMS.Unsigned32
1603      )  return RTEMS.Status_Codes;
1604      pragma Import (C, Region_Resize_Segment_Base,
1605         "rtems_region_resize_segment");
1606      Old_Size_Base : aliased RTEMS.Unsigned32;
1607   begin
1608
1609      Result := Region_Resize_Segment_Base (
1610         ID,
1611         Segment,
1612         Size,
1613         Old_Size_Base'Access
1614      );
1615      Old_Size := Old_Size_Base;
1616
1617   end Region_Resize_Segment;
1618
1619   --
1620   -- Dual Ported Memory Manager
1621   --
1622
1623   procedure Port_Create (
1624      Name           : in     RTEMS.Name;
1625      Internal_Start : in     RTEMS.Address;
1626      External_Start : in     RTEMS.Address;
1627      Length         : in     RTEMS.Unsigned32;
1628      ID             :    out RTEMS.ID;
1629      Result         :    out RTEMS.Status_Codes
1630   ) is
1631      function Port_Create_Base (
1632         Name           : RTEMS.Name;
1633         Internal_Start : RTEMS.Address;
1634         External_Start : RTEMS.Address;
1635         Length         : RTEMS.Unsigned32;
1636         ID             : access RTEMS.ID
1637      )  return RTEMS.Status_Codes;
1638      pragma Import (C, Port_Create_Base, "rtems_port_create");
1639      ID_Base : aliased RTEMS.ID;
1640   begin
1641
1642      Result := Port_Create_Base (
1643         Name,
1644         Internal_Start,
1645         External_Start,
1646         Length,
1647         ID_Base'Access
1648      );
1649      ID := ID_Base;
1650
1651   end Port_Create;
1652
1653   procedure Port_Ident (
1654      Name   : in     RTEMS.Name;
1655      ID     :    out RTEMS.ID;
1656      Result :    out RTEMS.Status_Codes
1657   ) is
1658      function Port_Ident_Base (
1659         Name : RTEMS.Name;
1660         ID   : access RTEMS.ID
1661      )  return RTEMS.Status_Codes;
1662      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1663      ID_Base : aliased RTEMS.ID;
1664   begin
1665
1666      Result := Port_Ident_Base (Name, ID_Base'Access);
1667      ID := ID_Base;
1668
1669   end Port_Ident;
1670
1671   procedure Port_Delete (
1672      ID     : in     RTEMS.ID;
1673      Result :    out RTEMS.Status_Codes
1674   ) is
1675      function Port_Delete_Base (
1676         ID : RTEMS.ID
1677      )  return RTEMS.Status_Codes;
1678      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1679   begin
1680
1681      Result := Port_Delete_Base (ID);
1682
1683   end Port_Delete;
1684
1685   procedure Port_External_To_Internal (
1686      ID       : in     RTEMS.ID;
1687      External : in     RTEMS.Address;
1688      Internal :    out RTEMS.Address;
1689      Result   :    out RTEMS.Status_Codes
1690   ) is
1691      function Port_External_To_Internal_Base (
1692         ID       : RTEMS.ID;
1693         External : RTEMS.Address;
1694         Internal : access RTEMS.Address
1695      )  return RTEMS.Status_Codes;
1696      pragma Import (C, Port_External_To_Internal_Base,
1697         "rtems_port_external_to_internal");
1698      Internal_Base : aliased RTEMS.Address;
1699   begin
1700
1701      Result := Port_External_To_Internal_Base (
1702         ID,
1703         External,
1704         Internal_Base'Access
1705      );
1706      Internal := INTERNAL_Base;
1707
1708   end Port_External_To_Internal;
1709
1710   procedure Port_Internal_To_External (
1711      ID       : in     RTEMS.ID;
1712      Internal : in     RTEMS.Address;
1713      External :    out RTEMS.Address;
1714      Result   :    out RTEMS.Status_Codes
1715   ) is
1716      function Port_Internal_To_External_Base (
1717         ID       : RTEMS.ID;
1718         Internal : RTEMS.Address;
1719         External : access RTEMS.Address
1720      )  return RTEMS.Status_Codes;
1721      pragma Import (C, Port_Internal_To_External_Base,
1722         "rtems_port_internal_to_external");
1723      External_Base : aliased RTEMS.Address;
1724   begin
1725
1726      Result := Port_Internal_To_External_Base (
1727         ID,
1728         Internal,
1729         External_Base'Access
1730      );
1731      External := EXTERNAL_Base;
1732
1733   end Port_Internal_To_External;
1734
1735
1736   --
1737   -- Fatal Error Manager
1738   --
1739
1740   procedure Fatal_Error_Occurred (
1741      The_Error : in     RTEMS.Unsigned32
1742   ) is
1743      procedure Fatal_Error_Occurred_Base (
1744         The_Error : RTEMS.Unsigned32
1745      );
1746   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1747   begin
1748
1749      Fatal_Error_Occurred_Base (The_Error);
1750
1751   end Fatal_Error_Occurred;
1752
1753
1754   --
1755   -- Rate Monotonic Manager
1756   --
1757
1758   procedure Rate_Monotonic_Create (
1759      Name   : in     RTEMS.Name;
1760      ID     :    out RTEMS.ID;
1761      Result :    out RTEMS.Status_Codes
1762   ) is
1763      function Rate_Monotonic_Create_Base (
1764         Name   : RTEMS.Name;
1765         ID     : access RTEMS.ID
1766      )  return RTEMS.Status_Codes;
1767      pragma Import (C, Rate_Monotonic_Create_Base, "rtems_rate_monotonic_create");
1768      ID_Base : aliased RTEMS.ID;
1769   begin
1770
1771      Result := Rate_Monotonic_Create_Base (Name, ID_Base'Access);
1772      ID := ID_Base;
1773
1774   end Rate_Monotonic_Create;
1775
1776   procedure Rate_Monotonic_Ident (
1777      Name   : in     RTEMS.Name;
1778      ID     :    out RTEMS.ID;
1779      Result :    out RTEMS.Status_Codes
1780   ) is
1781      function Rate_Monotonic_Ident_Base (
1782         Name   : RTEMS.Name;
1783         ID     : access RTEMS.ID
1784      )  return RTEMS.Status_Codes;
1785      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1786      ID_Base : aliased RTEMS.ID;
1787   begin
1788
1789      Result := Rate_Monotonic_Ident_Base (Name, ID_Base'Access);
1790
1791      ID := ID_Base;
1792
1793   end Rate_Monotonic_Ident;
1794
1795   procedure Rate_Monotonic_Delete (
1796      ID     : in     RTEMS.ID;
1797      Result :    out RTEMS.Status_Codes
1798   ) is
1799      function Rate_Monotonic_Delete_Base (
1800         ID : RTEMS.ID
1801      )  return RTEMS.Status_Codes;
1802      pragma Import (C, Rate_Monotonic_Delete_Base,
1803         "rtems_rate_monotonic_delete");
1804   begin
1805
1806      Result := Rate_Monotonic_Delete_Base (ID);
1807
1808   end Rate_Monotonic_Delete;
1809
1810   procedure Rate_Monotonic_Cancel (
1811      ID     : in     RTEMS.ID;
1812      Result :    out RTEMS.Status_Codes
1813   ) is
1814      function Rate_Monotonic_Cancel_Base (
1815         ID : RTEMS.ID
1816      )  return RTEMS.Status_Codes;
1817      pragma Import (C, Rate_Monotonic_Cancel_Base,
1818         "rtems_rate_monotonic_cancel");
1819   begin
1820
1821      Result := Rate_Monotonic_Cancel_Base (ID);
1822
1823   end Rate_Monotonic_Cancel;
1824
1825   procedure Rate_Monotonic_Period (
1826      ID      : in     RTEMS.ID;
1827      Length  : in     RTEMS.Interval;
1828      Result  :    out RTEMS.Status_Codes
1829   ) is
1830      function Rate_Monotonic_Period_Base (
1831         ID     : RTEMS.ID;
1832         Length : RTEMS.Interval
1833      )  return RTEMS.Status_Codes;
1834      pragma Import (C, Rate_Monotonic_Period_Base,
1835         "rtems_rate_monotonic_period");
1836   begin
1837
1838      Result := Rate_Monotonic_Period_Base (ID, Length);
1839
1840   end Rate_Monotonic_Period;
1841
1842   procedure Rate_Monotonic_Get_Status (
1843      ID      : in     RTEMS.ID;
1844      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1845      Result  :    out RTEMS.Status_Codes
1846   ) is
1847      function Rate_Monotonic_Get_Status_Base (
1848         ID      : RTEMS.ID;
1849         Status  : access RTEMS.Rate_Monotonic_Period_Status
1850      )  return RTEMS.Status_Codes;
1851      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1852         "rtems_rate_monotonic_get_status");
1853
1854      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1855   begin
1856
1857      Result := Rate_Monotonic_Get_Status_Base (
1858         ID,
1859         Status_Base'Access
1860      );
1861
1862      Status := Status_Base;
1863
1864
1865   end Rate_Monotonic_Get_Status;
1866
1867   procedure Rate_Monotonic_Reset_Statistics (
1868      ID     : in     RTEMS.ID;
1869      Result :    out RTEMS.Status_Codes
1870   ) is
1871      function Rate_Monotonic_Reset_Statistics_Base (
1872         ID : RTEMS.ID
1873      )  return RTEMS.Status_Codes;
1874      pragma Import (C, Rate_Monotonic_Reset_Statistics_Base,
1875         "rtems_rate_monotonic_reset_statistics");
1876   begin
1877
1878      Result := Rate_Monotonic_Reset_Statistics_Base (ID);
1879
1880   end Rate_Monotonic_Reset_Statistics;
1881
1882
1883   --
1884   -- Barrier Manager
1885   --
1886
1887   procedure Barrier_Create (
1888      Name            : in     RTEMS.Name;
1889      Attribute_Set   : in     RTEMS.Attribute;
1890      Maximum_Waiters : in     RTEMS.Unsigned32;
1891      ID              :    out RTEMS.ID;
1892      Result          :    out RTEMS.Status_Codes
1893   ) is
1894      function Barrier_Create_Base (
1895         Name            : RTEMS.Name;
1896         Attribute_Set   : RTEMS.Attribute;
1897         Maximum_Waiters : RTEMS.Unsigned32;
1898         ID              : access RTEMS.ID
1899      )  return RTEMS.Status_Codes;
1900      pragma Import (C, Barrier_Create_Base, "rtems_barrier_create");
1901      ID_Base : aliased RTEMS.ID;
1902   begin
1903
1904      Result := Barrier_Create_Base (
1905         Name,
1906         Attribute_Set,
1907         Maximum_Waiters,
1908         ID_Base'Access
1909      );
1910      ID := ID_Base;
1911
1912   end Barrier_Create;
1913
1914   procedure Barrier_Ident (
1915      Name   : in     RTEMS.Name;
1916      ID     :    out RTEMS.ID;
1917      Result :    out RTEMS.Status_Codes
1918   ) is
1919      function Barrier_Ident_Base (
1920         Name : RTEMS.Name;
1921         ID   : access RTEMS.ID
1922      )  return RTEMS.Status_Codes;
1923      pragma Import (C, Barrier_Ident_Base, "rtems_barrier_ident");
1924      ID_Base : aliased RTEMS.ID;
1925   begin
1926
1927      Result := Barrier_Ident_Base (Name, ID_Base'Access);
1928      ID := ID_Base;
1929
1930   end Barrier_Ident;
1931
1932   procedure Barrier_Delete (
1933      ID     : in     RTEMS.ID;
1934      Result :    out RTEMS.Status_Codes
1935   ) is
1936      function Barrier_Delete_Base (
1937         ID : RTEMS.ID
1938      )  return RTEMS.Status_Codes;
1939      pragma Import (C, Barrier_Delete_Base, "rtems_barrier_delete");
1940   begin
1941
1942      Result := Barrier_Delete_Base (ID);
1943
1944   end Barrier_Delete;
1945
1946   procedure Barrier_Wait (
1947      ID         : in     RTEMS.ID;
1948      Timeout    : in     RTEMS.Interval;
1949      Result     :    out RTEMS.Status_Codes
1950   ) is
1951      function Barrier_Wait_Base (
1952         ID         : RTEMS.ID;
1953         Timeout    : RTEMS.Interval
1954      )  return RTEMS.Status_Codes;
1955      pragma Import (C, Barrier_Wait_Base, "rtems_barrier_wait");
1956   begin
1957
1958      Result := Barrier_Wait_Base (ID, Timeout);
1959
1960   end Barrier_Wait;
1961
1962   procedure Barrier_Release (
1963      ID       : in     RTEMS.ID;
1964      Released :    out RTEMS.Unsigned32;
1965      Result   :    out RTEMS.Status_Codes
1966   ) is
1967      function Barrier_Release_Base (
1968         ID       : RTEMS.ID;
1969         Released : access RTEMS.Unsigned32
1970      )  return RTEMS.Status_Codes;
1971      pragma Import (C, Barrier_Release_Base, "rtems_barrier_release");
1972      Released_Base : aliased RTEMS.Unsigned32;
1973   begin
1974
1975      Result := Barrier_Release_Base (ID, Released_Base'Access);
1976      Released := Released_Base;
1977
1978   end Barrier_Release;
1979
1980
1981   --
1982   -- Debug Manager
1983   --
1984
1985   procedure Debug_Enable (
1986      To_Be_Enabled : in     RTEMS.Debug_Set
1987   ) is
1988      procedure Debug_Enable_Base (
1989         To_Be_Enabled : RTEMS.Debug_Set
1990      );
1991   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
1992   begin
1993
1994      Debug_Enable_Base (To_Be_Enabled);
1995
1996   end Debug_Enable;
1997
1998   procedure Debug_Disable (
1999      To_Be_Disabled : in     RTEMS.Debug_Set
2000   ) is
2001      procedure Debug_Disable_Base (
2002         To_Be_Disabled : RTEMS.Debug_Set
2003      );
2004   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
2005   begin
2006
2007      Debug_Disable_Base (To_Be_Disabled);
2008
2009   end Debug_Disable;
2010
2011   function Debug_Is_Enabled (
2012      Level : in     RTEMS.Debug_Set
2013   ) return RTEMS.Boolean is
2014      function Debug_Is_Enabled_Base (
2015         Level : RTEMS.Debug_Set
2016      )  return RTEMS.Boolean;
2017      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
2018   begin
2019
2020      return Debug_Is_Enabled_Base (Level);
2021
2022   end Debug_Is_Enabled;
2023
2024   --
2025   --  Object Services
2026   --
2027
2028   function Build_Name (
2029      C1 : in     Character;
2030      C2 : in     Character;
2031      C3 : in     Character;
2032      C4 : in     Character
2033   ) return RTEMS.Name is
2034      C1_Value : RTEMS.Unsigned32;
2035      C2_Value : RTEMS.Unsigned32;
2036      C3_Value : RTEMS.Unsigned32;
2037      C4_Value : RTEMS.Unsigned32;
2038   begin
2039
2040     C1_Value := Character'Pos( C1 );
2041     C2_Value := Character'Pos( C2 );
2042     C3_Value := Character'Pos( C3 );
2043     C4_Value := Character'Pos( C4 );
2044
2045     return Interfaces.Shift_Left( C1_Value, 24 ) or
2046            Interfaces.Shift_Left( C2_Value, 16 ) or
2047            Interfaces.Shift_Left( C3_Value, 8 )  or
2048            C4_Value;
2049
2050   end Build_Name;
2051
2052   procedure Object_Get_Classic_Name(
2053      ID     : in     RTEMS.ID;
2054      Name   :    out RTEMS.Name;
2055      Result :    out RTEMS.Status_Codes
2056   ) is
2057      function Object_Get_Classic_Name_Base (
2058         ID   : RTEMS.ID;
2059         Name : access RTEMS.Name
2060      )  return RTEMS.Status_Codes;
2061      pragma Import
2062         (C, Object_Get_Classic_Name_Base, "rtems_object_get_classic_name");
2063      Tmp_Name : aliased RTEMS.Name;
2064   begin
2065      Result := Object_Get_Classic_Name_Base (ID, Tmp_Name'Access);
2066      Name := Tmp_Name;
2067   end Object_Get_Classic_Name;
2068
2069
2070   procedure Object_Get_Name(
2071      ID     : in     RTEMS.ID;
2072      Name   :    out String;
2073      Result :    out RTEMS.Address
2074   ) is
2075      function Object_Get_Name_Base (
2076         ID     : RTEMS.ID;
2077         Length : RTEMS.Unsigned32;
2078         Name   : RTEMS.Address
2079      )  return RTEMS.Address;
2080      pragma Import (C, Object_Get_Name_Base, "rtems_object_get_name");
2081   begin
2082      Name := (others => ASCII.Nul);
2083      Result := Object_Get_Name_Base (
2084         Id,
2085         Name'Length,
2086         Name(Name'First)'Address
2087      );
2088   end Object_Get_Name;
2089
2090   procedure Object_Set_Name(
2091      ID     : in     RTEMS.ID;
2092      Name   : in     String;
2093      Result :    out RTEMS.Status_Codes
2094   ) is
2095      function Object_Set_Name_Base (
2096         ID     : RTEMS.ID;
2097         Name   : chars_ptr
2098      )  return RTEMS.Status_Codes;
2099      pragma Import (C, Object_Set_Name_Base, "rtems_object_set_name");
2100      NameAsCString : chars_ptr := New_String(Name);
2101   begin
2102      Result := Object_Set_Name_Base (ID, NameAsCString);
2103   end Object_Set_Name;
2104
2105   procedure Object_Id_Get_API(
2106      ID  : in     RTEMS.ID;
2107      API :    out RTEMS.Unsigned32
2108   ) is
2109      function Object_Id_Get_API_Base (
2110         ID     : RTEMS.ID
2111      )  return RTEMS.Unsigned32;
2112      pragma Import (C, Object_Id_Get_API_Base, "rtems_object_id_get_api");
2113   begin
2114      API := Object_Id_Get_API_Base (ID);
2115   end Object_Id_Get_API;
2116
2117   procedure Object_Id_Get_Class(
2118      ID        : in     RTEMS.ID;
2119      The_Class :    out RTEMS.Unsigned32
2120   ) is
2121      function Object_Id_Get_Class_Base (
2122         ID : RTEMS.ID
2123      )  return RTEMS.Unsigned32;
2124      pragma Import (C, Object_Id_Get_Class_Base, "rtems_object_id_get_class");
2125   begin
2126      The_Class := Object_Id_Get_Class_Base (ID);
2127   end Object_Id_Get_Class;
2128
2129   procedure Object_Id_Get_Node(
2130      ID   : in     RTEMS.ID;
2131      Node :    out RTEMS.Unsigned32
2132   ) is
2133      function Object_Id_Get_Node_Base (
2134         ID     : RTEMS.ID
2135      )  return RTEMS.Unsigned32;
2136      pragma Import (C, Object_Id_Get_Node_Base, "rtems_object_id_get_node");
2137   begin
2138      Node := Object_Id_Get_Node_Base (ID);
2139   end Object_Id_Get_Node;
2140
2141   procedure Object_Id_Get_Index(
2142      ID    : in     RTEMS.ID;
2143      Index :    out RTEMS.Unsigned32
2144   ) is
2145      function Object_Id_Get_Index_Base (
2146         ID     : RTEMS.ID
2147      )  return RTEMS.Unsigned32;
2148      pragma Import (C, Object_Id_Get_Index_Base, "rtems_object_id_get_index");
2149   begin
2150      Index := Object_Id_Get_Index_Base (ID);
2151   end Object_Id_Get_Index;
2152
2153   function Build_Id(
2154      The_API   : in     RTEMS.Unsigned32;
2155      The_Class : in     RTEMS.Unsigned32;
2156      The_Node  : in     RTEMS.Unsigned32;
2157      The_Index : in     RTEMS.Unsigned32
2158   ) return RTEMS.Id is
2159      function Build_Id_Base (
2160        The_API   : RTEMS.Unsigned32;
2161        The_Class : RTEMS.Unsigned32;
2162        The_Node  : RTEMS.Unsigned32;
2163        The_Index : RTEMS.Unsigned32
2164      )  return RTEMS.Id;
2165      pragma Import (C, Build_Id_Base, "rtems_build_id");
2166   begin
2167      return Build_Id_Base (The_API, The_Class, The_Node, The_Index);
2168   end Build_Id;
2169
2170   function Object_Id_API_Minimum
2171   return RTEMS.Unsigned32 is
2172      function Object_Id_API_Minimum_Base return RTEMS.Unsigned32;
2173      pragma Import
2174         (C, Object_Id_API_Minimum_Base, "rtems_object_id_api_minimum");
2175   begin
2176      return Object_Id_API_Minimum_Base;
2177   end Object_Id_API_Minimum;
2178
2179   function Object_Id_API_Maximum
2180   return RTEMS.Unsigned32 is
2181      function Object_Id_API_Maximum_Base return RTEMS.Unsigned32;
2182      pragma Import
2183         (C, Object_Id_API_Maximum_Base, "rtems_object_id_api_maximum");
2184   begin
2185      return Object_Id_API_Maximum_Base;
2186   end Object_Id_API_Maximum;
2187
2188   procedure Object_API_Minimum_Class(
2189      API     : in     RTEMS.Unsigned32;
2190      Minimum :    out RTEMS.Unsigned32
2191   ) is
2192      function  Object_API_Minimum_Class_Base (
2193         API : RTEMS.Unsigned32
2194      )  return RTEMS.Unsigned32;
2195      pragma Import
2196         (C, Object_API_Minimum_Class_Base, "rtems_object_api_minimum_class");
2197   begin
2198      Minimum := Object_API_Minimum_Class_Base (API);
2199   end Object_API_Minimum_Class;
2200
2201   procedure Object_API_Maximum_Class(
2202      API     : in     RTEMS.Unsigned32;
2203      Maximum :    out RTEMS.Unsigned32
2204   ) is
2205      function  Object_API_Maximum_Class_Base (
2206         API : RTEMS.Unsigned32
2207      )  return RTEMS.Unsigned32;
2208      pragma Import
2209         (C, Object_API_Maximum_Class_Base, "rtems_object_api_maximum_class");
2210   begin
2211      Maximum := Object_API_Maximum_Class_Base (API);
2212   end Object_API_Maximum_Class;
2213
2214   -- Translate S from a C-style char* into an Ada String.
2215   -- If S is Null_Ptr, return "", don't raise an exception.
2216   -- Copied from Lovelace Tutorial
2217   function Value_Without_Exception(S : chars_ptr) return String is
2218   begin
2219     if S = Null_Ptr then return "";
2220      else return Value(S);
2221     end if;
2222   end Value_Without_Exception;
2223   pragma Inline(Value_Without_Exception);
2224
2225   procedure Object_Get_API_Name(
2226      API  : in     RTEMS.Unsigned32;
2227      Name :    out String
2228   ) is
2229      function  Object_Get_API_Name_Base (
2230        API : RTEMS.Unsigned32
2231      )  return chars_ptr;
2232      pragma Import (C, Object_Get_API_Name_Base, "rtems_object_get_api_name");
2233      Result : chars_ptr := Object_Get_API_Name_Base (API);
2234      APIName : String :=  Value_Without_Exception (Result);
2235   begin
2236      Name := APIName;
2237   end Object_Get_API_Name;
2238
2239   procedure Object_Get_API_Class_Name(
2240      The_API   : in     RTEMS.Unsigned32;
2241      The_Class : in     RTEMS.Unsigned32;
2242      Name      :    out String
2243   ) is
2244      function  Object_Get_API_Class_Name_Base (
2245        API   : RTEMS.Unsigned32;
2246        Class : RTEMS.Unsigned32
2247      )  return chars_ptr;
2248      pragma Import
2249         (C, Object_Get_API_Class_Name_Base, "rtems_object_get_api_class_name");
2250      Result : chars_ptr := Object_Get_API_Class_Name_Base (The_API, The_Class);
2251      ClassName : String :=  Value_Without_Exception (Result);
2252   begin
2253      Name := ClassName;
2254   end Object_Get_API_Class_Name;
2255
2256   procedure Object_Get_Class_Information(
2257      The_API   : in     RTEMS.Unsigned32;
2258      The_Class : in     RTEMS.Unsigned32;
2259      Info      :    out RTEMS.Object_API_Class_Information;
2260      Result    :    out RTEMS.Status_Codes
2261   ) is
2262      function  Object_Get_Class_Information_Base (
2263        The_API   : RTEMS.Unsigned32;
2264        The_Class : RTEMS.Unsigned32;
2265        Info      : access RTEMS.Object_API_Class_Information
2266      )  return RTEMS.Status_Codes;
2267      pragma Import (
2268         C,
2269         Object_Get_Class_Information_Base,
2270         "rtems_object_get_class_information"
2271      );
2272      TmpInfo : aliased RTEMS.Object_API_Class_Information;
2273   begin
2274      Result :=  Object_Get_Class_Information_Base
2275         (The_API, The_Class, TmpInfo'Access);
2276      Info := TmpInfo;
2277   end Object_Get_Class_Information;
2278
2279end RTEMS;
Note: See TracBrowser for help on using the repository browser.