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

4.104.115
Last change on this file since da42259 was b3a4579e, checked in by Joel Sherrill <joel.sherrill@…>, on 12/16/08 at 15:58:56

2008-12-16 Joel Sherrill <joel.sherrill@…>

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