source: rtems/c/src/ada/rtems.adb @ 98e6eb8

4.104.114.84.95
Last change on this file since 98e6eb8 was 1e3e81f, checked in by Joel Sherrill <joel.sherrill@…>, on 10/07/99 at 16:17:41

Added Is_Suspended method.
  • Property mode set to 100644
File size: 54.4 KB
Line 
1--
2--  RTEMS / Body
3--  DESCRIPTION:
4--
5--  This package provides the interface to the RTEMS API.
6-- 
7--
8--  DEPENDENCIES:
9--
10--
11--
12--  COPYRIGHT (c) 1997.
13--  On-Line Applications Research Corporation (OAR).
14--
15--  The license and distribution terms for this file may in
16--  the file LICENSE in this distribution or at
17--  http://www.OARcorp.com/rtems/license.html.
18--
19--  $Id$
20--
21
22with Ada;
23with Ada.Unchecked_Conversion;
24with System;
25with Interfaces; use Interfaces;
26with Interfaces.C;
27
28package body RTEMS is
29
30   --
31   --  Utility Functions
32   --
33 
34   function From_Ada_Boolean (
35      Ada_Boolean : Standard.Boolean
36   ) return RTEMS.Boolean is
37   begin
38
39      if Ada_Boolean = Standard.True then
40         return RTEMS.True;
41      end if;
42
43      return RTEMS.False;
44
45   end From_Ada_Boolean;
46 
47   function To_Ada_Boolean (
48      RTEMS_Boolean : RTEMS.Boolean
49   ) return Standard.Boolean is
50   begin
51
52      if RTEMS_Boolean = RTEMS.True then
53         return Standard.True;
54      end if;
55
56      return Standard.False;
57
58   end To_Ada_Boolean;
59
60   function Milliseconds_To_Microseconds (
61      Milliseconds : RTEMS.Unsigned32
62   ) return RTEMS.Unsigned32 is
63   begin
64
65      return Milliseconds * 1000;
66
67   end Milliseconds_To_Microseconds;
68
69   function Microseconds_To_Ticks (
70      Microseconds : RTEMS.Unsigned32
71   ) return RTEMS.Interval is
72      Microseconds_Per_Tick : RTEMS.Interval;
73      pragma Import (C, Microseconds_Per_Tick, "_TOD_Microseconds_per_tick");
74   begin
75
76      return Microseconds / Microseconds_Per_Tick;
77
78   end Microseconds_To_Ticks;
79
80   function Milliseconds_To_Ticks (
81      Milliseconds : RTEMS.Unsigned32
82   ) return RTEMS.Interval is
83   begin
84
85      return Microseconds_To_Ticks(Milliseconds_To_Microseconds(Milliseconds));
86
87   end Milliseconds_To_Ticks;
88
89   function Build_Name (
90      C1 : in     Character;
91      C2 : in     Character;
92      C3 : in     Character;
93      C4 : in     Character
94   ) return RTEMS.Name is
95      C1_Value : RTEMS.Unsigned32;
96      C2_Value : RTEMS.Unsigned32;
97      C3_Value : RTEMS.Unsigned32;
98      C4_Value : RTEMS.Unsigned32;
99   begin
100
101     C1_Value := Character'Pos( C1 );
102     C2_Value := Character'Pos( C2 );
103     C3_Value := Character'Pos( C3 );
104     C4_Value := Character'Pos( C4 );
105
106     return Interfaces.Shift_Left( C1_Value, 24 ) or
107            Interfaces.Shift_Left( C2_Value, 16 ) or
108            Interfaces.Shift_Left( C3_Value, 8 )  or
109            C4_Value;
110
111   end Build_Name;
112
113   procedure Name_To_Characters (
114      Name : in     RTEMS.Name;
115      C1   :    out Character;
116      C2   :    out Character;
117      C3   :    out Character;
118      C4   :    out Character
119   ) is
120      C1_Value : RTEMS.Unsigned32;
121      C2_Value : RTEMS.Unsigned32;
122      C3_Value : RTEMS.Unsigned32;
123      C4_Value : RTEMS.Unsigned32;
124   begin
125
126     C1_Value := Interfaces.Shift_Right( Name, 24 );
127     C2_Value := Interfaces.Shift_Right( Name, 16 );
128     C3_Value := Interfaces.Shift_Right( Name, 8 );
129     C4_Value := Name;
130
131     C1_Value := C1_Value and 16#00FF#;
132     C2_Value := C2_Value and 16#00FF#;
133     C3_Value := C3_Value and 16#00FF#;
134     C4_Value := C4_Value and 16#00FF#;
135
136     C1 := Character'Val( C1_Value );
137     C2 := Character'Val( C2_Value );
138     C3 := Character'Val( C3_Value );
139     C4 := Character'Val( C4_Value );
140
141   end Name_To_Characters;
142
143   function Get_Node (
144      ID : in     RTEMS.ID
145   ) return RTEMS.Unsigned32 is
146   begin
147
148      -- May not be right
149      return Interfaces.Shift_Right( ID, 16 );
150
151   end Get_Node;
152
153   function Get_Index (
154      ID : in     RTEMS.ID
155   ) return RTEMS.Unsigned32 is
156   begin
157
158      -- May not be right
159      return ID and 16#FFFF#;
160
161   end Get_Index;
162
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   --
216   --  RTEMS API
217   --
218
219   --
220   --  Initialization Manager
221   --
222
223   procedure Initialize_Executive (
224      Configuration_Table   : in     RTEMS.Configuration_Table_Pointer;
225      CPU_Table             : in     RTEMS.CPU_Table_Pointer
226   ) is
227      procedure Initialize_Executive_Base (
228         Configuration_Table   : in     RTEMS.Configuration_Table_Pointer;
229         CPU_Table             : in     RTEMS.CPU_Table_Pointer
230      );
231      pragma Import (C, Initialize_Executive_Base,
232         "rtems_initialize_executive");
233
234   begin
235
236      Initialize_Executive_Base (Configuration_Table, CPU_Table);
237
238   end Initialize_Executive;
239 
240   procedure Initialize_Executive_Early (
241      Configuration_Table : in     RTEMS.Configuration_Table_Pointer;
242      CPU_Table           : in     RTEMS.CPU_Table_Pointer;
243      Level               :    out RTEMS.ISR_Level
244   ) is
245      function Initialize_Executive_Early_Base (
246         Configuration_Table   : in     RTEMS.Configuration_Table_Pointer;
247         CPU_Table             : in     RTEMS.CPU_Table_Pointer
248      ) return RTEMS.ISR_Level;
249      pragma Import (C, Initialize_Executive_Early_Base,
250         "rtems_initialize_executive_early");
251
252   begin
253
254      Level := Initialize_Executive_Early_Base (Configuration_Table, CPU_Table);
255
256   end Initialize_Executive_Early;
257
258   procedure Initialize_Executive_Late (
259      BSP_Level : in    RTEMS.ISR_Level
260   ) is
261      procedure Initialize_Executive_Late_Base (
262         Level : in     RTEMS.ISR_Level
263      );
264      pragma Import (C, Initialize_Executive_Late_Base,
265         "rtems_initialize_executive_late");
266
267   begin
268
269      Initialize_Executive_Late_Base (BSP_Level);
270
271   end Initialize_Executive_Late;
272
273   procedure Shutdown_Executive (
274      Result : in     RTEMS.Unsigned32
275   ) is
276      procedure Shutdown_Executive_Base;
277      pragma Import (C,Shutdown_Executive_Base,"rtems_shutdown_executive");
278   begin
279
280      Shutdown_Executive_Base;
281
282   end Shutdown_Executive;
283
284
285   --
286   --  Task Manager
287   --
288
289   procedure Task_Create (
290      Name             : in     RTEMS.Name;
291      Initial_Priority : in     RTEMS.Task_Priority;
292      Stack_Size       : in     RTEMS.Unsigned32;
293      Initial_Modes    : in     RTEMS.Mode;
294      Attribute_Set    : in     RTEMS.Attribute;
295      ID               :    out RTEMS.ID;
296      Result           :    out RTEMS.Status_Codes
297   ) is
298      function Task_Create_Base (
299         Name             : RTEMS.Name;
300         Initial_Priority : RTEMS.Task_Priority;
301         Stack_Size       : RTEMS.Unsigned32;
302         Initial_Modes    : RTEMS.Mode;
303         Attribute_Set    : RTEMS.Attribute;
304         ID               : access RTEMS.ID
305      )  return RTEMS.Status_Codes;
306         pragma Import (C, Task_Create_Base, "rtems_task_create");
307         ID_Base : aliased RTEMS.ID := ID;
308   begin
309      Result := Task_Create_Base (
310                   Name,
311                   Initial_Priority,
312                   Stack_Size,
313                   Initial_Modes,
314                   Attribute_Set,
315                   ID_Base'Unchecked_Access
316                );
317      ID := ID_Base;
318   end Task_Create;
319
320
321   procedure Task_Ident (
322      Name             : in     RTEMS.Name;
323      Node             : in     RTEMS.Node;
324      ID               :    out RTEMS.ID;
325      Result           :    out RTEMS.Status_Codes
326   ) is
327
328      function Task_Ident_Base (
329         Name             : RTEMS.Name;
330         Node             : RTEMS.Node;
331         ID               : access RTEMS.ID
332      )  return RTEMS.Status_Codes;
333      pragma Import (C, Task_Ident_Base, "rtems_task_ident");
334      ID_Base     : aliased RTEMS.ID := ID;
335
336   begin
337
338      Result := Task_Ident_Base (
339                        Name,
340                        Node,
341                        ID_Base'Unchecked_Access
342                     );
343
344      ID := ID_Base;
345
346   end Task_Ident;
347
348   procedure Task_Start (
349      ID          : in     RTEMS.ID;
350      Entry_Point : in     RTEMS.Task_Entry;
351      Argument    : in     RTEMS.Task_Argument;
352      Result      :    out RTEMS.Status_Codes
353   ) is
354
355      function Task_Start_Base (
356         ID          : RTEMS.ID;
357         Entry_Point : RTEMS.Task_Entry;
358         Argument    : RTEMS.Task_Argument
359      )  return RTEMS.Status_Codes;
360      pragma Import (C, Task_Start_Base, "rtems_task_start");
361
362   begin
363
364      Result := Task_Start_Base (
365                        ID,
366                        Entry_Point,
367                        Argument
368                     );
369
370   end Task_Start;
371
372   procedure Task_Restart (
373      ID       : in     RTEMS.ID;
374      Argument : in     RTEMS.Task_Argument;
375      Result   :    out RTEMS.Status_Codes
376   ) is
377      function Task_Restart_Base (
378         ID       : RTEMS.ID;
379         Argument : RTEMS.Task_Argument
380      )  return RTEMS.Status_Codes;
381      pragma Import (C, Task_Restart_Base, "rtems_task_restart");
382   begin
383
384      Result := Task_Restart_Base (
385                        ID,
386                        Argument
387                     );
388 
389   end Task_Restart;
390 
391   procedure Task_Delete (
392      ID     : in     RTEMS.ID;
393      Result :    out RTEMS.Status_Codes
394   ) is
395      function Task_Delete_Base (
396         ID : RTEMS.ID
397      )  return RTEMS.Status_Codes;
398      pragma Import (C, Task_Delete_Base, "rtems_task_delete");
399   begin
400
401      Result := Task_Delete_Base ( ID );
402 
403   end Task_Delete;
404 
405   procedure Task_Suspend (
406      ID     : in     RTEMS.ID;
407      Result :    out RTEMS.Status_Codes
408   ) is
409      function Task_Suspend_Base (
410         ID : RTEMS.ID
411      )  return RTEMS.Status_Codes;
412      pragma Import (C, Task_Suspend_Base, "rtems_task_suspend");
413   begin
414
415      Result := Task_Suspend_Base ( ID );
416 
417   end Task_Suspend;
418 
419   procedure Task_Resume (
420      ID     : in     RTEMS.ID;
421      Result :    out RTEMS.Status_Codes
422   ) is
423      function Task_Resume_Base (
424         ID : RTEMS.ID
425      )  return RTEMS.Status_Codes;
426      pragma Import (C, Task_Resume_Base, "rtems_task_resume");
427   begin
428
429      Result := Task_Resume_Base ( ID );
430
431   end Task_Resume;
432
433   procedure Task_Is_Suspended (
434      ID     : in     RTEMS.ID;
435      Result :    out RTEMS.Status_Codes
436   ) is
437      function Task_Is_Suspended (
438         ID : RTEMS.ID
439      )  return RTEMS.Status_Codes;
440      pragma Import (C, Task_Is_Suspended_Base, "rtems_task_is_suspended");
441   begin
442
443      Result := Task_Is_Suspended_Base ( ID );
444
445   end Task_Is_Suspended;
446
447 
448   procedure Task_Set_Priority (
449      ID           : in     RTEMS.ID;
450      New_Priority : in     RTEMS.Task_Priority;
451      Old_Priority :    out RTEMS.Task_Priority;
452      Result       :    out RTEMS.Status_Codes
453   ) is
454      function Task_Set_Priority_Base (
455         ID           : RTEMS.ID;
456         New_Priority : RTEMS.Task_Priority;
457         Old_Priority : access RTEMS.Task_Priority
458      )  return RTEMS.Status_Codes;
459      pragma Import (C, Task_Set_Priority_Base, "rtems_task_set_priority");
460      Old_Priority_Base : aliased RTEMS.Task_Priority := Old_Priority;
461 
462   begin
463 
464      Result := Task_Set_Priority_Base (
465                        ID,
466                        New_Priority,
467                        Old_Priority_Base'Unchecked_Access
468                     );
469 
470      Old_Priority := Old_Priority_Base;
471
472   end Task_Set_Priority;
473 
474   procedure Task_Mode (
475      Mode_Set          : in     RTEMS.Mode;
476      Mask              : in     RTEMS.Mode;
477      Previous_Mode_Set :    out RTEMS.Mode;
478      Result            :    out RTEMS.Status_Codes
479   ) is
480      function Task_Mode_Base (
481         Mode_Set          : RTEMS.Mode;
482         Mask              : RTEMS.Mode;
483         Previous_Mode_Set : access RTEMS.Mode
484      )  return RTEMS.Status_Codes;
485      pragma Import (C, Task_Mode_Base, "rtems_task_mode");
486      Previous_Mode_Set_Base : aliased RTEMS.Mode := Previous_Mode_Set;
487   begin
488
489      Result := Task_Mode_Base (
490         Mode_Set,
491         Mask,
492         Previous_Mode_Set_Base'Unchecked_Access
493      );
494
495      Previous_Mode_Set := Previous_Mode_Set_Base;
496
497   end Task_Mode;
498 
499   procedure Task_Get_Note (
500      ID      : in     RTEMS.ID;
501      Notepad : in     RTEMS.Notepad_Index;
502      Note    :    out RTEMS.Unsigned32;
503      Result  :    out RTEMS.Status_Codes
504   ) is
505      function Task_Get_Note_Base (
506         ID      : RTEMS.ID;
507         Notepad : RTEMS.Notepad_Index;
508         Note    : access RTEMS.Unsigned32
509      )  return RTEMS.Status_Codes;
510      pragma Import (C, Task_Get_Note_Base, "rtems_task_get_note");
511      Note_Base : aliased RTEMS.Unsigned32 := Note;
512   begin
513
514      Result := Task_Get_Note_Base (
515         ID,
516         Notepad,
517         Note_Base'Unchecked_Access
518      );
519 
520      Note := NOTE_Base;
521
522   end Task_Get_Note;
523 
524   procedure Task_Set_Note (
525      ID      : in     RTEMS.ID;
526      Notepad : in     RTEMS.Notepad_Index;
527      Note    : in     RTEMS.Unsigned32;
528      Result  :    out RTEMS.Status_Codes
529   ) is
530      function Task_Set_Note_Base (
531         ID      : RTEMS.ID;
532         Notepad : RTEMS.Notepad_Index;
533         Note    : RTEMS.Unsigned32
534      )  return RTEMS.Status_Codes;
535      pragma Import (C, Task_Set_Note_Base, "rtems_task_set_note");
536   begin
537
538      Result := Task_Set_Note_Base ( ID, Notepad, Note );
539
540   end Task_Set_Note;
541 
542   procedure Task_Wake_When (
543      Time_Buffer : in     RTEMS.Time_Of_Day;
544      Result      :    out RTEMS.Status_Codes
545   ) is
546      function Task_Wake_When_Base (
547         Time_Buffer : RTEMS.Time_Of_Day
548      )  return RTEMS.Status_Codes;
549      pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
550   begin
551
552      Result := Task_Wake_When_Base ( Time_Buffer );
553
554   end Task_Wake_When;
555 
556   procedure Task_Wake_After (
557      Ticks  : in     RTEMS.Interval;
558      Result :    out RTEMS.Status_Codes
559   ) is
560      function Task_Wake_After_Base (
561         Ticks : RTEMS.Interval
562      )  return RTEMS.Status_Codes;
563      pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
564   begin
565
566      Result := Task_Wake_After_Base ( Ticks );
567
568   end Task_Wake_After;
569 
570   --
571   -- Interrupt Manager
572   --
573
574   procedure Interrupt_Catch (
575      New_ISR_Handler : in     RTEMS.Address;
576      Vector          : in     RTEMS.Vector_Number;
577      Old_ISR_Handler :    out RTEMS.Address;
578      Result          :    out RTEMS.Status_Codes
579   ) is
580      function Interrupt_Catch_Base (
581         New_ISR_Handler : RTEMS.Address;
582         Vector          : RTEMS.Vector_Number;
583         Old_ISR_Handler : access RTEMS.Address
584      )  return RTEMS.Status_Codes;
585      pragma Import (C, Interrupt_Catch_Base, "rtems_interrupt_catch");
586      Old_ISR_Handler_Base : aliased RTEMS.Address := Old_ISR_Handler;
587   begin
588 
589      Result := Interrupt_Catch_Base (
590         New_ISR_Handler,
591         Vector,
592         OLD_ISR_HANDLER_Base'Unchecked_Access
593      );
594 
595      Old_ISR_Handler := OLD_ISR_HANDLER_Base;
596 
597   end Interrupt_Catch;
598
599   -- XXX
600   function Interrupt_Disable
601   return RTEMS.ISR_Level is
602   begin
603      return 0;
604   end Interrupt_Disable;
605
606   procedure Interrupt_Enable (
607      Level : in     RTEMS.ISR_Level
608   ) is
609   begin
610      Null;
611   end Interrupt_Enable;
612
613   procedure Interrupt_Flash (
614      Level : in     RTEMS.ISR_Level
615   ) is
616   begin
617      Null;
618   end Interrupt_Flash;
619
620   function Interrupt_Is_In_Progress
621   return RTEMS.Boolean is
622   begin
623      return RTEMS.From_Ada_Boolean (Standard.True);
624   end Interrupt_Is_In_Progress;
625
626   --
627   -- Clock Manager
628   --
629 
630   procedure Clock_Get (
631      Option      : in     RTEMS.Clock_Get_Options;
632      Time_Buffer : in     RTEMS.Address;
633      Result      :    out RTEMS.Status_Codes
634   ) is
635      function Clock_Get_base (
636         Option      : RTEMS.Clock_Get_Options;
637         Time_Buffer : RTEMS.Address
638      )  return RTEMS.Status_Codes;
639      pragma Import (C, Clock_Get_base, "rtems_clock_get");
640   begin
641
642      Result := Clock_Get_base ( Option, Time_Buffer );
643
644   end Clock_Get;
645 
646   procedure Clock_Set (
647      Time_Buffer : in     RTEMS.Time_Of_Day;
648      Result      :    out RTEMS.Status_Codes
649   ) is
650      function Clock_Set_base (
651         Time_Buffer : RTEMS.Time_Of_Day
652      )  return RTEMS.Status_Codes;
653      pragma Import (C, Clock_Set_base, "rtems_clock_set");
654   begin
655 
656      Result := Clock_Set_base ( Time_Buffer );
657
658   end Clock_Set;
659 
660   procedure Clock_Tick (
661      Result :    out RTEMS.Status_Codes
662   ) is
663      function Clock_Tick_Base return RTEMS.Status_Codes;
664      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
665   begin
666
667      Result := Clock_Tick_Base;
668
669   end Clock_Tick;
670 
671   --
672   -- Extension Manager
673   --
674 
675   procedure Extension_Create (
676      Name   : in     RTEMS.Name;
677      Table  : in     RTEMS.Extensions_Table_Pointer;
678      ID     :    out RTEMS.ID;
679      Result :    out RTEMS.Status_Codes
680   ) is
681      function Extension_Create_Base (
682         Name   : RTEMS.Name;
683         Table  : RTEMS.Extensions_Table_Pointer;
684         ID     : access RTEMS.ID
685      )  return RTEMS.Status_Codes;
686      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
687      ID_Base : aliased RTEMS.ID := ID;
688   begin
689 
690      Result := Extension_Create_Base (
691         Name,
692         Table,
693         ID_Base'Unchecked_Access
694      );
695 
696      ID := ID_Base;
697
698   end Extension_Create;
699 
700   procedure Extension_Ident (
701      Name   : in     RTEMS.Name;
702      ID     :    out RTEMS.ID;
703      Result :    out RTEMS.Status_Codes
704   ) is
705      function Extension_Ident_Base (
706         Name   : RTEMS.Name;
707         ID     : access RTEMS.ID
708      )  return RTEMS.Status_Codes;
709      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
710      ID_Base : aliased RTEMS.ID := ID;
711   begin
712 
713      Result := Extension_Ident_Base (
714         Name,
715         ID_Base'Unchecked_Access
716      );
717 
718      ID := ID_Base;
719
720   end Extension_Ident;
721 
722   procedure Extension_Delete (
723      ID     : in     RTEMS.ID;
724      Result :    out RTEMS.Status_Codes
725   ) is
726      function Extension_Delete_Base (
727         ID : RTEMS.ID
728      )  return RTEMS.Status_Codes;
729      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
730   begin
731 
732      Result := Extension_Delete_Base ( ID );
733
734   end Extension_Delete;
735 
736   --
737   -- Timer Manager
738   --
739 
740   procedure Timer_Create (
741      Name   : in     RTEMS.Name;
742      ID     :    out RTEMS.ID;
743      Result :    out RTEMS.Status_Codes
744   ) is
745      function Timer_Create_Base (
746         Name   : RTEMS.Name;
747         ID     : access RTEMS.ID
748      )  return RTEMS.Status_Codes;
749      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
750      ID_Base : aliased RTEMS.ID := ID;
751   begin
752 
753      Result := Timer_Create_Base (
754         Name,
755         ID_Base'Unchecked_Access
756      );
757 
758      ID := ID_Base;
759
760   end Timer_Create;
761 
762   procedure Timer_Ident (
763      Name   : in     RTEMS.Name;
764      ID     :    out RTEMS.ID;
765      Result :    out RTEMS.Status_Codes
766   ) is
767      function Timer_Ident_Base (
768         Name   : RTEMS.Name;
769         ID     : access RTEMS.ID
770      )  return RTEMS.Status_Codes;
771      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
772      ID_Base : aliased RTEMS.ID := ID;
773   begin
774 
775      Result := Timer_Ident_Base (
776         Name,
777         ID_Base'Unchecked_Access
778      );
779 
780      ID := ID_Base;
781
782   end Timer_Ident;
783 
784   procedure Timer_Delete (
785      ID     : in     RTEMS.ID;
786      Result :    out RTEMS.Status_Codes
787   ) is
788      function Timer_Delete_Base (
789         ID : RTEMS.ID
790      )  return RTEMS.Status_Codes;
791      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
792   begin
793 
794      Result := Timer_Delete_Base ( ID );
795
796   end Timer_Delete;
797 
798   procedure Timer_Fire_After (
799      ID        : in     RTEMS.ID;
800      Ticks     : in     RTEMS.Interval;
801      Routine   : in     RTEMS.Timer_Service_Routine;
802      User_Data : in     RTEMS.Address;
803      Result    :    out RTEMS.Status_Codes
804   ) is
805      function Timer_Fire_After_Base (
806         ID        : RTEMS.ID;
807         Ticks     : RTEMS.Interval;
808         Routine   : RTEMS.Timer_Service_Routine;
809         User_Data : RTEMS.Address
810      )  return RTEMS.Status_Codes;
811      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
812   begin
813 
814      Result := Timer_Fire_After_Base (
815                   ID,
816                   Ticks,
817                   Routine,
818                   User_Data
819                );
820
821   end Timer_Fire_After;
822 
823   procedure Timer_Fire_When (
824      ID        : in     RTEMS.ID;
825      Wall_Time : in     RTEMS.Time_Of_Day;
826      Routine   : in     RTEMS.Timer_Service_Routine;
827      User_Data : in     RTEMS.Address;
828      Result    :    out RTEMS.Status_Codes
829   ) is
830      function Timer_Fire_When (
831         ID        : RTEMS.ID;
832         Wall_Time : in     RTEMS.Time_Of_Day;
833         Routine   : RTEMS.Timer_Service_Routine;
834         User_Data : RTEMS.Address
835      )  return RTEMS.Status_Codes;
836      pragma Import (C, Timer_Fire_When, "rtems_timer_fire_when");
837   begin
838 
839      Result := Timer_Fire_When (
840                   ID,
841                   Wall_Time,
842                   Routine,
843                   User_Data
844                );
845
846   end Timer_Fire_When;
847 
848   procedure Timer_Reset (
849      ID     : in     RTEMS.ID;
850      Result :    out RTEMS.Status_Codes
851   ) is
852      function Timer_Reset_Base (
853         ID : RTEMS.ID
854      )  return RTEMS.Status_Codes;
855      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
856   begin
857 
858      Result := Timer_Reset_Base ( ID );
859
860   end Timer_Reset;
861 
862   procedure Timer_Cancel (
863      ID     : in     RTEMS.ID;
864      Result :    out RTEMS.Status_Codes
865   ) is
866      function Timer_Cancel_Base (
867         ID : RTEMS.ID
868      )  return RTEMS.Status_Codes;
869      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
870   begin
871 
872      Result := Timer_Cancel_Base ( ID );
873
874   end Timer_Cancel;
875 
876   --
877   -- Semaphore Manager
878   --
879 
880   procedure Semaphore_Create (
881      Name             : in     RTEMS.Name;
882      Count            : in     RTEMS.Unsigned32;
883      Attribute_Set    : in     RTEMS.Attribute;
884      Priority_Ceiling : in     RTEMS.Task_Priority;
885      ID               :    out RTEMS.ID;
886      Result           :    out RTEMS.Status_Codes
887   ) is
888      function Semaphore_Create_Base (
889         Name             : RTEMS.Name;
890         Count            : RTEMS.Unsigned32;
891         Attribute_Set    : RTEMS.Attribute;
892         Priority_Ceiling : RTEMS.Task_Priority;
893         ID               : access RTEMS.ID
894      )  return RTEMS.Status_Codes;
895      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
896      ID_Base : aliased RTEMS.ID := ID;
897   begin
898 
899      Result := Semaphore_Create_Base (
900         Name,
901         Count,
902         Attribute_Set,
903         Priority_Ceiling,
904         ID_Base'Unchecked_Access
905      );
906 
907      ID := ID_Base;
908
909   end Semaphore_Create;
910 
911   procedure Semaphore_Delete (
912      ID     : in     RTEMS.ID;
913      Result :    out RTEMS.Status_Codes
914   ) is
915      function Semaphore_Delete_Base (
916         ID : RTEMS.ID
917      )  return RTEMS.Status_Codes;
918      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
919   begin
920 
921      Result := Semaphore_Delete_Base ( ID );
922
923   end Semaphore_Delete;
924 
925   procedure Semaphore_Ident (
926      Name   : in     RTEMS.Name;
927      Node   : in     RTEMS.Unsigned32;
928      ID     :    out RTEMS.ID;
929      Result :    out RTEMS.Status_Codes
930   ) is
931      function Semaphore_Ident_Base (
932         Name : RTEMS.Name;
933         Node : RTEMS.Unsigned32;
934         ID   : access RTEMS.ID
935      )  return RTEMS.Status_Codes;
936      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
937      ID_Base : aliased RTEMS.ID := ID;
938   begin
939 
940      Result := Semaphore_Ident_Base (
941         Name,
942         Node,
943         ID_Base'Unchecked_Access
944      );
945 
946      ID := ID_Base;
947
948   end Semaphore_Ident;
949 
950   procedure Semaphore_Obtain (
951      ID         : in     RTEMS.ID;
952      Option_Set : in     RTEMS.Option;
953      Timeout    : in     RTEMS.Interval;
954      Result     :    out RTEMS.Status_Codes
955   ) is
956      function Semaphore_Obtain_Base (
957         ID         : RTEMS.ID;
958         Option_Set : RTEMS.Option;
959         Timeout    : RTEMS.Interval
960      )  return RTEMS.Status_Codes;
961      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
962   begin
963 
964      Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout );
965
966   end Semaphore_Obtain;
967 
968   procedure Semaphore_Release (
969      ID     : in     RTEMS.ID;
970      Result :    out RTEMS.Status_Codes
971   ) is
972      function Semaphore_Release_Base (
973         ID : RTEMS.ID
974      )  return RTEMS.Status_Codes;
975      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
976   begin
977 
978      Result := Semaphore_Release_Base ( ID );
979
980   end Semaphore_Release;
981 
982   --
983   -- Message Queue Manager
984   --
985 
986   procedure Message_Queue_Create (
987      Name             : in     RTEMS.Name;
988      Count            : in     RTEMS.Unsigned32;
989      Max_Message_Size : in     RTEMS.Unsigned32;
990      Attribute_Set    : in     RTEMS.Attribute;
991      ID               :    out RTEMS.ID;
992      Result           :    out RTEMS.Status_Codes
993   ) is
994      --  XXX broken
995      function Message_Queue_Create_Base (
996         Name             : RTEMS.Name;
997         Count            : RTEMS.Unsigned32;
998         Max_Message_Size : RTEMS.Unsigned32;
999         Attribute_Set    : RTEMS.Attribute;
1000         ID               : access RTEMS.ID
1001      )  return RTEMS.Status_Codes;
1002      pragma Import (C,
1003        Message_Queue_Create_Base, "rtems_message_queue_create");
1004      ID_Base : aliased RTEMS.ID := ID;
1005   begin
1006 
1007      Result := Message_Queue_Create_Base (
1008         Name,
1009         Count,
1010         Max_Message_Size,
1011         Attribute_Set,
1012         ID_Base'Unchecked_Access
1013      );
1014 
1015      ID := ID_Base;
1016
1017   end Message_Queue_Create;
1018 
1019   procedure Message_Queue_Ident (
1020      Name   : in     RTEMS.Name;
1021      Node   : in     RTEMS.Unsigned32;
1022      ID     :    out RTEMS.ID;
1023      Result :    out RTEMS.Status_Codes
1024   ) is
1025      function Message_Queue_Ident_Base (
1026         Name : RTEMS.Name;
1027         Node : RTEMS.Unsigned32;
1028         ID   : access RTEMS.ID
1029      )  return RTEMS.Status_Codes;
1030      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
1031      ID_Base : aliased RTEMS.ID := ID;
1032   begin
1033 
1034      Result := Message_Queue_Ident_Base (
1035         Name,
1036         Node,
1037         ID_Base'Unchecked_Access
1038      );
1039 
1040      ID := ID_Base;
1041
1042   end Message_Queue_Ident;
1043 
1044   procedure Message_Queue_Delete (
1045      ID     : in     RTEMS.ID;
1046      Result :    out RTEMS.Status_Codes
1047   ) is
1048      function Message_Queue_Delete_Base (
1049         ID : RTEMS.ID
1050      )  return RTEMS.Status_Codes;
1051      pragma Import (C, Message_Queue_Delete_Base,
1052         "rtems_message_queue_delete");
1053   begin
1054 
1055      Result := Message_Queue_Delete_Base ( ID );
1056
1057   end Message_Queue_Delete;
1058 
1059   procedure Message_Queue_Send (
1060      ID     : in     RTEMS.ID;
1061      Buffer : in     RTEMS.Address;
1062      Size   : in     RTEMS.Unsigned32;
1063      Result :    out RTEMS.Status_Codes
1064   ) is
1065      function Message_Queue_Send_Base (
1066         ID     : RTEMS.ID;
1067         Buffer : RTEMS.Address;
1068         Size   : RTEMS.Unsigned32
1069      )  return RTEMS.Status_Codes;
1070      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
1071   begin
1072 
1073      Result := Message_Queue_Send_Base ( ID, Buffer, Size );
1074
1075   end Message_Queue_Send;
1076 
1077   procedure Message_Queue_Urgent (
1078      ID     : in     RTEMS.ID;
1079      Buffer : in     RTEMS.Address;
1080      Size   : in     RTEMS.Unsigned32;
1081      Result :    out RTEMS.Status_Codes
1082   ) is
1083      function Message_Queue_Urgent_Base (
1084         ID     : RTEMS.ID;
1085         Buffer : RTEMS.Address;
1086         Size   : RTEMS.Unsigned32
1087      )  return RTEMS.Status_Codes;
1088      pragma Import (C, Message_Queue_Urgent_Base,
1089         "rtems_message_queue_urgent");
1090   begin
1091 
1092      Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
1093
1094   end Message_Queue_Urgent;
1095 
1096   procedure Message_Queue_Broadcast (
1097      ID     : in     RTEMS.ID;
1098      Buffer : in     RTEMS.Address;
1099      Size   : in     RTEMS.Unsigned32;
1100      Count  :    out RTEMS.Unsigned32;
1101      Result :    out RTEMS.Status_Codes
1102   ) is
1103      function Message_Queue_Broadcast_Base (
1104         ID     : RTEMS.ID;
1105         Buffer : RTEMS.Address;
1106         Size   : RTEMS.Unsigned32;
1107         Count  : access RTEMS.Unsigned32
1108      )  return RTEMS.Status_Codes;
1109      pragma Import (C, Message_Queue_Broadcast_Base,
1110         "rtems_message_queue_broadcast");
1111      Count_Base : aliased RTEMS.Unsigned32 := Count;
1112   begin
1113 
1114      Result := Message_Queue_Broadcast_Base (
1115                   ID,
1116                   Buffer,
1117                   Size,
1118                   Count_Base'Unchecked_Access
1119                );
1120 
1121      Count := Count_Base;
1122
1123   end Message_Queue_Broadcast;
1124 
1125   procedure Message_Queue_Receive (
1126      ID         : in     RTEMS.ID;
1127      Buffer     : in     RTEMS.Address;
1128      Option_Set : in     RTEMS.Option;
1129      Timeout    : in     RTEMS.Interval;
1130      Size       :    out RTEMS.Unsigned32;
1131      Result     :    out RTEMS.Status_Codes
1132   ) is
1133      function Message_Queue_Receive_Base (
1134         ID         : RTEMS.ID;
1135         Buffer     : RTEMS.Address;
1136         Size       : access RTEMS.Unsigned32;
1137         Option_Set : RTEMS.Option;
1138         Timeout    : RTEMS.Interval
1139      )  return RTEMS.Status_Codes;
1140      pragma Import (C, Message_Queue_Receive_Base,
1141         "rtems_message_queue_receive");
1142      Size_Base : aliased RTEMS.Unsigned32;
1143   begin
1144 
1145      Result := Message_Queue_Receive_Base (
1146                   ID,
1147                   Buffer,
1148                   Size_Base'Unchecked_Access,
1149                   Option_Set,
1150                   Timeout
1151                 );
1152
1153      Size := Size_Base;
1154
1155   end Message_Queue_Receive;
1156 
1157   procedure Message_Queue_Flush (
1158      ID     : in     RTEMS.ID;
1159      Count  :    out RTEMS.Unsigned32;
1160      Result :    out RTEMS.Status_Codes
1161   ) is
1162      function Message_Queue_Flush_Base (
1163         ID    : RTEMS.ID;
1164         Count : access RTEMS.Unsigned32
1165      )  return RTEMS.Status_Codes;
1166      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1167      COUNT_Base : aliased RTEMS.Unsigned32 := Count;
1168   begin
1169 
1170      Result := Message_Queue_Flush_Base (
1171                   ID,
1172                   COUNT_Base'Unchecked_Access
1173                );
1174 
1175      Count := COUNT_Base;
1176
1177   end Message_Queue_Flush;
1178 
1179
1180   --
1181   -- Event Manager
1182   --
1183
1184   procedure Event_Send (
1185      ID       : in     RTEMS.ID;
1186      Event_In : in     RTEMS.Event_Set;
1187      Result   :    out RTEMS.Status_Codes
1188   ) is
1189      function Event_Send_Base (
1190         ID       : RTEMS.ID;
1191         Event_In : RTEMS.Event_Set
1192      )  return RTEMS.Status_Codes;
1193      pragma Import (C, Event_Send_Base, "rtems_event_send");
1194   begin
1195
1196      Result := Event_Send_Base (
1197                   ID,
1198                   Event_In
1199                );
1200
1201   end Event_Send;
1202
1203   procedure Event_Receive (
1204      Event_In   : in     RTEMS.Event_Set;
1205      Option_Set : in     RTEMS.Option;
1206      Ticks      : in     RTEMS.Interval;
1207      Event_Out  :    out RTEMS.Event_Set;
1208      Result     :    out RTEMS.Status_Codes
1209   ) is
1210      function Event_Receive_Base (
1211         Event_In   : RTEMS.Event_Set;
1212         Option_Set : RTEMS.Option;
1213         Ticks      : RTEMS.Interval;
1214         Event_Out  : access RTEMS.Event_Set
1215      )  return RTEMS.Status_Codes;
1216      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1217      Event_Out_Base : aliased RTEMS.Event_Set; -- := Event_Out;
1218   begin
1219
1220      Result := Event_Receive_Base (
1221                   Event_In,
1222                   Option_Set,
1223                   Ticks,
1224                   Event_Out_Base'Access
1225                );
1226
1227      Event_Out := Event_Out_Base;
1228
1229   end Event_Receive;
1230
1231   --
1232   -- Signal Manager
1233   --
1234 
1235   procedure Signal_Catch (
1236      ASR_Handler : in     RTEMS.ASR_Handler;
1237      Mode_Set    : in     RTEMS.Mode;
1238      Result      :    out RTEMS.Status_Codes
1239   ) is
1240      function Signal_Catch_Base (
1241         ASR_Handler : RTEMS.ASR_Handler;
1242         Mode_Set    : RTEMS.Mode
1243      )  return RTEMS.Status_Codes;
1244      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1245   begin
1246
1247      Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
1248
1249   end Signal_Catch;
1250 
1251   procedure Signal_Send (
1252      ID         : in     RTEMS.ID;
1253      Signal_Set : in     RTEMS.Signal_Set;
1254      Result     :    out RTEMS.Status_Codes
1255   ) is
1256      function Signal_Send_Base (
1257         ID         : RTEMS.ID;
1258         Signal_Set : RTEMS.Signal_Set
1259      )  return RTEMS.Status_Codes;
1260      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1261   begin
1262 
1263      Result := Signal_Send_Base ( ID, Signal_Set );
1264
1265   end Signal_Send;
1266 
1267 
1268   --
1269   -- Partition Manager
1270   --
1271 
1272   procedure Partition_Create (
1273      Name             : in     RTEMS.Name;
1274      Starting_Address : in     RTEMS.Address;
1275      Length           : in     RTEMS.Unsigned32;
1276      Buffer_Size      : in     RTEMS.Unsigned32;
1277      Attribute_Set    : in     RTEMS.Attribute;
1278      ID               :    out RTEMS.ID;
1279      Result           :    out RTEMS.Status_Codes
1280   ) is
1281      function Partition_Create_Base (
1282         Name             : RTEMS.Name;
1283         Starting_Address : RTEMS.Address;
1284         Length           : RTEMS.Unsigned32;
1285         Buffer_Size      : RTEMS.Unsigned32;
1286         Attribute_Set    : RTEMS.Attribute;
1287         ID               : access RTEMS.Event_Set
1288      )  return RTEMS.Status_Codes;
1289      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1290      ID_Base : aliased RTEMS.ID := ID;
1291   begin
1292 
1293      Result := Partition_Create_Base (
1294         Name,
1295         Starting_Address,
1296         Length,
1297         Buffer_Size,
1298         Attribute_Set,
1299         ID_Base'Unchecked_Access
1300      );
1301 
1302      ID := ID_Base;
1303 
1304   end Partition_Create;
1305 
1306   procedure Partition_Ident (
1307      Name   : in     RTEMS.Name;
1308      Node   : in     RTEMS.Unsigned32;
1309      ID     :    out RTEMS.ID;
1310      Result :    out RTEMS.Status_Codes
1311   ) is
1312      function Partition_Ident_Base (
1313         Name : RTEMS.Name;
1314         Node : RTEMS.Unsigned32;
1315         ID   : access RTEMS.Event_Set
1316      )  return RTEMS.Status_Codes;
1317      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1318      ID_Base : aliased RTEMS.ID := ID;
1319   begin
1320 
1321      Result := Partition_Ident_Base (
1322         Name,
1323         Node,
1324         ID_Base'Unchecked_Access
1325      );
1326 
1327      ID := ID_Base;
1328
1329   end Partition_Ident;
1330 
1331   procedure Partition_Delete (
1332      ID     : in     RTEMS.ID;
1333      Result :    out RTEMS.Status_Codes
1334   ) is
1335      function Partition_Delete_Base (
1336         ID : RTEMS.ID
1337      )  return RTEMS.Status_Codes;
1338      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1339   begin
1340 
1341      Result := Partition_Delete_Base ( ID );
1342
1343   end Partition_Delete;
1344 
1345   procedure Partition_Get_Buffer (
1346      ID     : in     RTEMS.ID;
1347      Buffer :    out RTEMS.Address;
1348      Result :    out RTEMS.Status_Codes
1349   ) is
1350      function Partition_Get_Buffer_Base (
1351         ID     : RTEMS.ID;
1352         Buffer : access RTEMS.Address
1353      )  return RTEMS.Status_Codes;
1354      pragma Import (C, Partition_Get_Buffer_Base,
1355         "rtems_partition_get_buffer");
1356      Buffer_Base : aliased RTEMS.Address := Buffer;
1357   begin
1358 
1359      Result := Partition_Get_Buffer_Base (
1360         ID,
1361         Buffer_Base'Unchecked_Access
1362      );
1363 
1364      Buffer := Buffer_Base;
1365
1366   end Partition_Get_Buffer;
1367 
1368   procedure Partition_Return_Buffer (
1369      ID     : in     RTEMS.ID;
1370      Buffer : in     RTEMS.Address;
1371      Result :    out RTEMS.Status_Codes
1372   ) is
1373      function Partition_Return_Buffer_Base (
1374         ID     : RTEMS.Name;
1375         Buffer : RTEMS.Address
1376      )  return RTEMS.Status_Codes;
1377      pragma Import (C, Partition_Return_Buffer_Base,
1378         "rtems_partition_return_buffer");
1379   begin
1380 
1381      Result := Partition_Return_Buffer_Base ( ID, Buffer );
1382
1383   end Partition_Return_Buffer;
1384
1385   --
1386   -- Region Manager
1387   --
1388 
1389   procedure Region_Create (
1390      Name             : in     RTEMS.Name;
1391      Starting_Address : in     RTEMS.Address;
1392      Length           : in     RTEMS.Unsigned32;
1393      Page_Size        : in     RTEMS.Unsigned32;
1394      Attribute_Set    : in     RTEMS.Attribute;
1395      ID               :    out RTEMS.ID;
1396      Result           :    out RTEMS.Status_Codes
1397   ) is
1398      function Region_Create_Base (
1399         Name             : RTEMS.Name;
1400         Starting_Address : RTEMS.Address;
1401         Length           : RTEMS.Unsigned32;
1402         Page_Size        : RTEMS.Unsigned32;
1403         Attribute_Set    : RTEMS.Attribute;
1404         ID               : access RTEMS.ID
1405      )  return RTEMS.Status_Codes;
1406      pragma Import (C, Region_Create_Base, "rtems_region_create");
1407      ID_Base : aliased RTEMS.ID := ID;
1408 
1409   begin
1410 
1411      Result := Region_Create_Base (
1412                        Name,
1413                        Starting_Address,
1414                        Length,
1415                        Page_Size,
1416                        Attribute_Set,
1417                        ID_Base'Unchecked_Access
1418                     );
1419 
1420      ID := ID_Base;
1421
1422   end Region_Create;
1423 
1424   procedure Region_Ident (
1425      Name   : in     RTEMS.Name;
1426      ID     :    out RTEMS.ID;
1427      Result :    out RTEMS.Status_Codes
1428   ) is
1429      function Region_Ident_Base (
1430         Name   : RTEMS.Name;
1431         ID     : access RTEMS.ID
1432      )  return RTEMS.Status_Codes;
1433      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1434      ID_Base : aliased RTEMS.ID := ID;
1435   begin
1436 
1437      Result := Region_Ident_Base (
1438         Name,
1439         ID_Base'Unchecked_Access
1440      );
1441 
1442      ID := ID_Base;
1443
1444   end Region_Ident;
1445 
1446   procedure Region_Delete (
1447      ID     : in     RTEMS.ID;
1448      Result :    out RTEMS.Status_Codes
1449   ) is
1450      function Region_Delete_Base (
1451         ID : RTEMS.ID
1452      )  return RTEMS.Status_Codes;
1453      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1454   begin
1455 
1456      Result := Region_Delete_Base ( ID );
1457
1458   end Region_Delete;
1459 
1460   procedure Region_Extend (
1461      ID               : in     RTEMS.ID;
1462      Starting_Address : in     RTEMS.Address;
1463      Length           : in     RTEMS.Unsigned32;
1464      Result           :    out RTEMS.Status_Codes
1465   ) is
1466      function Region_Extend_Base (
1467         ID               : RTEMS.ID;
1468         Starting_Address : RTEMS.Address;
1469         Length           : RTEMS.Unsigned32
1470      )  return RTEMS.Status_Codes;
1471      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1472   begin
1473 
1474      Result := Region_Extend_Base ( ID, Starting_Address, Length );
1475
1476   end Region_Extend;
1477 
1478   procedure Region_Get_Segment (
1479      ID         : in     RTEMS.ID;
1480      Size       : in     RTEMS.Unsigned32;
1481      Option_Set : in     RTEMS.Option;
1482      Timeout    : in     RTEMS.Interval;
1483      Segment    :    out RTEMS.Address;
1484      Result     :    out RTEMS.Status_Codes
1485   ) is
1486      function Region_Get_Segment_Base (
1487         ID         : RTEMS.ID;
1488         Size       : RTEMS.Unsigned32;
1489         Option_Set : RTEMS.Option;
1490         Timeout    : RTEMS.Interval;
1491         Segment    : access RTEMS.Address
1492      )  return RTEMS.Status_Codes;
1493      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1494      Segment_Base : aliased RTEMS.Address := Segment;
1495   begin
1496 
1497      Result := Region_Get_Segment_Base (
1498         ID,
1499         Size,
1500         Option_Set,
1501         Timeout,
1502         Segment_Base'Unchecked_Access
1503      );
1504 
1505      Segment := SEGMENT_Base;
1506
1507   end Region_Get_Segment;
1508 
1509   procedure Region_Get_Segment_Size (
1510      ID      : in     RTEMS.ID;
1511      Segment : in     RTEMS.Address;
1512      Size    :    out RTEMS.Unsigned32;
1513      Result  :    out RTEMS.Status_Codes
1514   ) is
1515      function Region_Get_Segment_Size_Base (
1516         ID      : RTEMS.ID;
1517         Segment : RTEMS.Address;
1518         Size    : access RTEMS.Unsigned32
1519      )  return RTEMS.Status_Codes;
1520      pragma Import (C, Region_Get_Segment_Size_Base,
1521         "rtems_region_get_segment_size");
1522      Size_Base : aliased RTEMS.Unsigned32 := Size;
1523   begin
1524 
1525      Result := Region_Get_Segment_Size_Base (
1526         ID,
1527         Segment,
1528         Size_Base'Unchecked_Access
1529      );
1530 
1531      Size := SIZE_Base;
1532
1533   end Region_Get_Segment_Size;
1534 
1535   procedure Region_Return_Segment (
1536      ID      : in     RTEMS.ID;
1537      Segment : in     RTEMS.Address;
1538      Result  :    out RTEMS.Status_Codes
1539   ) is
1540      function Region_Return_Segment_Base (
1541         ID      : RTEMS.ID;
1542         Segment : RTEMS.Address
1543      )  return RTEMS.Status_Codes;
1544      pragma Import (C, Region_Return_Segment_Base,
1545         "rtems_region_return_segment");
1546   begin
1547 
1548      Result := Region_Return_Segment_Base ( ID, Segment );
1549
1550   end Region_Return_Segment;
1551 
1552
1553   --
1554   -- Dual Ported Memory Manager
1555   --
1556 
1557   procedure Port_Create (
1558      Name           : in     RTEMS.Name;
1559      Internal_Start : in     RTEMS.Address;
1560      External_Start : in     RTEMS.Address;
1561      Length         : in     RTEMS.Unsigned32;
1562      ID             :    out RTEMS.ID;
1563      Result         :    out RTEMS.Status_Codes
1564   ) is
1565      function Port_Create_Base (
1566         Name           : RTEMS.Name;
1567         Internal_Start : RTEMS.Address;
1568         External_Start : RTEMS.Address;
1569         Length         : RTEMS.Unsigned32;
1570         ID             : access RTEMS.ID
1571      )  return RTEMS.Status_Codes;
1572      pragma Import (C, Port_Create_Base, "rtems_port_create");
1573      ID_Base : aliased RTEMS.ID := ID;
1574 
1575   begin
1576 
1577      Result := Port_Create_Base (
1578                   Name,
1579                   Internal_Start,
1580                   External_Start,
1581                   Length,
1582                   ID_Base'Unchecked_Access
1583                );
1584 
1585      ID := ID_Base;
1586
1587   end Port_Create;
1588 
1589   procedure Port_Ident (
1590      Name   : in     RTEMS.Name;
1591      ID     :    out RTEMS.ID;
1592      Result :    out RTEMS.Status_Codes
1593   ) is
1594      function Port_Ident_Base (
1595         Name : RTEMS.Name;
1596         ID   : access RTEMS.ID
1597      )  return RTEMS.Status_Codes;
1598      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1599      ID_Base : aliased RTEMS.ID := ID;
1600   begin
1601 
1602      Result := Port_Ident_Base (
1603         Name,
1604         ID_Base'Unchecked_Access
1605      );
1606 
1607      ID := ID_Base;
1608
1609   end Port_Ident;
1610 
1611   procedure Port_Delete (
1612      ID     : in     RTEMS.ID;
1613      Result :    out RTEMS.Status_Codes
1614   ) is
1615      function Port_Delete_Base (
1616         ID : RTEMS.ID
1617      )  return RTEMS.Status_Codes;
1618      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1619   begin
1620 
1621      Result := Port_Delete_Base ( ID );
1622
1623   end Port_Delete;
1624 
1625   procedure Port_External_To_Internal (
1626      ID       : in     RTEMS.ID;
1627      External : in     RTEMS.Address;
1628      Internal :    out RTEMS.Address;
1629      Result   :    out RTEMS.Status_Codes
1630   ) is
1631      function Port_External_To_Internal_Base (
1632         ID       : RTEMS.ID;
1633         External : RTEMS.Address;
1634         Internal : access RTEMS.Address
1635      )  return RTEMS.Status_Codes;
1636      pragma Import (C, Port_External_To_Internal_Base,
1637         "rtems_port_external_to_internal");
1638      Internal_Base : aliased RTEMS.Address := Internal;
1639   begin
1640 
1641      Result := Port_External_To_Internal_Base (
1642         ID,
1643         External,
1644         Internal_Base'Unchecked_Access
1645      );
1646 
1647      Internal := INTERNAL_Base;
1648
1649   end Port_External_To_Internal;
1650 
1651   procedure Port_Internal_To_External (
1652      ID       : in     RTEMS.ID;
1653      Internal : in     RTEMS.Address;
1654      External :    out RTEMS.Address;
1655      Result   :    out RTEMS.Status_Codes
1656   ) is
1657      function Port_Internal_To_External_Base (
1658         ID       : RTEMS.ID;
1659         Internal : RTEMS.Address;
1660         External : access RTEMS.Address
1661      )  return RTEMS.Status_Codes;
1662      pragma Import (C, Port_Internal_To_External_Base,
1663         "rtems_port_internal_to_external");
1664      External_Base : aliased RTEMS.Address := External;
1665   begin
1666 
1667      Result := Port_Internal_To_External_Base (
1668         ID,
1669         Internal,
1670         External_Base'Unchecked_Access
1671      );
1672 
1673      External := EXTERNAL_Base;
1674
1675   end Port_Internal_To_External;
1676 
1677   --
1678   -- Input/Output Manager
1679   --
1680 
1681   procedure IO_Initialize (
1682      Major        : in     RTEMS.Device_Major_Number;
1683      Minor        : in     RTEMS.Device_Minor_Number;
1684      Argument     : in     RTEMS.Address;
1685      Return_Value :    out RTEMS.Unsigned32;
1686      Result       :    out RTEMS.Status_Codes
1687   ) is
1688      function IO_Initialize_Base (
1689         Major        : RTEMS.Device_Major_Number;
1690         Minor        : RTEMS.Device_Minor_Number;
1691         Argument     : RTEMS.Address;
1692         Return_Value : access RTEMS.Unsigned32
1693      )  return RTEMS.Status_Codes;
1694      pragma Import (C, IO_Initialize_Base, "rtems_io_initialize");
1695      Return_Value_Base : aliased RTEMS.Unsigned32 := Return_Value;
1696   begin
1697 
1698      Result := IO_Initialize_Base (
1699         Major,
1700         Minor,
1701         Argument,
1702         Return_Value_Base'Unchecked_Access
1703      );
1704 
1705      Return_Value := Return_Value_Base;
1706
1707   end IO_Initialize;
1708 
1709   procedure IO_Register_Name (
1710      Name   : in     String;
1711      Major  : in     RTEMS.Device_Major_Number;
1712      Minor  : in     RTEMS.Device_Minor_Number;
1713      Result :    out RTEMS.Status_Codes
1714   ) is
1715      function IO_Register_Name_Base (
1716         Name   : Interfaces.C.Char_Array;
1717         Major  : RTEMS.Device_Major_Number;
1718         Minor  : RTEMS.Device_Minor_Number
1719      )  return RTEMS.Status_Codes;
1720      pragma Import (C, IO_Register_Name_Base, "rtems_io_register_name");
1721   begin
1722
1723      Result := IO_Register_Name_Base (
1724         Interfaces.C.To_C (Name),
1725         Major,
1726         Minor
1727      );
1728
1729   end IO_Register_Name;
1730
1731   procedure IO_Lookup_Name (
1732      Name         : in     String;
1733      Device_Info  :    out RTEMS.Driver_Name_t;
1734      Result       :    out RTEMS.Status_Codes
1735   ) is
1736      function IO_Lookup_Name_Base (
1737         Name        : Interfaces.C.Char_Array;
1738         Device_Info : access RTEMS.Driver_Name_t
1739      )  return RTEMS.Status_Codes;
1740      pragma Import (C, IO_Lookup_Name_Base, "rtems_io_lookup_name");
1741
1742      Device_Info_Base : aliased RTEMS.Driver_Name_t;
1743   begin
1744
1745      Result := IO_Lookup_Name_Base (
1746         Interfaces.C.To_C (Name),
1747         Device_Info_Base'Unchecked_Access
1748      );
1749
1750      Device_Info := Device_Info_Base;
1751
1752   end IO_Lookup_Name;
1753
1754   procedure IO_Open (
1755      Major        : in     RTEMS.Device_Major_Number;
1756      Minor        : in     RTEMS.Device_Minor_Number;
1757      Argument     : in     RTEMS.Address;
1758      Result       :    out RTEMS.Status_Codes
1759   ) is
1760      function IO_Open_Base (
1761         Major        : RTEMS.Device_Major_Number;
1762         Minor        : RTEMS.Device_Minor_Number;
1763         Argument     : RTEMS.Address
1764      )  return RTEMS.Status_Codes;
1765      pragma Import (C, IO_Open_Base, "rtems_io_open");
1766   begin
1767 
1768      Result := IO_Open_Base (Major, Minor, Argument);
1769 
1770   end IO_Open;
1771 
1772   procedure IO_Close (
1773      Major        : in     RTEMS.Device_Major_Number;
1774      Minor        : in     RTEMS.Device_Minor_Number;
1775      Argument     : in     RTEMS.Address;
1776      Result       :    out RTEMS.Status_Codes
1777   ) is
1778      function IO_Close_Base (
1779         Major        : RTEMS.Device_Major_Number;
1780         Minor        : RTEMS.Device_Minor_Number;
1781         Argument     : RTEMS.Address
1782      )  return RTEMS.Status_Codes;
1783      pragma Import (C, IO_Close_Base, "rtems_io_close");
1784   begin
1785 
1786      Result := IO_Close_Base (Major, Minor, Argument);
1787 
1788   end IO_Close;
1789 
1790   procedure IO_Read (
1791      Major        : in     RTEMS.Device_Major_Number;
1792      Minor        : in     RTEMS.Device_Minor_Number;
1793      Argument     : in     RTEMS.Address;
1794      Result       :    out RTEMS.Status_Codes
1795   ) is
1796      function IO_Read_Base (
1797         Major        : RTEMS.Device_Major_Number;
1798         Minor        : RTEMS.Device_Minor_Number;
1799         Argument     : RTEMS.Address
1800      )  return RTEMS.Status_Codes;
1801      pragma Import (C, IO_Read_Base, "rtems_io_read");
1802   begin
1803 
1804      Result := IO_Read_Base (Major, Minor, Argument);
1805 
1806   end IO_Read;
1807 
1808   procedure IO_Write (
1809      Major        : in     RTEMS.Device_Major_Number;
1810      Minor        : in     RTEMS.Device_Minor_Number;
1811      Argument     : in     RTEMS.Address;
1812      Result       :    out RTEMS.Status_Codes
1813   ) is
1814      function IO_Write_Base (
1815         Major        : RTEMS.Device_Major_Number;
1816         Minor        : RTEMS.Device_Minor_Number;
1817         Argument     : RTEMS.Address
1818      )  return RTEMS.Status_Codes;
1819      pragma Import (C, IO_Write_Base, "rtems_io_write");
1820   begin
1821 
1822      Result := IO_Write_Base (Major, Minor, Argument);
1823 
1824   end IO_Write;
1825 
1826   procedure IO_Control (
1827      Major        : in     RTEMS.Device_Major_Number;
1828      Minor        : in     RTEMS.Device_Minor_Number;
1829      Argument     : in     RTEMS.Address;
1830      Result       :    out RTEMS.Status_Codes
1831   ) is
1832      function IO_Control_Base (
1833         Major        : RTEMS.Device_Major_Number;
1834         Minor        : RTEMS.Device_Minor_Number;
1835         Argument     : RTEMS.Address
1836      )  return RTEMS.Status_Codes;
1837      pragma Import (C, IO_Control_Base, "rtems_io_control");
1838   begin
1839 
1840      Result := IO_Control_Base (Major, Minor, Argument);
1841 
1842   end IO_Control;
1843 
1844 
1845   --
1846   -- Fatal Error Manager
1847   --
1848 
1849   procedure Fatal_Error_Occurred (
1850      The_Error : in     RTEMS.Unsigned32
1851   ) is
1852      procedure Fatal_Error_Occurred_base (
1853         The_Error : RTEMS.Unsigned32
1854      );
1855   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1856   begin
1857 
1858      Fatal_Error_Occurred_Base ( The_Error );
1859
1860   end Fatal_Error_Occurred;
1861   --
1862   -- Rate Monotonic Manager
1863   --
1864 
1865   procedure Rate_Monotonic_Create (
1866      Name   : in     RTEMS.Name;
1867      ID     :    out RTEMS.ID;
1868      Result :    out RTEMS.Status_Codes
1869   ) is
1870      function Rate_Monotonic_Create_base (
1871         Name   : RTEMS.Name;
1872         ID     : access RTEMS.ID
1873      )  return RTEMS.Status_Codes;
1874      pragma Import (C, Rate_Monotonic_Create_base, "rtems_rate_monotonic_create");
1875      ID_Base : aliased RTEMS.ID := ID;
1876   begin
1877 
1878      Result := Rate_Monotonic_Create_base (
1879         Name,
1880         ID_Base'Unchecked_Access
1881      );
1882 
1883      ID := ID_Base;
1884
1885   end Rate_Monotonic_Create;
1886 
1887   procedure Rate_Monotonic_Ident (
1888      Name   : in     RTEMS.Name;
1889      ID     :    out RTEMS.ID;
1890      Result :    out RTEMS.Status_Codes
1891   ) is
1892      function Rate_Monotonic_Ident_Base (
1893         Name   : RTEMS.Name;
1894         ID     : access RTEMS.ID
1895      )  return RTEMS.Status_Codes;
1896      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1897      ID_Base : aliased RTEMS.ID := ID;
1898   begin
1899 
1900      Result := Rate_Monotonic_Ident_Base (
1901         Name,
1902         ID_Base'Unchecked_Access
1903      );
1904 
1905      ID := ID_Base;
1906
1907   end Rate_Monotonic_Ident;
1908 
1909   procedure Rate_Monotonic_Delete (
1910      ID     : in     RTEMS.ID;
1911      Result :    out RTEMS.Status_Codes
1912   ) is
1913      function Rate_Monotonic_Delete_Base (
1914         ID : RTEMS.ID
1915      )  return RTEMS.Status_Codes;
1916      pragma Import (C, Rate_Monotonic_Delete_Base,
1917         "rtems_rate_monotonic_delete");
1918   begin
1919 
1920      Result := Rate_Monotonic_Delete_base ( ID );
1921
1922   end Rate_Monotonic_Delete;
1923 
1924   procedure Rate_Monotonic_Cancel (
1925      ID     : in     RTEMS.ID;
1926      Result :    out RTEMS.Status_Codes
1927   ) is
1928      function Rate_Monotonic_Cancel_Base (
1929         ID : RTEMS.ID
1930      )  return RTEMS.Status_Codes;
1931      pragma Import (C, Rate_Monotonic_Cancel_Base,
1932         "rtems_rate_monotonic_cancel");
1933   begin
1934 
1935      Result := Rate_Monotonic_Cancel_Base ( ID );
1936
1937   end Rate_Monotonic_Cancel;
1938 
1939   procedure Rate_Monotonic_Period (
1940      ID      : in     RTEMS.ID;
1941      Length  : in     RTEMS.Interval;
1942      Result  :    out RTEMS.Status_Codes
1943   ) is
1944      function Rate_Monotonic_Period_Base (
1945         ID     : RTEMS.ID;
1946         Length : RTEMS.Interval
1947      )  return RTEMS.Status_Codes;
1948      pragma Import (C, Rate_Monotonic_Period_Base,
1949         "rtems_rate_monotonic_period");
1950   begin
1951 
1952      Result := Rate_Monotonic_Period_base ( ID, Length );
1953
1954   end Rate_Monotonic_Period;
1955 
1956 
1957   procedure Rate_Monotonic_Get_Status (
1958      ID      : in     RTEMS.ID;
1959      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1960      Result  :    out RTEMS.Status_Codes
1961   ) is
1962      function Rate_Monotonic_Get_Status_Base (
1963         ID      : RTEMS.ID;
1964         Status  : access RTEMS.Rate_Monotonic_Period_Status
1965      )  return RTEMS.Status_Codes;
1966      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1967         "rtems_rate_monotonic_get_status");
1968
1969      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1970   begin
1971
1972      Result := Rate_Monotonic_Get_Status_Base (
1973         ID,
1974         Status_Base'Unchecked_Access
1975      );
1976
1977      Status := Status_Base;
1978
1979
1980   end Rate_Monotonic_Get_Status;
1981
1982   --
1983   -- Multiprocessing Manager
1984   --
1985 
1986   procedure Multiprocessing_Announce is
1987      procedure Multiprocessing_Announce_Base;
1988      pragma Import (C, Multiprocessing_Announce_Base,
1989         "rtems_multiprocessing_announce");
1990   begin
1991 
1992      Multiprocessing_Announce_Base;
1993
1994   end Multiprocessing_Announce;
1995 
1996 
1997   --
1998   -- Debug Manager
1999   --
2000 
2001   procedure Debug_Enable (
2002      To_Be_Enabled : in     RTEMS.Debug_Set
2003   ) is
2004      procedure Debug_Enable_Base (
2005         To_Be_Enabled : RTEMS.Debug_Set
2006      );
2007   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
2008   begin
2009 
2010      Debug_Enable_Base ( To_Be_Enabled );
2011
2012   end Debug_Enable;
2013 
2014   procedure Debug_Disable (
2015      To_Be_Disabled : in     RTEMS.Debug_Set
2016   ) is
2017      procedure Debug_Disable_Base (
2018         To_Be_Disabled : RTEMS.Debug_Set
2019      );
2020   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
2021   begin
2022 
2023      Debug_Disable_Base ( To_Be_Disabled );
2024
2025   end Debug_Disable;
2026 
2027   function Debug_Is_Enabled (
2028      Level : in     RTEMS.Debug_Set
2029   ) return RTEMS.Boolean is
2030      function Debug_Is_Enabled_Base (
2031         Level : RTEMS.Debug_Set
2032      )  return RTEMS.Boolean;
2033      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
2034   begin
2035 
2036      return Debug_Is_Enabled_Base ( Level );
2037
2038   end Debug_Is_Enabled;
2039
2040    -- HACK
2041    -- function Configuration
2042    -- return RTEMS.Configuration_Table_Pointer is
2043    --    Configuration_base : RTEMS.Configuration_Table_Pointer;
2044    --    pragma Import (C, Configuration_base, "_Configuration_Table");
2045    -- begin
2046    --    return Configuration_Base;
2047    -- end Configuration;
2048
2049end RTEMS;
2050
Note: See TracBrowser for help on using the repository browser.