source: rtems/c/src/ada/rtems.adb @ 42f07c5

4.104.114.95
Last change on this file since 42f07c5 was 29948d48, checked in by Glenn Humphrey <glenn.humphrey@…>, on 10/18/07 at 21:26:23

2007-10-18 Glenn Humphrey <glenn.humphrey@…>

  • rtems.adb, rtems.ads: Added a missing binding.
  • Property mode set to 100644
File size: 49.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-2007.
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;
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 = Standard.True 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      Microseconds_Per_Tick : RTEMS.Interval;
74      pragma Import (C, Microseconds_Per_Tick, "_TOD_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   function Build_Name (
91      C1 : in     Character;
92      C2 : in     Character;
93      C3 : in     Character;
94      C4 : in     Character
95   ) return RTEMS.Name is
96      C1_Value : RTEMS.Unsigned32;
97      C2_Value : RTEMS.Unsigned32;
98      C3_Value : RTEMS.Unsigned32;
99      C4_Value : RTEMS.Unsigned32;
100   begin
101
102     C1_Value := Character'Pos( C1 );
103     C2_Value := Character'Pos( C2 );
104     C3_Value := Character'Pos( C3 );
105     C4_Value := Character'Pos( C4 );
106
107     return Interfaces.Shift_Left( C1_Value, 24 ) or
108            Interfaces.Shift_Left( C2_Value, 16 ) or
109            Interfaces.Shift_Left( C3_Value, 8 )  or
110            C4_Value;
111
112   end Build_Name;
113
114   procedure Name_To_Characters (
115      Name : in     RTEMS.Name;
116      C1   :    out Character;
117      C2   :    out Character;
118      C3   :    out Character;
119      C4   :    out Character
120   ) is
121      C1_Value : RTEMS.Unsigned32;
122      C2_Value : RTEMS.Unsigned32;
123      C3_Value : RTEMS.Unsigned32;
124      C4_Value : RTEMS.Unsigned32;
125   begin
126
127     C1_Value := Interfaces.Shift_Right( Name, 24 );
128     C2_Value := Interfaces.Shift_Right( Name, 16 );
129     C3_Value := Interfaces.Shift_Right( Name, 8 );
130     C4_Value := Name;
131
132     C1_Value := C1_Value and 16#00FF#;
133     C2_Value := C2_Value and 16#00FF#;
134     C3_Value := C3_Value and 16#00FF#;
135     C4_Value := C4_Value and 16#00FF#;
136
137     C1 := Character'Val( C1_Value );
138     C2 := Character'Val( C2_Value );
139     C3 := Character'Val( C3_Value );
140     C4 := Character'Val( C4_Value );
141
142   end Name_To_Characters;
143
144   function Get_Node (
145      ID : in     RTEMS.ID
146   ) return RTEMS.Unsigned32 is
147   begin
148
149      -- May not be right
150      return Interfaces.Shift_Right( ID, 16 );
151
152   end Get_Node;
153
154   function Get_Index (
155      ID : in     RTEMS.ID
156   ) return RTEMS.Unsigned32 is
157   begin
158
159      -- May not be right
160      return ID and 16#FFFF#;
161
162   end Get_Index;
163
164   function Are_Statuses_Equal (
165      Status  : in     RTEMS.Status_Codes;
166      Desired : in     RTEMS.Status_Codes
167   ) return Standard.Boolean is
168   begin
169
170      if Status = Desired then
171         return Standard.True;
172      end if;
173
174      return Standard.False;
175
176   end Are_Statuses_Equal;
177
178   function Is_Status_Successful (
179      Status  : in     RTEMS.Status_Codes
180   ) return Standard.Boolean is
181   begin
182
183      if Status = RTEMS.Successful then
184         return Standard.True;
185      end if;
186
187      return Standard.False;
188
189   end Is_Status_Successful;
190
191   function Subtract (
192      Left   : in     RTEMS.Address;
193      Right  : in     RTEMS.Address
194   ) return RTEMS.Unsigned32 is
195      function To_Unsigned32 is
196         new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
197
198   begin
199      return To_Unsigned32(Left) - To_Unsigned32(Right);
200   end Subtract;
201
202   function Are_Equal (
203      Left   : in     RTEMS.Address;
204      Right  : in     RTEMS.Address
205   ) return Standard.Boolean is
206      function To_Unsigned32 is
207         new Ada.Unchecked_Conversion (System.Address, RTEMS.Unsigned32);
208
209   begin
210      return (To_Unsigned32(Left) = To_Unsigned32(Right));
211   end Are_Equal;
212
213   --
214   --
215   --  RTEMS API
216   --
217
218   --
219   --  Initialization Manager -- Shutdown Only
220   --
221   procedure Shutdown_Executive (
222      Status           : in     RTEMS.Unsigned32
223   ) is
224      procedure Shutdown_Executive_Base (
225         Status : RTEMS.Unsigned32
226      );
227      pragma Import (C, Shutdown_Executive_Base, "rtems_shutdown_executive");
228   begin
229      Shutdown_Executive_Base (Status);
230   end Shutdown_Executive;
231 
232
233   --
234   --  Task Manager
235   --
236
237   procedure Task_Create (
238      Name             : in     RTEMS.Name;
239      Initial_Priority : in     RTEMS.Task_Priority;
240      Stack_Size       : in     RTEMS.Unsigned32;
241      Initial_Modes    : in     RTEMS.Mode;
242      Attribute_Set    : in     RTEMS.Attribute;
243      ID               :    out RTEMS.ID;
244      Result           :    out RTEMS.Status_Codes
245   ) is
246      function Task_Create_Base (
247         Name             : RTEMS.Name;
248         Initial_Priority : RTEMS.Task_Priority;
249         Stack_Size       : RTEMS.Unsigned32;
250         Initial_Modes    : RTEMS.Mode;
251         Attribute_Set    : RTEMS.Attribute;
252         ID               : access RTEMS.ID
253      )  return RTEMS.Status_Codes;
254      pragma Import (C, Task_Create_Base, "rtems_task_create");
255      ID_Base : aliased RTEMS.ID;
256   begin
257      Result := Task_Create_Base (
258        Name,
259        Initial_Priority,
260        Stack_Size,
261        Initial_Modes,
262        Attribute_Set,
263        ID_Base'Unchecked_Access
264      );
265      ID := ID_Base;
266   end Task_Create;
267
268   procedure Task_Ident (
269      Name             : in     RTEMS.Name;
270      Node             : in     RTEMS.Node;
271      ID               :    out RTEMS.ID;
272      Result           :    out RTEMS.Status_Codes
273   ) is
274
275      function Task_Ident_Base (
276         Name             : RTEMS.Name;
277         Node             : RTEMS.Node;
278         ID               : access RTEMS.ID
279      )  return RTEMS.Status_Codes;
280      pragma Import (C, Task_Ident_Base, "rtems_task_ident");
281      ID_Base     : aliased RTEMS.ID;
282
283   begin
284
285      Result := Task_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
286      ID := ID_Base;
287
288   end Task_Ident;
289
290   procedure Task_Start (
291      ID          : in     RTEMS.ID;
292      Entry_Point : in     RTEMS.Task_Entry;
293      Argument    : in     RTEMS.Task_Argument;
294      Result      :    out RTEMS.Status_Codes
295   ) is
296      function Task_Start_Base (
297         ID          : RTEMS.ID;
298         Entry_Point : RTEMS.Task_Entry;
299         Argument    : RTEMS.Task_Argument
300      )  return RTEMS.Status_Codes;
301      pragma Import (C, Task_Start_Base, "rtems_task_start");
302   begin
303
304      Result := Task_Start_Base ( ID, Entry_Point, Argument );
305
306   end Task_Start;
307
308   procedure Task_Restart (
309      ID       : in     RTEMS.ID;
310      Argument : in     RTEMS.Task_Argument;
311      Result   :    out RTEMS.Status_Codes
312   ) is
313      function Task_Restart_Base (
314         ID       : RTEMS.ID;
315         Argument : RTEMS.Task_Argument
316      )  return RTEMS.Status_Codes;
317      pragma Import (C, Task_Restart_Base, "rtems_task_restart");
318   begin
319
320      Result := Task_Restart_Base ( ID, Argument );
321 
322   end Task_Restart;
323 
324   procedure Task_Delete (
325      ID     : in     RTEMS.ID;
326      Result :    out RTEMS.Status_Codes
327   ) is
328      function Task_Delete_Base (
329         ID : RTEMS.ID
330      )  return RTEMS.Status_Codes;
331      pragma Import (C, Task_Delete_Base, "rtems_task_delete");
332   begin
333
334      Result := Task_Delete_Base ( ID );
335 
336   end Task_Delete;
337 
338   procedure Task_Suspend (
339      ID     : in     RTEMS.ID;
340      Result :    out RTEMS.Status_Codes
341   ) is
342      function Task_Suspend_Base (
343         ID : RTEMS.ID
344      )  return RTEMS.Status_Codes;
345      pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
346   begin
347
348      Result := Task_Suspend_Base ( ID );
349 
350   end Task_Suspend;
351 
352   procedure Task_Resume (
353      ID     : in     RTEMS.ID;
354      Result :    out RTEMS.Status_Codes
355   ) is
356      function Task_Resume_Base (
357         ID : RTEMS.ID
358      )  return RTEMS.Status_Codes;
359      pragma Import (C, Task_Resume_Base, "rtems_task_resume");
360   begin
361
362      Result := Task_Resume_Base ( ID );
363
364   end Task_Resume;
365 
366   procedure Task_Set_Priority (
367      ID           : in     RTEMS.ID;
368      New_Priority : in     RTEMS.Task_Priority;
369      Old_Priority :    out RTEMS.Task_Priority;
370      Result       :    out RTEMS.Status_Codes
371   ) is
372      function Task_Set_Priority_Base (
373         ID           : RTEMS.ID;
374         New_Priority : RTEMS.Task_Priority;
375         Old_Priority : access RTEMS.Task_Priority
376      )  return RTEMS.Status_Codes;
377      pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority");
378      Old_Priority_Base : aliased RTEMS.Task_Priority;
379   begin
380 
381      Result := Task_Set_Priority_Base (
382         ID,
383         New_Priority,
384         Old_Priority_Base'Unchecked_Access
385      );
386      Old_Priority := Old_Priority_Base;
387
388   end Task_Set_Priority;
389 
390   procedure Task_Mode (
391      Mode_Set          : in     RTEMS.Mode;
392      Mask              : in     RTEMS.Mode;
393      Previous_Mode_Set :    out RTEMS.Mode;
394      Result            :    out RTEMS.Status_Codes
395   ) is
396      function Task_Mode_Base (
397         Mode_Set          : RTEMS.Mode;
398         Mask              : RTEMS.Mode;
399         Previous_Mode_Set : access RTEMS.Mode
400      )  return RTEMS.Status_Codes;
401      pragma Import (C, Task_Mode_Base, "rtems_task_mode");
402      Previous_Mode_Set_Base : aliased RTEMS.Mode;
403   begin
404
405      Result := Task_Mode_Base (
406         Mode_Set,
407         Mask,
408         Previous_Mode_Set_Base'Unchecked_Access
409      );
410      Previous_Mode_Set := Previous_Mode_Set_Base;
411
412   end Task_Mode;
413 
414   procedure Task_Get_Note (
415      ID      : in     RTEMS.ID;
416      Notepad : in     RTEMS.Notepad_Index;
417      Note    :    out RTEMS.Unsigned32;
418      Result  :    out RTEMS.Status_Codes
419   ) is
420      function Task_Get_Note_Base (
421         ID      : RTEMS.ID;
422         Notepad : RTEMS.Notepad_Index;
423         Note    : access RTEMS.Unsigned32
424      )  return RTEMS.Status_Codes;
425      pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
426      Note_Base : aliased RTEMS.Unsigned32;
427   begin
428
429      Result := Task_Get_Note_Base ( ID, Notepad, Note_Base'Unchecked_Access );
430      Note := NOTE_Base;
431
432   end Task_Get_Note;
433 
434   procedure Task_Set_Note (
435      ID      : in     RTEMS.ID;
436      Notepad : in     RTEMS.Notepad_Index;
437      Note    : in     RTEMS.Unsigned32;
438      Result  :    out RTEMS.Status_Codes
439   ) is
440      function Task_Set_Note_Base (
441         ID      : RTEMS.ID;
442         Notepad : RTEMS.Notepad_Index;
443         Note    : RTEMS.Unsigned32
444      )  return RTEMS.Status_Codes;
445      pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
446   begin
447
448      Result := Task_Set_Note_Base ( ID, Notepad, Note );
449
450   end Task_Set_Note;
451 
452   procedure Task_Variable_Add (
453      ID            : in     RTEMS.ID;
454      Task_Variable : in     RTEMS.Address;
455      Dtor          : in     RTEMS.Task_Variable_Dtor;
456      Result        :    out RTEMS.Status_Codes
457   ) is
458      function Task_Variable_Add_Base (
459         ID            : RTEMS.ID;
460         Task_Variable : RTEMS.Address;
461         Dtor          : RTEMS.Task_Variable_Dtor
462      )  return RTEMS.Status_Codes;
463      pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
464   begin
465
466      Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
467
468   end Task_Variable_Add;
469
470   procedure Task_Variable_Get (
471      ID                  : in     RTEMS.ID;
472      Task_Variable       :    out RTEMS.Address;
473      Task_Variable_Value :    out RTEMS.Address;
474      Result              :    out RTEMS.Status_Codes
475   ) is
476      function Task_Variable_Get_Base (
477         ID                  : RTEMS.ID;
478         Task_Variable       : access RTEMS.Address;
479         Task_Variable_Value : access RTEMS.Address
480      )  return RTEMS.Status_Codes;
481      pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
482      Task_Variable_Base       : aliased RTEMS.Address;
483      Task_Variable_Value_Base : aliased RTEMS.Address;
484   begin
485
486      Result := Task_Variable_Get_Base (
487         ID,
488         Task_Variable_Base'Unchecked_Access,
489         Task_Variable_Value_Base'Unchecked_Access
490      );
491      Task_Variable := Task_Variable_Base;
492      Task_Variable_Value := Task_Variable_Value_Base;
493
494   end Task_Variable_Get;
495
496   procedure Task_Variable_Delete (
497      ID                  : in     RTEMS.ID;
498      Task_Variable       :    out RTEMS.Address;
499      Result              :    out RTEMS.Status_Codes
500   ) is
501      function Task_Variable_Delete_Base (
502         ID                  : RTEMS.ID;
503         Task_Variable       : access RTEMS.Address
504      )  return RTEMS.Status_Codes;
505      pragma Import (
506         C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
507      );
508      Task_Variable_Base : aliased RTEMS.Address;
509   begin
510
511      Result := Task_Variable_Delete_Base (
512         ID, Task_Variable_Base'Unchecked_Access
513      );
514      Task_Variable := Task_Variable_Base;
515
516   end Task_Variable_Delete;
517
518   procedure Task_Wake_When (
519      Time_Buffer : in     RTEMS.Time_Of_Day;
520      Result      :    out RTEMS.Status_Codes
521   ) is
522      function Task_Wake_When_Base (
523         Time_Buffer : RTEMS.Time_Of_Day
524      )  return RTEMS.Status_Codes;
525      pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
526   begin
527
528      Result := Task_Wake_When_Base ( Time_Buffer );
529
530   end Task_Wake_When;
531 
532   procedure Task_Wake_After (
533      Ticks  : in     RTEMS.Interval;
534      Result :    out RTEMS.Status_Codes
535   ) is
536      function Task_Wake_After_Base (
537         Ticks : RTEMS.Interval
538      )  return RTEMS.Status_Codes;
539      pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
540   begin
541
542      Result := Task_Wake_After_Base ( Ticks );
543
544   end Task_Wake_After;
545 
546   --
547   -- Interrupt Manager
548   --
549
550   -- Interrupt_Disable is interfaced in the specification
551   -- Interrupt_Enable is interfaced in the specification
552   -- Interrupt_Flash is interfaced in the specification
553   -- Interrupt_Is_In_Progress is interfaced in the specification
554
555   --
556   -- Clock Manager
557   --
558 
559   procedure Clock_Get (
560      Option      : in     RTEMS.Clock_Get_Options;
561      Time_Buffer : in     RTEMS.Address;
562      Result      :    out RTEMS.Status_Codes
563   ) is
564      function Clock_Get_base (
565         Option      : RTEMS.Clock_Get_Options;
566         Time_Buffer : RTEMS.Address
567      )  return RTEMS.Status_Codes;
568      pragma Import (C, Clock_Get_base, "rtems_clock_get");
569   begin
570
571      Result := Clock_Get_base ( Option, Time_Buffer );
572
573   end Clock_Get;
574 
575   procedure Clock_Set (
576      Time_Buffer : in     RTEMS.Time_Of_Day;
577      Result      :    out RTEMS.Status_Codes
578   ) is
579      function Clock_Set_base (
580         Time_Buffer : RTEMS.Time_Of_Day
581      )  return RTEMS.Status_Codes;
582      pragma Import (C, Clock_Set_base, "rtems_clock_set");
583   begin
584 
585      Result := Clock_Set_base ( Time_Buffer );
586
587   end Clock_Set;
588 
589   procedure Clock_Tick (
590      Result :    out RTEMS.Status_Codes
591   ) is
592      function Clock_Tick_Base return RTEMS.Status_Codes;
593      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
594   begin
595
596      Result := Clock_Tick_Base;
597
598   end Clock_Tick;
599
600   --
601   -- Extension Manager
602   --
603 
604   procedure Extension_Create (
605      Name   : in     RTEMS.Name;
606      Table  : in     RTEMS.Extensions_Table_Pointer;
607      ID     :    out RTEMS.ID;
608      Result :    out RTEMS.Status_Codes
609   ) is
610      function Extension_Create_Base (
611         Name   : RTEMS.Name;
612         Table  : RTEMS.Extensions_Table_Pointer;
613         ID     : access RTEMS.ID
614      )  return RTEMS.Status_Codes;
615      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
616      ID_Base : aliased RTEMS.ID;
617   begin
618 
619      Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
620      ID := ID_Base;
621
622   end Extension_Create;
623 
624   procedure Extension_Ident (
625      Name   : in     RTEMS.Name;
626      ID     :    out RTEMS.ID;
627      Result :    out RTEMS.Status_Codes
628   ) is
629      function Extension_Ident_Base (
630         Name   : RTEMS.Name;
631         ID     : access RTEMS.ID
632      )  return RTEMS.Status_Codes;
633      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
634      ID_Base : aliased RTEMS.ID;
635   begin
636 
637      Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access );
638      ID := ID_Base;
639
640   end Extension_Ident;
641 
642   procedure Extension_Delete (
643      ID     : in     RTEMS.ID;
644      Result :    out RTEMS.Status_Codes
645   ) is
646      function Extension_Delete_Base (
647         ID : RTEMS.ID
648      )  return RTEMS.Status_Codes;
649      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
650   begin
651 
652      Result := Extension_Delete_Base ( ID );
653
654   end Extension_Delete;
655 
656   --
657   -- Timer Manager
658   --
659 
660   procedure Timer_Create (
661      Name   : in     RTEMS.Name;
662      ID     :    out RTEMS.ID;
663      Result :    out RTEMS.Status_Codes
664   ) is
665      function Timer_Create_Base (
666         Name   : RTEMS.Name;
667         ID     : access RTEMS.ID
668      )  return RTEMS.Status_Codes;
669      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
670      ID_Base : aliased RTEMS.ID;
671   begin
672 
673      Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
674      ID := ID_Base;
675
676   end Timer_Create;
677 
678   procedure Timer_Ident (
679      Name   : in     RTEMS.Name;
680      ID     :    out RTEMS.ID;
681      Result :    out RTEMS.Status_Codes
682   ) is
683      function Timer_Ident_Base (
684         Name   : RTEMS.Name;
685         ID     : access RTEMS.ID
686      )  return RTEMS.Status_Codes;
687      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
688      ID_Base : aliased RTEMS.ID;
689   begin
690 
691      Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
692      ID := ID_Base;
693
694   end Timer_Ident;
695 
696   procedure Timer_Delete (
697      ID     : in     RTEMS.ID;
698      Result :    out RTEMS.Status_Codes
699   ) is
700      function Timer_Delete_Base (
701         ID : RTEMS.ID
702      )  return RTEMS.Status_Codes;
703      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
704   begin
705 
706      Result := Timer_Delete_Base ( ID );
707
708   end Timer_Delete;
709 
710   procedure Timer_Fire_After (
711      ID        : in     RTEMS.ID;
712      Ticks     : in     RTEMS.Interval;
713      Routine   : in     RTEMS.Timer_Service_Routine;
714      User_Data : in     RTEMS.Address;
715      Result    :    out RTEMS.Status_Codes
716   ) is
717      function Timer_Fire_After_Base (
718         ID        : RTEMS.ID;
719         Ticks     : RTEMS.Interval;
720         Routine   : RTEMS.Timer_Service_Routine;
721         User_Data : RTEMS.Address
722      )  return RTEMS.Status_Codes;
723      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
724   begin
725 
726      Result := Timer_Fire_After_Base ( ID, Ticks, Routine, User_Data );
727
728   end Timer_Fire_After;
729 
730   procedure Timer_Server_Fire_After (
731      ID        : in     RTEMS.ID;
732      Ticks     : in     RTEMS.Interval;
733      Routine   : in     RTEMS.Timer_Service_Routine;
734      User_Data : in     RTEMS.Address;
735      Result    :    out RTEMS.Status_Codes
736   ) is
737      function Timer_Server_Fire_After_Base (
738         ID        : RTEMS.ID;
739         Ticks     : RTEMS.Interval;
740         Routine   : RTEMS.Timer_Service_Routine;
741         User_Data : RTEMS.Address
742      )  return RTEMS.Status_Codes;
743      pragma Import (
744        C,
745        Timer_Server_Fire_After_Base,
746        "rtems_timer_server_fire_after"
747      );
748   begin
749 
750      Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data );
751
752   end Timer_Server_Fire_After;
753 
754   procedure Timer_Fire_When (
755      ID        : in     RTEMS.ID;
756      Wall_Time : in     RTEMS.Time_Of_Day;
757      Routine   : in     RTEMS.Timer_Service_Routine;
758      User_Data : in     RTEMS.Address;
759      Result    :    out RTEMS.Status_Codes
760   ) is
761      function Timer_Fire_When_Base (
762         ID        : RTEMS.ID;
763         Wall_Time : RTEMS.Time_Of_Day;
764         Routine   : RTEMS.Timer_Service_Routine;
765         User_Data : RTEMS.Address
766      )  return RTEMS.Status_Codes;
767      pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
768   begin
769 
770      Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
771
772   end Timer_Fire_When;
773 
774   procedure Timer_Server_Fire_When (
775      ID        : in     RTEMS.ID;
776      Wall_Time : in     RTEMS.Time_Of_Day;
777      Routine   : in     RTEMS.Timer_Service_Routine;
778      User_Data : in     RTEMS.Address;
779      Result    :    out RTEMS.Status_Codes
780   ) is
781      function Timer_Server_Fire_When_Base (
782         ID        : RTEMS.ID;
783         Wall_Time : RTEMS.Time_Of_Day;
784         Routine   : RTEMS.Timer_Service_Routine;
785         User_Data : RTEMS.Address
786      )  return RTEMS.Status_Codes;
787      pragma Import (
788         C,
789         Timer_Server_Fire_When_Base,
790         "rtems_timer_server_fire_when"
791      );
792   begin
793 
794      Result :=
795         Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
796   end Timer_Server_Fire_When;
797 
798   procedure Timer_Reset (
799      ID     : in     RTEMS.ID;
800      Result :    out RTEMS.Status_Codes
801   ) is
802      function Timer_Reset_Base (
803         ID : RTEMS.ID
804      )  return RTEMS.Status_Codes;
805      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
806   begin
807 
808      Result := Timer_Reset_Base ( ID );
809
810   end Timer_Reset;
811 
812   procedure Timer_Cancel (
813      ID     : in     RTEMS.ID;
814      Result :    out RTEMS.Status_Codes
815   ) is
816      function Timer_Cancel_Base (
817         ID : RTEMS.ID
818      )  return RTEMS.Status_Codes;
819      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
820   begin
821 
822      Result := Timer_Cancel_Base ( ID );
823
824   end Timer_Cancel;
825 
826   procedure Timer_Initiate_Server (
827      Server_Priority : in     RTEMS.Task_Priority;
828      Stack_Size      : in     RTEMS.Unsigned32;
829      Attribute_Set   : in     RTEMS.Attribute;
830      Result          :    out RTEMS.Status_Codes
831   ) is
832      function Timer_Initiate_Server_Base (
833         Server_Priority : RTEMS.Task_Priority;
834         Stack_Size      : RTEMS.Unsigned32;
835         Attribute_Set   : RTEMS.Attribute
836      )  return RTEMS.Status_Codes;
837      pragma Import (
838         C,
839         Timer_Initiate_Server_Base,
840         "rtems_timer_initiate_server"
841      );
842   begin
843      Result := Timer_Initiate_Server_Base (
844         Server_Priority,
845         Stack_Size,
846         Attribute_Set
847      );
848   end Timer_Initiate_Server;
849
850   --
851   -- Semaphore Manager
852   --
853 
854   procedure Semaphore_Create (
855      Name             : in     RTEMS.Name;
856      Count            : in     RTEMS.Unsigned32;
857      Attribute_Set    : in     RTEMS.Attribute;
858      Priority_Ceiling : in     RTEMS.Task_Priority;
859      ID               :    out RTEMS.ID;
860      Result           :    out RTEMS.Status_Codes
861   ) is
862      function Semaphore_Create_Base (
863         Name             : RTEMS.Name;
864         Count            : RTEMS.Unsigned32;
865         Attribute_Set    : RTEMS.Attribute;
866         Priority_Ceiling : RTEMS.Task_Priority;
867         ID               : access RTEMS.ID
868      )  return RTEMS.Status_Codes;
869      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
870      ID_Base : aliased RTEMS.ID;
871   begin
872 
873      Result := Semaphore_Create_Base (
874         Name,
875         Count,
876         Attribute_Set,
877         Priority_Ceiling,
878         ID_Base'Unchecked_Access
879      );
880      ID := ID_Base;
881
882   end Semaphore_Create;
883 
884   procedure Semaphore_Delete (
885      ID     : in     RTEMS.ID;
886      Result :    out RTEMS.Status_Codes
887   ) is
888      function Semaphore_Delete_Base (
889         ID : RTEMS.ID
890      )  return RTEMS.Status_Codes;
891      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
892   begin
893 
894      Result := Semaphore_Delete_Base ( ID );
895
896   end Semaphore_Delete;
897 
898   procedure Semaphore_Ident (
899      Name   : in     RTEMS.Name;
900      Node   : in     RTEMS.Unsigned32;
901      ID     :    out RTEMS.ID;
902      Result :    out RTEMS.Status_Codes
903   ) is
904      function Semaphore_Ident_Base (
905         Name : RTEMS.Name;
906         Node : RTEMS.Unsigned32;
907         ID   : access RTEMS.ID
908      )  return RTEMS.Status_Codes;
909      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
910      ID_Base : aliased RTEMS.ID;
911   begin
912 
913      Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
914      ID := ID_Base;
915
916   end Semaphore_Ident;
917 
918   procedure Semaphore_Obtain (
919      ID         : in     RTEMS.ID;
920      Option_Set : in     RTEMS.Option;
921      Timeout    : in     RTEMS.Interval;
922      Result     :    out RTEMS.Status_Codes
923   ) is
924      function Semaphore_Obtain_Base (
925         ID         : RTEMS.ID;
926         Option_Set : RTEMS.Option;
927         Timeout    : RTEMS.Interval
928      )  return RTEMS.Status_Codes;
929      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
930   begin
931 
932      Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout );
933
934   end Semaphore_Obtain;
935 
936   procedure Semaphore_Release (
937      ID     : in     RTEMS.ID;
938      Result :    out RTEMS.Status_Codes
939   ) is
940      function Semaphore_Release_Base (
941         ID : RTEMS.ID
942      )  return RTEMS.Status_Codes;
943      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
944   begin
945 
946      Result := Semaphore_Release_Base ( ID );
947
948   end Semaphore_Release;
949 
950   --
951   -- Message Queue Manager
952   --
953 
954   procedure Message_Queue_Create (
955      Name             : in     RTEMS.Name;
956      Count            : in     RTEMS.Unsigned32;
957      Max_Message_Size : in     RTEMS.Unsigned32;
958      Attribute_Set    : in     RTEMS.Attribute;
959      ID               :    out RTEMS.ID;
960      Result           :    out RTEMS.Status_Codes
961   ) is
962      --  XXX broken
963      function Message_Queue_Create_Base (
964         Name             : RTEMS.Name;
965         Count            : RTEMS.Unsigned32;
966         Max_Message_Size : RTEMS.Unsigned32;
967         Attribute_Set    : RTEMS.Attribute;
968         ID               : access RTEMS.ID
969      )  return RTEMS.Status_Codes;
970      pragma Import (C,
971        Message_Queue_Create_Base, "rtems_message_queue_create");
972      ID_Base : aliased RTEMS.ID;
973   begin
974 
975      Result := Message_Queue_Create_Base (
976         Name,
977         Count,
978         Max_Message_Size,
979         Attribute_Set,
980         ID_Base'Unchecked_Access
981      );
982      ID := ID_Base;
983
984   end Message_Queue_Create;
985 
986   procedure Message_Queue_Ident (
987      Name   : in     RTEMS.Name;
988      Node   : in     RTEMS.Unsigned32;
989      ID     :    out RTEMS.ID;
990      Result :    out RTEMS.Status_Codes
991   ) is
992      function Message_Queue_Ident_Base (
993         Name : RTEMS.Name;
994         Node : RTEMS.Unsigned32;
995         ID   : access RTEMS.ID
996      )  return RTEMS.Status_Codes;
997      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
998      ID_Base : aliased RTEMS.ID;
999   begin
1000 
1001      Result :=
1002         Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
1003      ID := ID_Base;
1004
1005   end Message_Queue_Ident;
1006 
1007   procedure Message_Queue_Delete (
1008      ID     : in     RTEMS.ID;
1009      Result :    out RTEMS.Status_Codes
1010   ) is
1011      function Message_Queue_Delete_Base (
1012         ID : RTEMS.ID
1013      )  return RTEMS.Status_Codes;
1014      pragma Import (
1015         C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
1016   begin
1017 
1018      Result := Message_Queue_Delete_Base ( ID );
1019
1020   end Message_Queue_Delete;
1021 
1022   procedure Message_Queue_Send (
1023      ID     : in     RTEMS.ID;
1024      Buffer : in     RTEMS.Address;
1025      Size   : in     RTEMS.Unsigned32;
1026      Result :    out RTEMS.Status_Codes
1027   ) is
1028      function Message_Queue_Send_Base (
1029         ID     : RTEMS.ID;
1030         Buffer : RTEMS.Address;
1031         Size   : RTEMS.Unsigned32
1032      )  return RTEMS.Status_Codes;
1033      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
1034   begin
1035 
1036      Result := Message_Queue_Send_Base ( ID, Buffer, Size );
1037
1038   end Message_Queue_Send;
1039 
1040   procedure Message_Queue_Urgent (
1041      ID     : in     RTEMS.ID;
1042      Buffer : in     RTEMS.Address;
1043      Size   : in     RTEMS.Unsigned32;
1044      Result :    out RTEMS.Status_Codes
1045   ) is
1046      function Message_Queue_Urgent_Base (
1047         ID     : RTEMS.ID;
1048         Buffer : RTEMS.Address;
1049         Size   : RTEMS.Unsigned32
1050      )  return RTEMS.Status_Codes;
1051      pragma Import (C, Message_Queue_Urgent_Base,
1052         "rtems_message_queue_urgent");
1053   begin
1054 
1055      Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
1056
1057   end Message_Queue_Urgent;
1058 
1059   procedure Message_Queue_Broadcast (
1060      ID     : in     RTEMS.ID;
1061      Buffer : in     RTEMS.Address;
1062      Size   : in     RTEMS.Unsigned32;
1063      Count  :    out RTEMS.Unsigned32;
1064      Result :    out RTEMS.Status_Codes
1065   ) is
1066      function Message_Queue_Broadcast_Base (
1067         ID     : RTEMS.ID;
1068         Buffer : RTEMS.Address;
1069         Size   : RTEMS.Unsigned32;
1070         Count  : access RTEMS.Unsigned32
1071      )  return RTEMS.Status_Codes;
1072      pragma Import (C, Message_Queue_Broadcast_Base,
1073         "rtems_message_queue_broadcast");
1074      Count_Base : aliased RTEMS.Unsigned32;
1075   begin
1076 
1077      Result := Message_Queue_Broadcast_Base (
1078         ID,
1079         Buffer,
1080         Size,
1081         Count_Base'Unchecked_Access
1082      );
1083      Count := Count_Base;
1084
1085   end Message_Queue_Broadcast;
1086 
1087   procedure Message_Queue_Receive (
1088      ID         : in     RTEMS.ID;
1089      Buffer     : in     RTEMS.Address;
1090      Option_Set : in     RTEMS.Option;
1091      Timeout    : in     RTEMS.Interval;
1092      Size       :    out RTEMS.Unsigned32;
1093      Result     :    out RTEMS.Status_Codes
1094   ) is
1095      function Message_Queue_Receive_Base (
1096         ID         : RTEMS.ID;
1097         Buffer     : RTEMS.Address;
1098         Size       : access RTEMS.Unsigned32;
1099         Option_Set : RTEMS.Option;
1100         Timeout    : RTEMS.Interval
1101      )  return RTEMS.Status_Codes;
1102      pragma Import (C, Message_Queue_Receive_Base,
1103         "rtems_message_queue_receive");
1104      Size_Base : aliased RTEMS.Unsigned32;
1105   begin
1106 
1107      Result := Message_Queue_Receive_Base (
1108         ID,
1109         Buffer,
1110         Size_Base'Unchecked_Access,
1111         Option_Set,
1112         Timeout
1113      );
1114      Size := Size_Base;
1115
1116   end Message_Queue_Receive;
1117 
1118   procedure Message_Queue_Get_Number_Pending (
1119      ID     : in     RTEMS.ID;
1120      Count  :    out RTEMS.Unsigned32;
1121      Result :    out RTEMS.Status_Codes
1122   ) is
1123      function Message_Queue_Get_Number_Pending_Base (
1124         ID    : RTEMS.ID;
1125         Count : access RTEMS.Unsigned32
1126      )  return RTEMS.Status_Codes;
1127      pragma Import (
1128         C,
1129         Message_Queue_Get_Number_Pending_Base,
1130         "rtems_message_queue_get_number_pending"
1131      );
1132      COUNT_Base : aliased RTEMS.Unsigned32;
1133   begin
1134 
1135      Result := Message_Queue_Get_Number_Pending_Base (
1136         ID, COUNT_Base'Unchecked_Access
1137      );
1138      Count := COUNT_Base;
1139
1140   end Message_Queue_Get_Number_Pending;
1141 
1142   procedure Message_Queue_Flush (
1143      ID     : in     RTEMS.ID;
1144      Count  :    out RTEMS.Unsigned32;
1145      Result :    out RTEMS.Status_Codes
1146   ) is
1147      function Message_Queue_Flush_Base (
1148         ID    : RTEMS.ID;
1149         Count : access RTEMS.Unsigned32
1150      )  return RTEMS.Status_Codes;
1151      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1152      COUNT_Base : aliased RTEMS.Unsigned32;
1153   begin
1154 
1155      Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
1156      Count := COUNT_Base;
1157
1158   end Message_Queue_Flush;
1159 
1160   --
1161   -- Event Manager
1162   --
1163
1164   procedure Event_Send (
1165      ID       : in     RTEMS.ID;
1166      Event_In : in     RTEMS.Event_Set;
1167      Result   :    out RTEMS.Status_Codes
1168   ) is
1169      function Event_Send_Base (
1170         ID       : RTEMS.ID;
1171         Event_In : RTEMS.Event_Set
1172      )  return RTEMS.Status_Codes;
1173      pragma Import (C, Event_Send_Base, "rtems_event_send");
1174   begin
1175
1176      Result := Event_Send_Base ( ID, Event_In );
1177
1178   end Event_Send;
1179
1180   procedure Event_Receive (
1181      Event_In   : in     RTEMS.Event_Set;
1182      Option_Set : in     RTEMS.Option;
1183      Ticks      : in     RTEMS.Interval;
1184      Event_Out  :    out RTEMS.Event_Set;
1185      Result     :    out RTEMS.Status_Codes
1186   ) is
1187      function Event_Receive_Base (
1188         Event_In   : RTEMS.Event_Set;
1189         Option_Set : RTEMS.Option;
1190         Ticks      : RTEMS.Interval;
1191         Event_Out  : access RTEMS.Event_Set
1192      )  return RTEMS.Status_Codes;
1193      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1194      Event_Out_Base : aliased RTEMS.Event_Set;
1195   begin
1196
1197      Result := Event_Receive_Base (
1198         Event_In,
1199         Option_Set,
1200         Ticks,
1201         Event_Out_Base'Access
1202      );
1203      Event_Out := Event_Out_Base;
1204
1205   end Event_Receive;
1206
1207   --
1208   -- Signal Manager
1209   --
1210 
1211   procedure Signal_Catch (
1212      ASR_Handler : in     RTEMS.ASR_Handler;
1213      Mode_Set    : in     RTEMS.Mode;
1214      Result      :    out RTEMS.Status_Codes
1215   ) is
1216      function Signal_Catch_Base (
1217         ASR_Handler : RTEMS.ASR_Handler;
1218         Mode_Set    : RTEMS.Mode
1219      )  return RTEMS.Status_Codes;
1220      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1221   begin
1222
1223      Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
1224
1225   end Signal_Catch;
1226 
1227   procedure Signal_Send (
1228      ID         : in     RTEMS.ID;
1229      Signal_Set : in     RTEMS.Signal_Set;
1230      Result     :    out RTEMS.Status_Codes
1231   ) is
1232      function Signal_Send_Base (
1233         ID         : RTEMS.ID;
1234         Signal_Set : RTEMS.Signal_Set
1235      )  return RTEMS.Status_Codes;
1236      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1237   begin
1238 
1239      Result := Signal_Send_Base ( ID, Signal_Set );
1240
1241   end Signal_Send;
1242 
1243 
1244   --
1245   -- Partition Manager
1246   --
1247 
1248   procedure Partition_Create (
1249      Name             : in     RTEMS.Name;
1250      Starting_Address : in     RTEMS.Address;
1251      Length           : in     RTEMS.Unsigned32;
1252      Buffer_Size      : in     RTEMS.Unsigned32;
1253      Attribute_Set    : in     RTEMS.Attribute;
1254      ID               :    out RTEMS.ID;
1255      Result           :    out RTEMS.Status_Codes
1256   ) is
1257      function Partition_Create_Base (
1258         Name             : RTEMS.Name;
1259         Starting_Address : RTEMS.Address;
1260         Length           : RTEMS.Unsigned32;
1261         Buffer_Size      : RTEMS.Unsigned32;
1262         Attribute_Set    : RTEMS.Attribute;
1263         ID               : access RTEMS.Event_Set
1264      )  return RTEMS.Status_Codes;
1265      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1266      ID_Base : aliased RTEMS.ID;
1267   begin
1268 
1269      Result := Partition_Create_Base (
1270         Name,
1271         Starting_Address,
1272         Length,
1273         Buffer_Size,
1274         Attribute_Set,
1275         ID_Base'Unchecked_Access
1276      );
1277      ID := ID_Base;
1278 
1279   end Partition_Create;
1280 
1281   procedure Partition_Ident (
1282      Name   : in     RTEMS.Name;
1283      Node   : in     RTEMS.Unsigned32;
1284      ID     :    out RTEMS.ID;
1285      Result :    out RTEMS.Status_Codes
1286   ) is
1287      function Partition_Ident_Base (
1288         Name : RTEMS.Name;
1289         Node : RTEMS.Unsigned32;
1290         ID   : access RTEMS.Event_Set
1291      )  return RTEMS.Status_Codes;
1292      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1293      ID_Base : aliased RTEMS.ID;
1294   begin
1295 
1296      Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
1297      ID := ID_Base;
1298
1299   end Partition_Ident;
1300 
1301   procedure Partition_Delete (
1302      ID     : in     RTEMS.ID;
1303      Result :    out RTEMS.Status_Codes
1304   ) is
1305      function Partition_Delete_Base (
1306         ID : RTEMS.ID
1307      )  return RTEMS.Status_Codes;
1308      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1309   begin
1310 
1311      Result := Partition_Delete_Base ( ID );
1312
1313   end Partition_Delete;
1314 
1315   procedure Partition_Get_Buffer (
1316      ID     : in     RTEMS.ID;
1317      Buffer :    out RTEMS.Address;
1318      Result :    out RTEMS.Status_Codes
1319   ) is
1320      function Partition_Get_Buffer_Base (
1321         ID     : RTEMS.ID;
1322         Buffer : access RTEMS.Address
1323      )  return RTEMS.Status_Codes;
1324      pragma Import (C, Partition_Get_Buffer_Base,
1325         "rtems_partition_get_buffer");
1326      Buffer_Base : aliased RTEMS.Address;
1327   begin
1328 
1329      Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
1330      Buffer := Buffer_Base;
1331
1332   end Partition_Get_Buffer;
1333 
1334   procedure Partition_Return_Buffer (
1335      ID     : in     RTEMS.ID;
1336      Buffer : in     RTEMS.Address;
1337      Result :    out RTEMS.Status_Codes
1338   ) is
1339      function Partition_Return_Buffer_Base (
1340         ID     : RTEMS.Name;
1341         Buffer : RTEMS.Address
1342      )  return RTEMS.Status_Codes;
1343      pragma Import (C, Partition_Return_Buffer_Base,
1344         "rtems_partition_return_buffer");
1345   begin
1346 
1347      Result := Partition_Return_Buffer_Base ( ID, Buffer );
1348
1349   end Partition_Return_Buffer;
1350
1351   --
1352   -- Region Manager
1353   --
1354 
1355   procedure Region_Create (
1356      Name             : in     RTEMS.Name;
1357      Starting_Address : in     RTEMS.Address;
1358      Length           : in     RTEMS.Unsigned32;
1359      Page_Size        : in     RTEMS.Unsigned32;
1360      Attribute_Set    : in     RTEMS.Attribute;
1361      ID               :    out RTEMS.ID;
1362      Result           :    out RTEMS.Status_Codes
1363   ) is
1364      function Region_Create_Base (
1365         Name             : RTEMS.Name;
1366         Starting_Address : RTEMS.Address;
1367         Length           : RTEMS.Unsigned32;
1368         Page_Size        : RTEMS.Unsigned32;
1369         Attribute_Set    : RTEMS.Attribute;
1370         ID               : access RTEMS.ID
1371      )  return RTEMS.Status_Codes;
1372      pragma Import (C, Region_Create_Base, "rtems_region_create");
1373      ID_Base : aliased RTEMS.ID;
1374   begin
1375 
1376      Result := Region_Create_Base (
1377         Name,
1378         Starting_Address,
1379         Length,
1380         Page_Size,
1381         Attribute_Set,
1382         ID_Base'Unchecked_Access
1383      );
1384      ID := ID_Base;
1385
1386   end Region_Create;
1387 
1388   procedure Region_Ident (
1389      Name   : in     RTEMS.Name;
1390      ID     :    out RTEMS.ID;
1391      Result :    out RTEMS.Status_Codes
1392   ) is
1393      function Region_Ident_Base (
1394         Name   : RTEMS.Name;
1395         ID     : access RTEMS.ID
1396      )  return RTEMS.Status_Codes;
1397      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1398      ID_Base : aliased RTEMS.ID;
1399   begin
1400 
1401      Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
1402      ID := ID_Base;
1403
1404   end Region_Ident;
1405 
1406   procedure Region_Delete (
1407      ID     : in     RTEMS.ID;
1408      Result :    out RTEMS.Status_Codes
1409   ) is
1410      function Region_Delete_Base (
1411         ID : RTEMS.ID
1412      )  return RTEMS.Status_Codes;
1413      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1414   begin
1415 
1416      Result := Region_Delete_Base ( ID );
1417
1418   end Region_Delete;
1419 
1420   procedure Region_Extend (
1421      ID               : in     RTEMS.ID;
1422      Starting_Address : in     RTEMS.Address;
1423      Length           : in     RTEMS.Unsigned32;
1424      Result           :    out RTEMS.Status_Codes
1425   ) is
1426      function Region_Extend_Base (
1427         ID               : RTEMS.ID;
1428         Starting_Address : RTEMS.Address;
1429         Length           : RTEMS.Unsigned32
1430      )  return RTEMS.Status_Codes;
1431      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1432   begin
1433 
1434      Result := Region_Extend_Base ( ID, Starting_Address, Length );
1435
1436   end Region_Extend;
1437 
1438   procedure Region_Get_Segment (
1439      ID         : in     RTEMS.ID;
1440      Size       : in     RTEMS.Unsigned32;
1441      Option_Set : in     RTEMS.Option;
1442      Timeout    : in     RTEMS.Interval;
1443      Segment    :    out RTEMS.Address;
1444      Result     :    out RTEMS.Status_Codes
1445   ) is
1446      function Region_Get_Segment_Base (
1447         ID         : RTEMS.ID;
1448         Size       : RTEMS.Unsigned32;
1449         Option_Set : RTEMS.Option;
1450         Timeout    : RTEMS.Interval;
1451         Segment    : access RTEMS.Address
1452      )  return RTEMS.Status_Codes;
1453      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1454      Segment_Base : aliased RTEMS.Address;
1455   begin
1456 
1457      Result := Region_Get_Segment_Base (
1458         ID,
1459         Size,
1460         Option_Set,
1461         Timeout,
1462         Segment_Base'Unchecked_Access
1463      );
1464      Segment := SEGMENT_Base;
1465
1466   end Region_Get_Segment;
1467 
1468   procedure Region_Get_Segment_Size (
1469      ID      : in     RTEMS.ID;
1470      Segment : in     RTEMS.Address;
1471      Size    :    out RTEMS.Unsigned32;
1472      Result  :    out RTEMS.Status_Codes
1473   ) is
1474      function Region_Get_Segment_Size_Base (
1475         ID      : RTEMS.ID;
1476         Segment : RTEMS.Address;
1477         Size    : access RTEMS.Unsigned32
1478      )  return RTEMS.Status_Codes;
1479      pragma Import (C, Region_Get_Segment_Size_Base,
1480         "rtems_region_get_segment_size");
1481      Size_Base : aliased RTEMS.Unsigned32;
1482   begin
1483 
1484      Result := Region_Get_Segment_Size_Base (
1485         ID,
1486         Segment,
1487         Size_Base'Unchecked_Access
1488      );
1489      Size := SIZE_Base;
1490
1491   end Region_Get_Segment_Size;
1492 
1493   procedure Region_Return_Segment (
1494      ID      : in     RTEMS.ID;
1495      Segment : in     RTEMS.Address;
1496      Result  :    out RTEMS.Status_Codes
1497   ) is
1498      function Region_Return_Segment_Base (
1499         ID      : RTEMS.ID;
1500         Segment : RTEMS.Address
1501      )  return RTEMS.Status_Codes;
1502      pragma Import (C, Region_Return_Segment_Base,
1503         "rtems_region_return_segment");
1504   begin
1505 
1506      Result := Region_Return_Segment_Base ( ID, Segment );
1507
1508   end Region_Return_Segment;
1509 
1510   --
1511   -- Dual Ported Memory Manager
1512   --
1513 
1514   procedure Port_Create (
1515      Name           : in     RTEMS.Name;
1516      Internal_Start : in     RTEMS.Address;
1517      External_Start : in     RTEMS.Address;
1518      Length         : in     RTEMS.Unsigned32;
1519      ID             :    out RTEMS.ID;
1520      Result         :    out RTEMS.Status_Codes
1521   ) is
1522      function Port_Create_Base (
1523         Name           : RTEMS.Name;
1524         Internal_Start : RTEMS.Address;
1525         External_Start : RTEMS.Address;
1526         Length         : RTEMS.Unsigned32;
1527         ID             : access RTEMS.ID
1528      )  return RTEMS.Status_Codes;
1529      pragma Import (C, Port_Create_Base, "rtems_port_create");
1530      ID_Base : aliased RTEMS.ID;
1531   begin
1532 
1533      Result := Port_Create_Base (
1534         Name,
1535         Internal_Start,
1536         External_Start,
1537         Length,
1538         ID_Base'Unchecked_Access
1539      );
1540      ID := ID_Base;
1541
1542   end Port_Create;
1543 
1544   procedure Port_Ident (
1545      Name   : in     RTEMS.Name;
1546      ID     :    out RTEMS.ID;
1547      Result :    out RTEMS.Status_Codes
1548   ) is
1549      function Port_Ident_Base (
1550         Name : RTEMS.Name;
1551         ID   : access RTEMS.ID
1552      )  return RTEMS.Status_Codes;
1553      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1554      ID_Base : aliased RTEMS.ID;
1555   begin
1556 
1557      Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
1558      ID := ID_Base;
1559
1560   end Port_Ident;
1561 
1562   procedure Port_Delete (
1563      ID     : in     RTEMS.ID;
1564      Result :    out RTEMS.Status_Codes
1565   ) is
1566      function Port_Delete_Base (
1567         ID : RTEMS.ID
1568      )  return RTEMS.Status_Codes;
1569      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1570   begin
1571 
1572      Result := Port_Delete_Base ( ID );
1573
1574   end Port_Delete;
1575 
1576   procedure Port_External_To_Internal (
1577      ID       : in     RTEMS.ID;
1578      External : in     RTEMS.Address;
1579      Internal :    out RTEMS.Address;
1580      Result   :    out RTEMS.Status_Codes
1581   ) is
1582      function Port_External_To_Internal_Base (
1583         ID       : RTEMS.ID;
1584         External : RTEMS.Address;
1585         Internal : access RTEMS.Address
1586      )  return RTEMS.Status_Codes;
1587      pragma Import (C, Port_External_To_Internal_Base,
1588         "rtems_port_external_to_internal");
1589      Internal_Base : aliased RTEMS.Address;
1590   begin
1591 
1592      Result := Port_External_To_Internal_Base (
1593         ID,
1594         External,
1595         Internal_Base'Unchecked_Access
1596      );
1597      Internal := INTERNAL_Base;
1598
1599   end Port_External_To_Internal;
1600 
1601   procedure Port_Internal_To_External (
1602      ID       : in     RTEMS.ID;
1603      Internal : in     RTEMS.Address;
1604      External :    out RTEMS.Address;
1605      Result   :    out RTEMS.Status_Codes
1606   ) is
1607      function Port_Internal_To_External_Base (
1608         ID       : RTEMS.ID;
1609         Internal : RTEMS.Address;
1610         External : access RTEMS.Address
1611      )  return RTEMS.Status_Codes;
1612      pragma Import (C, Port_Internal_To_External_Base,
1613         "rtems_port_internal_to_external");
1614      External_Base : aliased RTEMS.Address;
1615   begin
1616 
1617      Result := Port_Internal_To_External_Base (
1618         ID,
1619         Internal,
1620         External_Base'Unchecked_Access
1621      );
1622      External := EXTERNAL_Base;
1623
1624   end Port_Internal_To_External;
1625 
1626 
1627   --
1628   -- Fatal Error Manager
1629   --
1630 
1631   procedure Fatal_Error_Occurred (
1632      The_Error : in     RTEMS.Unsigned32
1633   ) is
1634      procedure Fatal_Error_Occurred_base (
1635         The_Error : RTEMS.Unsigned32
1636      );
1637   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1638   begin
1639 
1640      Fatal_Error_Occurred_Base ( The_Error );
1641
1642   end Fatal_Error_Occurred;
1643
1644
1645   --
1646   -- Rate Monotonic Manager
1647   --
1648 
1649   procedure Rate_Monotonic_Create (
1650      Name   : in     RTEMS.Name;
1651      ID     :    out RTEMS.ID;
1652      Result :    out RTEMS.Status_Codes
1653   ) is
1654      function Rate_Monotonic_Create_base (
1655         Name   : RTEMS.Name;
1656         ID     : access RTEMS.ID
1657      )  return RTEMS.Status_Codes;
1658      pragma Import (C, Rate_Monotonic_Create_base, "rtems_rate_monotonic_create");
1659      ID_Base : aliased RTEMS.ID;
1660   begin
1661 
1662      Result := Rate_Monotonic_Create_base ( Name, ID_Base'Unchecked_Access );
1663      ID := ID_Base;
1664
1665   end Rate_Monotonic_Create;
1666 
1667   procedure Rate_Monotonic_Ident (
1668      Name   : in     RTEMS.Name;
1669      ID     :    out RTEMS.ID;
1670      Result :    out RTEMS.Status_Codes
1671   ) is
1672      function Rate_Monotonic_Ident_Base (
1673         Name   : RTEMS.Name;
1674         ID     : access RTEMS.ID
1675      )  return RTEMS.Status_Codes;
1676      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1677      ID_Base : aliased RTEMS.ID;
1678   begin
1679 
1680      Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
1681 
1682      ID := ID_Base;
1683
1684   end Rate_Monotonic_Ident;
1685 
1686   procedure Rate_Monotonic_Delete (
1687      ID     : in     RTEMS.ID;
1688      Result :    out RTEMS.Status_Codes
1689   ) is
1690      function Rate_Monotonic_Delete_Base (
1691         ID : RTEMS.ID
1692      )  return RTEMS.Status_Codes;
1693      pragma Import (C, Rate_Monotonic_Delete_Base,
1694         "rtems_rate_monotonic_delete");
1695   begin
1696 
1697      Result := Rate_Monotonic_Delete_base ( ID );
1698
1699   end Rate_Monotonic_Delete;
1700 
1701   procedure Rate_Monotonic_Cancel (
1702      ID     : in     RTEMS.ID;
1703      Result :    out RTEMS.Status_Codes
1704   ) is
1705      function Rate_Monotonic_Cancel_Base (
1706         ID : RTEMS.ID
1707      )  return RTEMS.Status_Codes;
1708      pragma Import (C, Rate_Monotonic_Cancel_Base,
1709         "rtems_rate_monotonic_cancel");
1710   begin
1711 
1712      Result := Rate_Monotonic_Cancel_Base ( ID );
1713
1714   end Rate_Monotonic_Cancel;
1715 
1716   procedure Rate_Monotonic_Period (
1717      ID      : in     RTEMS.ID;
1718      Length  : in     RTEMS.Interval;
1719      Result  :    out RTEMS.Status_Codes
1720   ) is
1721      function Rate_Monotonic_Period_Base (
1722         ID     : RTEMS.ID;
1723         Length : RTEMS.Interval
1724      )  return RTEMS.Status_Codes;
1725      pragma Import (C, Rate_Monotonic_Period_Base,
1726         "rtems_rate_monotonic_period");
1727   begin
1728 
1729      Result := Rate_Monotonic_Period_base ( ID, Length );
1730
1731   end Rate_Monotonic_Period;
1732 
1733 
1734   procedure Rate_Monotonic_Get_Status (
1735      ID      : in     RTEMS.ID;
1736      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1737      Result  :    out RTEMS.Status_Codes
1738   ) is
1739      function Rate_Monotonic_Get_Status_Base (
1740         ID      : RTEMS.ID;
1741         Status  : access RTEMS.Rate_Monotonic_Period_Status
1742      )  return RTEMS.Status_Codes;
1743      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1744         "rtems_rate_monotonic_get_status");
1745
1746      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1747   begin
1748
1749      Result := Rate_Monotonic_Get_Status_Base (
1750         ID,
1751         Status_Base'Unchecked_Access
1752      );
1753
1754      Status := Status_Base;
1755
1756
1757   end Rate_Monotonic_Get_Status;
1758
1759 
1760   --
1761   -- Debug Manager
1762   --
1763 
1764   procedure Debug_Enable (
1765      To_Be_Enabled : in     RTEMS.Debug_Set
1766   ) is
1767      procedure Debug_Enable_Base (
1768         To_Be_Enabled : RTEMS.Debug_Set
1769      );
1770   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
1771   begin
1772 
1773      Debug_Enable_Base ( To_Be_Enabled );
1774
1775   end Debug_Enable;
1776 
1777   procedure Debug_Disable (
1778      To_Be_Disabled : in     RTEMS.Debug_Set
1779   ) is
1780      procedure Debug_Disable_Base (
1781         To_Be_Disabled : RTEMS.Debug_Set
1782      );
1783   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
1784   begin
1785 
1786      Debug_Disable_Base ( To_Be_Disabled );
1787
1788   end Debug_Disable;
1789 
1790   function Debug_Is_Enabled (
1791      Level : in     RTEMS.Debug_Set
1792   ) return RTEMS.Boolean is
1793      function Debug_Is_Enabled_Base (
1794         Level : RTEMS.Debug_Set
1795      )  return RTEMS.Boolean;
1796      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
1797   begin
1798 
1799      return Debug_Is_Enabled_Base ( Level );
1800
1801   end Debug_Is_Enabled;
1802
1803end RTEMS;
Note: See TracBrowser for help on using the repository browser.