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

4.104.114.84.95
Last change on this file since df49c60 was 8f2cf931, checked in by Joel Sherrill <joel.sherrill@…>, on 10/21/99 at 14:49:24

Added Semaphore_Flush.

  • Property mode set to 100644
File size: 54.8 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   procedure Semaphore_Flush (
983      ID     : in     RTEMS.ID;
984      Result :    out RTEMS.Status_Codes
985   ) is
986      function Semaphore_Flush_Base (
987         ID : RTEMS.ID
988      )  return RTEMS.Status_Codes;
989      pragma Import (C, Semaphore_Flush_Base, "rtems_semaphore_flush");
990   begin
991 
992      Result := Semaphore_Flush_Base ( ID );
993
994   end Semaphore_Release;
995 
996   --
997   -- Message Queue Manager
998   --
999 
1000   procedure Message_Queue_Create (
1001      Name             : in     RTEMS.Name;
1002      Count            : in     RTEMS.Unsigned32;
1003      Max_Message_Size : in     RTEMS.Unsigned32;
1004      Attribute_Set    : in     RTEMS.Attribute;
1005      ID               :    out RTEMS.ID;
1006      Result           :    out RTEMS.Status_Codes
1007   ) is
1008      --  XXX broken
1009      function Message_Queue_Create_Base (
1010         Name             : RTEMS.Name;
1011         Count            : RTEMS.Unsigned32;
1012         Max_Message_Size : RTEMS.Unsigned32;
1013         Attribute_Set    : RTEMS.Attribute;
1014         ID               : access RTEMS.ID
1015      )  return RTEMS.Status_Codes;
1016      pragma Import (C,
1017        Message_Queue_Create_Base, "rtems_message_queue_create");
1018      ID_Base : aliased RTEMS.ID := ID;
1019   begin
1020 
1021      Result := Message_Queue_Create_Base (
1022         Name,
1023         Count,
1024         Max_Message_Size,
1025         Attribute_Set,
1026         ID_Base'Unchecked_Access
1027      );
1028 
1029      ID := ID_Base;
1030
1031   end Message_Queue_Create;
1032 
1033   procedure Message_Queue_Ident (
1034      Name   : in     RTEMS.Name;
1035      Node   : in     RTEMS.Unsigned32;
1036      ID     :    out RTEMS.ID;
1037      Result :    out RTEMS.Status_Codes
1038   ) is
1039      function Message_Queue_Ident_Base (
1040         Name : RTEMS.Name;
1041         Node : RTEMS.Unsigned32;
1042         ID   : access RTEMS.ID
1043      )  return RTEMS.Status_Codes;
1044      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
1045      ID_Base : aliased RTEMS.ID := ID;
1046   begin
1047 
1048      Result := Message_Queue_Ident_Base (
1049         Name,
1050         Node,
1051         ID_Base'Unchecked_Access
1052      );
1053 
1054      ID := ID_Base;
1055
1056   end Message_Queue_Ident;
1057 
1058   procedure Message_Queue_Delete (
1059      ID     : in     RTEMS.ID;
1060      Result :    out RTEMS.Status_Codes
1061   ) is
1062      function Message_Queue_Delete_Base (
1063         ID : RTEMS.ID
1064      )  return RTEMS.Status_Codes;
1065      pragma Import (C, Message_Queue_Delete_Base,
1066         "rtems_message_queue_delete");
1067   begin
1068 
1069      Result := Message_Queue_Delete_Base ( ID );
1070
1071   end Message_Queue_Delete;
1072 
1073   procedure Message_Queue_Send (
1074      ID     : in     RTEMS.ID;
1075      Buffer : in     RTEMS.Address;
1076      Size   : in     RTEMS.Unsigned32;
1077      Result :    out RTEMS.Status_Codes
1078   ) is
1079      function Message_Queue_Send_Base (
1080         ID     : RTEMS.ID;
1081         Buffer : RTEMS.Address;
1082         Size   : RTEMS.Unsigned32
1083      )  return RTEMS.Status_Codes;
1084      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
1085   begin
1086 
1087      Result := Message_Queue_Send_Base ( ID, Buffer, Size );
1088
1089   end Message_Queue_Send;
1090 
1091   procedure Message_Queue_Urgent (
1092      ID     : in     RTEMS.ID;
1093      Buffer : in     RTEMS.Address;
1094      Size   : in     RTEMS.Unsigned32;
1095      Result :    out RTEMS.Status_Codes
1096   ) is
1097      function Message_Queue_Urgent_Base (
1098         ID     : RTEMS.ID;
1099         Buffer : RTEMS.Address;
1100         Size   : RTEMS.Unsigned32
1101      )  return RTEMS.Status_Codes;
1102      pragma Import (C, Message_Queue_Urgent_Base,
1103         "rtems_message_queue_urgent");
1104   begin
1105 
1106      Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
1107
1108   end Message_Queue_Urgent;
1109 
1110   procedure Message_Queue_Broadcast (
1111      ID     : in     RTEMS.ID;
1112      Buffer : in     RTEMS.Address;
1113      Size   : in     RTEMS.Unsigned32;
1114      Count  :    out RTEMS.Unsigned32;
1115      Result :    out RTEMS.Status_Codes
1116   ) is
1117      function Message_Queue_Broadcast_Base (
1118         ID     : RTEMS.ID;
1119         Buffer : RTEMS.Address;
1120         Size   : RTEMS.Unsigned32;
1121         Count  : access RTEMS.Unsigned32
1122      )  return RTEMS.Status_Codes;
1123      pragma Import (C, Message_Queue_Broadcast_Base,
1124         "rtems_message_queue_broadcast");
1125      Count_Base : aliased RTEMS.Unsigned32 := Count;
1126   begin
1127 
1128      Result := Message_Queue_Broadcast_Base (
1129                   ID,
1130                   Buffer,
1131                   Size,
1132                   Count_Base'Unchecked_Access
1133                );
1134 
1135      Count := Count_Base;
1136
1137   end Message_Queue_Broadcast;
1138 
1139   procedure Message_Queue_Receive (
1140      ID         : in     RTEMS.ID;
1141      Buffer     : in     RTEMS.Address;
1142      Option_Set : in     RTEMS.Option;
1143      Timeout    : in     RTEMS.Interval;
1144      Size       :    out RTEMS.Unsigned32;
1145      Result     :    out RTEMS.Status_Codes
1146   ) is
1147      function Message_Queue_Receive_Base (
1148         ID         : RTEMS.ID;
1149         Buffer     : RTEMS.Address;
1150         Size       : access RTEMS.Unsigned32;
1151         Option_Set : RTEMS.Option;
1152         Timeout    : RTEMS.Interval
1153      )  return RTEMS.Status_Codes;
1154      pragma Import (C, Message_Queue_Receive_Base,
1155         "rtems_message_queue_receive");
1156      Size_Base : aliased RTEMS.Unsigned32;
1157   begin
1158 
1159      Result := Message_Queue_Receive_Base (
1160                   ID,
1161                   Buffer,
1162                   Size_Base'Unchecked_Access,
1163                   Option_Set,
1164                   Timeout
1165                 );
1166
1167      Size := Size_Base;
1168
1169   end Message_Queue_Receive;
1170 
1171   procedure Message_Queue_Flush (
1172      ID     : in     RTEMS.ID;
1173      Count  :    out RTEMS.Unsigned32;
1174      Result :    out RTEMS.Status_Codes
1175   ) is
1176      function Message_Queue_Flush_Base (
1177         ID    : RTEMS.ID;
1178         Count : access RTEMS.Unsigned32
1179      )  return RTEMS.Status_Codes;
1180      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1181      COUNT_Base : aliased RTEMS.Unsigned32 := Count;
1182   begin
1183 
1184      Result := Message_Queue_Flush_Base (
1185                   ID,
1186                   COUNT_Base'Unchecked_Access
1187                );
1188 
1189      Count := COUNT_Base;
1190
1191   end Message_Queue_Flush;
1192 
1193
1194   --
1195   -- Event Manager
1196   --
1197
1198   procedure Event_Send (
1199      ID       : in     RTEMS.ID;
1200      Event_In : in     RTEMS.Event_Set;
1201      Result   :    out RTEMS.Status_Codes
1202   ) is
1203      function Event_Send_Base (
1204         ID       : RTEMS.ID;
1205         Event_In : RTEMS.Event_Set
1206      )  return RTEMS.Status_Codes;
1207      pragma Import (C, Event_Send_Base, "rtems_event_send");
1208   begin
1209
1210      Result := Event_Send_Base (
1211                   ID,
1212                   Event_In
1213                );
1214
1215   end Event_Send;
1216
1217   procedure Event_Receive (
1218      Event_In   : in     RTEMS.Event_Set;
1219      Option_Set : in     RTEMS.Option;
1220      Ticks      : in     RTEMS.Interval;
1221      Event_Out  :    out RTEMS.Event_Set;
1222      Result     :    out RTEMS.Status_Codes
1223   ) is
1224      function Event_Receive_Base (
1225         Event_In   : RTEMS.Event_Set;
1226         Option_Set : RTEMS.Option;
1227         Ticks      : RTEMS.Interval;
1228         Event_Out  : access RTEMS.Event_Set
1229      )  return RTEMS.Status_Codes;
1230      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1231      Event_Out_Base : aliased RTEMS.Event_Set; -- := Event_Out;
1232   begin
1233
1234      Result := Event_Receive_Base (
1235                   Event_In,
1236                   Option_Set,
1237                   Ticks,
1238                   Event_Out_Base'Access
1239                );
1240
1241      Event_Out := Event_Out_Base;
1242
1243   end Event_Receive;
1244
1245   --
1246   -- Signal Manager
1247   --
1248 
1249   procedure Signal_Catch (
1250      ASR_Handler : in     RTEMS.ASR_Handler;
1251      Mode_Set    : in     RTEMS.Mode;
1252      Result      :    out RTEMS.Status_Codes
1253   ) is
1254      function Signal_Catch_Base (
1255         ASR_Handler : RTEMS.ASR_Handler;
1256         Mode_Set    : RTEMS.Mode
1257      )  return RTEMS.Status_Codes;
1258      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1259   begin
1260
1261      Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
1262
1263   end Signal_Catch;
1264 
1265   procedure Signal_Send (
1266      ID         : in     RTEMS.ID;
1267      Signal_Set : in     RTEMS.Signal_Set;
1268      Result     :    out RTEMS.Status_Codes
1269   ) is
1270      function Signal_Send_Base (
1271         ID         : RTEMS.ID;
1272         Signal_Set : RTEMS.Signal_Set
1273      )  return RTEMS.Status_Codes;
1274      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1275   begin
1276 
1277      Result := Signal_Send_Base ( ID, Signal_Set );
1278
1279   end Signal_Send;
1280 
1281 
1282   --
1283   -- Partition Manager
1284   --
1285 
1286   procedure Partition_Create (
1287      Name             : in     RTEMS.Name;
1288      Starting_Address : in     RTEMS.Address;
1289      Length           : in     RTEMS.Unsigned32;
1290      Buffer_Size      : in     RTEMS.Unsigned32;
1291      Attribute_Set    : in     RTEMS.Attribute;
1292      ID               :    out RTEMS.ID;
1293      Result           :    out RTEMS.Status_Codes
1294   ) is
1295      function Partition_Create_Base (
1296         Name             : RTEMS.Name;
1297         Starting_Address : RTEMS.Address;
1298         Length           : RTEMS.Unsigned32;
1299         Buffer_Size      : RTEMS.Unsigned32;
1300         Attribute_Set    : RTEMS.Attribute;
1301         ID               : access RTEMS.Event_Set
1302      )  return RTEMS.Status_Codes;
1303      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1304      ID_Base : aliased RTEMS.ID := ID;
1305   begin
1306 
1307      Result := Partition_Create_Base (
1308         Name,
1309         Starting_Address,
1310         Length,
1311         Buffer_Size,
1312         Attribute_Set,
1313         ID_Base'Unchecked_Access
1314      );
1315 
1316      ID := ID_Base;
1317 
1318   end Partition_Create;
1319 
1320   procedure Partition_Ident (
1321      Name   : in     RTEMS.Name;
1322      Node   : in     RTEMS.Unsigned32;
1323      ID     :    out RTEMS.ID;
1324      Result :    out RTEMS.Status_Codes
1325   ) is
1326      function Partition_Ident_Base (
1327         Name : RTEMS.Name;
1328         Node : RTEMS.Unsigned32;
1329         ID   : access RTEMS.Event_Set
1330      )  return RTEMS.Status_Codes;
1331      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1332      ID_Base : aliased RTEMS.ID := ID;
1333   begin
1334 
1335      Result := Partition_Ident_Base (
1336         Name,
1337         Node,
1338         ID_Base'Unchecked_Access
1339      );
1340 
1341      ID := ID_Base;
1342
1343   end Partition_Ident;
1344 
1345   procedure Partition_Delete (
1346      ID     : in     RTEMS.ID;
1347      Result :    out RTEMS.Status_Codes
1348   ) is
1349      function Partition_Delete_Base (
1350         ID : RTEMS.ID
1351      )  return RTEMS.Status_Codes;
1352      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1353   begin
1354 
1355      Result := Partition_Delete_Base ( ID );
1356
1357   end Partition_Delete;
1358 
1359   procedure Partition_Get_Buffer (
1360      ID     : in     RTEMS.ID;
1361      Buffer :    out RTEMS.Address;
1362      Result :    out RTEMS.Status_Codes
1363   ) is
1364      function Partition_Get_Buffer_Base (
1365         ID     : RTEMS.ID;
1366         Buffer : access RTEMS.Address
1367      )  return RTEMS.Status_Codes;
1368      pragma Import (C, Partition_Get_Buffer_Base,
1369         "rtems_partition_get_buffer");
1370      Buffer_Base : aliased RTEMS.Address := Buffer;
1371   begin
1372 
1373      Result := Partition_Get_Buffer_Base (
1374         ID,
1375         Buffer_Base'Unchecked_Access
1376      );
1377 
1378      Buffer := Buffer_Base;
1379
1380   end Partition_Get_Buffer;
1381 
1382   procedure Partition_Return_Buffer (
1383      ID     : in     RTEMS.ID;
1384      Buffer : in     RTEMS.Address;
1385      Result :    out RTEMS.Status_Codes
1386   ) is
1387      function Partition_Return_Buffer_Base (
1388         ID     : RTEMS.Name;
1389         Buffer : RTEMS.Address
1390      )  return RTEMS.Status_Codes;
1391      pragma Import (C, Partition_Return_Buffer_Base,
1392         "rtems_partition_return_buffer");
1393   begin
1394 
1395      Result := Partition_Return_Buffer_Base ( ID, Buffer );
1396
1397   end Partition_Return_Buffer;
1398
1399   --
1400   -- Region Manager
1401   --
1402 
1403   procedure Region_Create (
1404      Name             : in     RTEMS.Name;
1405      Starting_Address : in     RTEMS.Address;
1406      Length           : in     RTEMS.Unsigned32;
1407      Page_Size        : in     RTEMS.Unsigned32;
1408      Attribute_Set    : in     RTEMS.Attribute;
1409      ID               :    out RTEMS.ID;
1410      Result           :    out RTEMS.Status_Codes
1411   ) is
1412      function Region_Create_Base (
1413         Name             : RTEMS.Name;
1414         Starting_Address : RTEMS.Address;
1415         Length           : RTEMS.Unsigned32;
1416         Page_Size        : RTEMS.Unsigned32;
1417         Attribute_Set    : RTEMS.Attribute;
1418         ID               : access RTEMS.ID
1419      )  return RTEMS.Status_Codes;
1420      pragma Import (C, Region_Create_Base, "rtems_region_create");
1421      ID_Base : aliased RTEMS.ID := ID;
1422 
1423   begin
1424 
1425      Result := Region_Create_Base (
1426                        Name,
1427                        Starting_Address,
1428                        Length,
1429                        Page_Size,
1430                        Attribute_Set,
1431                        ID_Base'Unchecked_Access
1432                     );
1433 
1434      ID := ID_Base;
1435
1436   end Region_Create;
1437 
1438   procedure Region_Ident (
1439      Name   : in     RTEMS.Name;
1440      ID     :    out RTEMS.ID;
1441      Result :    out RTEMS.Status_Codes
1442   ) is
1443      function Region_Ident_Base (
1444         Name   : RTEMS.Name;
1445         ID     : access RTEMS.ID
1446      )  return RTEMS.Status_Codes;
1447      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1448      ID_Base : aliased RTEMS.ID := ID;
1449   begin
1450 
1451      Result := Region_Ident_Base (
1452         Name,
1453         ID_Base'Unchecked_Access
1454      );
1455 
1456      ID := ID_Base;
1457
1458   end Region_Ident;
1459 
1460   procedure Region_Delete (
1461      ID     : in     RTEMS.ID;
1462      Result :    out RTEMS.Status_Codes
1463   ) is
1464      function Region_Delete_Base (
1465         ID : RTEMS.ID
1466      )  return RTEMS.Status_Codes;
1467      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1468   begin
1469 
1470      Result := Region_Delete_Base ( ID );
1471
1472   end Region_Delete;
1473 
1474   procedure Region_Extend (
1475      ID               : in     RTEMS.ID;
1476      Starting_Address : in     RTEMS.Address;
1477      Length           : in     RTEMS.Unsigned32;
1478      Result           :    out RTEMS.Status_Codes
1479   ) is
1480      function Region_Extend_Base (
1481         ID               : RTEMS.ID;
1482         Starting_Address : RTEMS.Address;
1483         Length           : RTEMS.Unsigned32
1484      )  return RTEMS.Status_Codes;
1485      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1486   begin
1487 
1488      Result := Region_Extend_Base ( ID, Starting_Address, Length );
1489
1490   end Region_Extend;
1491 
1492   procedure Region_Get_Segment (
1493      ID         : in     RTEMS.ID;
1494      Size       : in     RTEMS.Unsigned32;
1495      Option_Set : in     RTEMS.Option;
1496      Timeout    : in     RTEMS.Interval;
1497      Segment    :    out RTEMS.Address;
1498      Result     :    out RTEMS.Status_Codes
1499   ) is
1500      function Region_Get_Segment_Base (
1501         ID         : RTEMS.ID;
1502         Size       : RTEMS.Unsigned32;
1503         Option_Set : RTEMS.Option;
1504         Timeout    : RTEMS.Interval;
1505         Segment    : access RTEMS.Address
1506      )  return RTEMS.Status_Codes;
1507      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1508      Segment_Base : aliased RTEMS.Address := Segment;
1509   begin
1510 
1511      Result := Region_Get_Segment_Base (
1512         ID,
1513         Size,
1514         Option_Set,
1515         Timeout,
1516         Segment_Base'Unchecked_Access
1517      );
1518 
1519      Segment := SEGMENT_Base;
1520
1521   end Region_Get_Segment;
1522 
1523   procedure Region_Get_Segment_Size (
1524      ID      : in     RTEMS.ID;
1525      Segment : in     RTEMS.Address;
1526      Size    :    out RTEMS.Unsigned32;
1527      Result  :    out RTEMS.Status_Codes
1528   ) is
1529      function Region_Get_Segment_Size_Base (
1530         ID      : RTEMS.ID;
1531         Segment : RTEMS.Address;
1532         Size    : access RTEMS.Unsigned32
1533      )  return RTEMS.Status_Codes;
1534      pragma Import (C, Region_Get_Segment_Size_Base,
1535         "rtems_region_get_segment_size");
1536      Size_Base : aliased RTEMS.Unsigned32 := Size;
1537   begin
1538 
1539      Result := Region_Get_Segment_Size_Base (
1540         ID,
1541         Segment,
1542         Size_Base'Unchecked_Access
1543      );
1544 
1545      Size := SIZE_Base;
1546
1547   end Region_Get_Segment_Size;
1548 
1549   procedure Region_Return_Segment (
1550      ID      : in     RTEMS.ID;
1551      Segment : in     RTEMS.Address;
1552      Result  :    out RTEMS.Status_Codes
1553   ) is
1554      function Region_Return_Segment_Base (
1555         ID      : RTEMS.ID;
1556         Segment : RTEMS.Address
1557      )  return RTEMS.Status_Codes;
1558      pragma Import (C, Region_Return_Segment_Base,
1559         "rtems_region_return_segment");
1560   begin
1561 
1562      Result := Region_Return_Segment_Base ( ID, Segment );
1563
1564   end Region_Return_Segment;
1565 
1566
1567   --
1568   -- Dual Ported Memory Manager
1569   --
1570 
1571   procedure Port_Create (
1572      Name           : in     RTEMS.Name;
1573      Internal_Start : in     RTEMS.Address;
1574      External_Start : in     RTEMS.Address;
1575      Length         : in     RTEMS.Unsigned32;
1576      ID             :    out RTEMS.ID;
1577      Result         :    out RTEMS.Status_Codes
1578   ) is
1579      function Port_Create_Base (
1580         Name           : RTEMS.Name;
1581         Internal_Start : RTEMS.Address;
1582         External_Start : RTEMS.Address;
1583         Length         : RTEMS.Unsigned32;
1584         ID             : access RTEMS.ID
1585      )  return RTEMS.Status_Codes;
1586      pragma Import (C, Port_Create_Base, "rtems_port_create");
1587      ID_Base : aliased RTEMS.ID := ID;
1588 
1589   begin
1590 
1591      Result := Port_Create_Base (
1592                   Name,
1593                   Internal_Start,
1594                   External_Start,
1595                   Length,
1596                   ID_Base'Unchecked_Access
1597                );
1598 
1599      ID := ID_Base;
1600
1601   end Port_Create;
1602 
1603   procedure Port_Ident (
1604      Name   : in     RTEMS.Name;
1605      ID     :    out RTEMS.ID;
1606      Result :    out RTEMS.Status_Codes
1607   ) is
1608      function Port_Ident_Base (
1609         Name : RTEMS.Name;
1610         ID   : access RTEMS.ID
1611      )  return RTEMS.Status_Codes;
1612      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1613      ID_Base : aliased RTEMS.ID := ID;
1614   begin
1615 
1616      Result := Port_Ident_Base (
1617         Name,
1618         ID_Base'Unchecked_Access
1619      );
1620 
1621      ID := ID_Base;
1622
1623   end Port_Ident;
1624 
1625   procedure Port_Delete (
1626      ID     : in     RTEMS.ID;
1627      Result :    out RTEMS.Status_Codes
1628   ) is
1629      function Port_Delete_Base (
1630         ID : RTEMS.ID
1631      )  return RTEMS.Status_Codes;
1632      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1633   begin
1634 
1635      Result := Port_Delete_Base ( ID );
1636
1637   end Port_Delete;
1638 
1639   procedure Port_External_To_Internal (
1640      ID       : in     RTEMS.ID;
1641      External : in     RTEMS.Address;
1642      Internal :    out RTEMS.Address;
1643      Result   :    out RTEMS.Status_Codes
1644   ) is
1645      function Port_External_To_Internal_Base (
1646         ID       : RTEMS.ID;
1647         External : RTEMS.Address;
1648         Internal : access RTEMS.Address
1649      )  return RTEMS.Status_Codes;
1650      pragma Import (C, Port_External_To_Internal_Base,
1651         "rtems_port_external_to_internal");
1652      Internal_Base : aliased RTEMS.Address := Internal;
1653   begin
1654 
1655      Result := Port_External_To_Internal_Base (
1656         ID,
1657         External,
1658         Internal_Base'Unchecked_Access
1659      );
1660 
1661      Internal := INTERNAL_Base;
1662
1663   end Port_External_To_Internal;
1664 
1665   procedure Port_Internal_To_External (
1666      ID       : in     RTEMS.ID;
1667      Internal : in     RTEMS.Address;
1668      External :    out RTEMS.Address;
1669      Result   :    out RTEMS.Status_Codes
1670   ) is
1671      function Port_Internal_To_External_Base (
1672         ID       : RTEMS.ID;
1673         Internal : RTEMS.Address;
1674         External : access RTEMS.Address
1675      )  return RTEMS.Status_Codes;
1676      pragma Import (C, Port_Internal_To_External_Base,
1677         "rtems_port_internal_to_external");
1678      External_Base : aliased RTEMS.Address := External;
1679   begin
1680 
1681      Result := Port_Internal_To_External_Base (
1682         ID,
1683         Internal,
1684         External_Base'Unchecked_Access
1685      );
1686 
1687      External := EXTERNAL_Base;
1688
1689   end Port_Internal_To_External;
1690 
1691   --
1692   -- Input/Output Manager
1693   --
1694 
1695   procedure IO_Initialize (
1696      Major        : in     RTEMS.Device_Major_Number;
1697      Minor        : in     RTEMS.Device_Minor_Number;
1698      Argument     : in     RTEMS.Address;
1699      Return_Value :    out RTEMS.Unsigned32;
1700      Result       :    out RTEMS.Status_Codes
1701   ) is
1702      function IO_Initialize_Base (
1703         Major        : RTEMS.Device_Major_Number;
1704         Minor        : RTEMS.Device_Minor_Number;
1705         Argument     : RTEMS.Address;
1706         Return_Value : access RTEMS.Unsigned32
1707      )  return RTEMS.Status_Codes;
1708      pragma Import (C, IO_Initialize_Base, "rtems_io_initialize");
1709      Return_Value_Base : aliased RTEMS.Unsigned32 := Return_Value;
1710   begin
1711 
1712      Result := IO_Initialize_Base (
1713         Major,
1714         Minor,
1715         Argument,
1716         Return_Value_Base'Unchecked_Access
1717      );
1718 
1719      Return_Value := Return_Value_Base;
1720
1721   end IO_Initialize;
1722 
1723   procedure IO_Register_Name (
1724      Name   : in     String;
1725      Major  : in     RTEMS.Device_Major_Number;
1726      Minor  : in     RTEMS.Device_Minor_Number;
1727      Result :    out RTEMS.Status_Codes
1728   ) is
1729      function IO_Register_Name_Base (
1730         Name   : Interfaces.C.Char_Array;
1731         Major  : RTEMS.Device_Major_Number;
1732         Minor  : RTEMS.Device_Minor_Number
1733      )  return RTEMS.Status_Codes;
1734      pragma Import (C, IO_Register_Name_Base, "rtems_io_register_name");
1735   begin
1736
1737      Result := IO_Register_Name_Base (
1738         Interfaces.C.To_C (Name),
1739         Major,
1740         Minor
1741      );
1742
1743   end IO_Register_Name;
1744
1745   procedure IO_Lookup_Name (
1746      Name         : in     String;
1747      Device_Info  :    out RTEMS.Driver_Name_t;
1748      Result       :    out RTEMS.Status_Codes
1749   ) is
1750      function IO_Lookup_Name_Base (
1751         Name        : Interfaces.C.Char_Array;
1752         Device_Info : access RTEMS.Driver_Name_t
1753      )  return RTEMS.Status_Codes;
1754      pragma Import (C, IO_Lookup_Name_Base, "rtems_io_lookup_name");
1755
1756      Device_Info_Base : aliased RTEMS.Driver_Name_t;
1757   begin
1758
1759      Result := IO_Lookup_Name_Base (
1760         Interfaces.C.To_C (Name),
1761         Device_Info_Base'Unchecked_Access
1762      );
1763
1764      Device_Info := Device_Info_Base;
1765
1766   end IO_Lookup_Name;
1767
1768   procedure IO_Open (
1769      Major        : in     RTEMS.Device_Major_Number;
1770      Minor        : in     RTEMS.Device_Minor_Number;
1771      Argument     : in     RTEMS.Address;
1772      Result       :    out RTEMS.Status_Codes
1773   ) is
1774      function IO_Open_Base (
1775         Major        : RTEMS.Device_Major_Number;
1776         Minor        : RTEMS.Device_Minor_Number;
1777         Argument     : RTEMS.Address
1778      )  return RTEMS.Status_Codes;
1779      pragma Import (C, IO_Open_Base, "rtems_io_open");
1780   begin
1781 
1782      Result := IO_Open_Base (Major, Minor, Argument);
1783 
1784   end IO_Open;
1785 
1786   procedure IO_Close (
1787      Major        : in     RTEMS.Device_Major_Number;
1788      Minor        : in     RTEMS.Device_Minor_Number;
1789      Argument     : in     RTEMS.Address;
1790      Result       :    out RTEMS.Status_Codes
1791   ) is
1792      function IO_Close_Base (
1793         Major        : RTEMS.Device_Major_Number;
1794         Minor        : RTEMS.Device_Minor_Number;
1795         Argument     : RTEMS.Address
1796      )  return RTEMS.Status_Codes;
1797      pragma Import (C, IO_Close_Base, "rtems_io_close");
1798   begin
1799 
1800      Result := IO_Close_Base (Major, Minor, Argument);
1801 
1802   end IO_Close;
1803 
1804   procedure IO_Read (
1805      Major        : in     RTEMS.Device_Major_Number;
1806      Minor        : in     RTEMS.Device_Minor_Number;
1807      Argument     : in     RTEMS.Address;
1808      Result       :    out RTEMS.Status_Codes
1809   ) is
1810      function IO_Read_Base (
1811         Major        : RTEMS.Device_Major_Number;
1812         Minor        : RTEMS.Device_Minor_Number;
1813         Argument     : RTEMS.Address
1814      )  return RTEMS.Status_Codes;
1815      pragma Import (C, IO_Read_Base, "rtems_io_read");
1816   begin
1817 
1818      Result := IO_Read_Base (Major, Minor, Argument);
1819 
1820   end IO_Read;
1821 
1822   procedure IO_Write (
1823      Major        : in     RTEMS.Device_Major_Number;
1824      Minor        : in     RTEMS.Device_Minor_Number;
1825      Argument     : in     RTEMS.Address;
1826      Result       :    out RTEMS.Status_Codes
1827   ) is
1828      function IO_Write_Base (
1829         Major        : RTEMS.Device_Major_Number;
1830         Minor        : RTEMS.Device_Minor_Number;
1831         Argument     : RTEMS.Address
1832      )  return RTEMS.Status_Codes;
1833      pragma Import (C, IO_Write_Base, "rtems_io_write");
1834   begin
1835 
1836      Result := IO_Write_Base (Major, Minor, Argument);
1837 
1838   end IO_Write;
1839 
1840   procedure IO_Control (
1841      Major        : in     RTEMS.Device_Major_Number;
1842      Minor        : in     RTEMS.Device_Minor_Number;
1843      Argument     : in     RTEMS.Address;
1844      Result       :    out RTEMS.Status_Codes
1845   ) is
1846      function IO_Control_Base (
1847         Major        : RTEMS.Device_Major_Number;
1848         Minor        : RTEMS.Device_Minor_Number;
1849         Argument     : RTEMS.Address
1850      )  return RTEMS.Status_Codes;
1851      pragma Import (C, IO_Control_Base, "rtems_io_control");
1852   begin
1853 
1854      Result := IO_Control_Base (Major, Minor, Argument);
1855 
1856   end IO_Control;
1857 
1858 
1859   --
1860   -- Fatal Error Manager
1861   --
1862 
1863   procedure Fatal_Error_Occurred (
1864      The_Error : in     RTEMS.Unsigned32
1865   ) is
1866      procedure Fatal_Error_Occurred_base (
1867         The_Error : RTEMS.Unsigned32
1868      );
1869   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1870   begin
1871 
1872      Fatal_Error_Occurred_Base ( The_Error );
1873
1874   end Fatal_Error_Occurred;
1875   --
1876   -- Rate Monotonic Manager
1877   --
1878 
1879   procedure Rate_Monotonic_Create (
1880      Name   : in     RTEMS.Name;
1881      ID     :    out RTEMS.ID;
1882      Result :    out RTEMS.Status_Codes
1883   ) is
1884      function Rate_Monotonic_Create_base (
1885         Name   : RTEMS.Name;
1886         ID     : access RTEMS.ID
1887      )  return RTEMS.Status_Codes;
1888      pragma Import (C, Rate_Monotonic_Create_base, "rtems_rate_monotonic_create");
1889      ID_Base : aliased RTEMS.ID := ID;
1890   begin
1891 
1892      Result := Rate_Monotonic_Create_base (
1893         Name,
1894         ID_Base'Unchecked_Access
1895      );
1896 
1897      ID := ID_Base;
1898
1899   end Rate_Monotonic_Create;
1900 
1901   procedure Rate_Monotonic_Ident (
1902      Name   : in     RTEMS.Name;
1903      ID     :    out RTEMS.ID;
1904      Result :    out RTEMS.Status_Codes
1905   ) is
1906      function Rate_Monotonic_Ident_Base (
1907         Name   : RTEMS.Name;
1908         ID     : access RTEMS.ID
1909      )  return RTEMS.Status_Codes;
1910      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1911      ID_Base : aliased RTEMS.ID := ID;
1912   begin
1913 
1914      Result := Rate_Monotonic_Ident_Base (
1915         Name,
1916         ID_Base'Unchecked_Access
1917      );
1918 
1919      ID := ID_Base;
1920
1921   end Rate_Monotonic_Ident;
1922 
1923   procedure Rate_Monotonic_Delete (
1924      ID     : in     RTEMS.ID;
1925      Result :    out RTEMS.Status_Codes
1926   ) is
1927      function Rate_Monotonic_Delete_Base (
1928         ID : RTEMS.ID
1929      )  return RTEMS.Status_Codes;
1930      pragma Import (C, Rate_Monotonic_Delete_Base,
1931         "rtems_rate_monotonic_delete");
1932   begin
1933 
1934      Result := Rate_Monotonic_Delete_base ( ID );
1935
1936   end Rate_Monotonic_Delete;
1937 
1938   procedure Rate_Monotonic_Cancel (
1939      ID     : in     RTEMS.ID;
1940      Result :    out RTEMS.Status_Codes
1941   ) is
1942      function Rate_Monotonic_Cancel_Base (
1943         ID : RTEMS.ID
1944      )  return RTEMS.Status_Codes;
1945      pragma Import (C, Rate_Monotonic_Cancel_Base,
1946         "rtems_rate_monotonic_cancel");
1947   begin
1948 
1949      Result := Rate_Monotonic_Cancel_Base ( ID );
1950
1951   end Rate_Monotonic_Cancel;
1952 
1953   procedure Rate_Monotonic_Period (
1954      ID      : in     RTEMS.ID;
1955      Length  : in     RTEMS.Interval;
1956      Result  :    out RTEMS.Status_Codes
1957   ) is
1958      function Rate_Monotonic_Period_Base (
1959         ID     : RTEMS.ID;
1960         Length : RTEMS.Interval
1961      )  return RTEMS.Status_Codes;
1962      pragma Import (C, Rate_Monotonic_Period_Base,
1963         "rtems_rate_monotonic_period");
1964   begin
1965 
1966      Result := Rate_Monotonic_Period_base ( ID, Length );
1967
1968   end Rate_Monotonic_Period;
1969 
1970 
1971   procedure Rate_Monotonic_Get_Status (
1972      ID      : in     RTEMS.ID;
1973      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1974      Result  :    out RTEMS.Status_Codes
1975   ) is
1976      function Rate_Monotonic_Get_Status_Base (
1977         ID      : RTEMS.ID;
1978         Status  : access RTEMS.Rate_Monotonic_Period_Status
1979      )  return RTEMS.Status_Codes;
1980      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1981         "rtems_rate_monotonic_get_status");
1982
1983      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1984   begin
1985
1986      Result := Rate_Monotonic_Get_Status_Base (
1987         ID,
1988         Status_Base'Unchecked_Access
1989      );
1990
1991      Status := Status_Base;
1992
1993
1994   end Rate_Monotonic_Get_Status;
1995
1996   --
1997   -- Multiprocessing Manager
1998   --
1999 
2000   procedure Multiprocessing_Announce is
2001      procedure Multiprocessing_Announce_Base;
2002      pragma Import (C, Multiprocessing_Announce_Base,
2003         "rtems_multiprocessing_announce");
2004   begin
2005 
2006      Multiprocessing_Announce_Base;
2007
2008   end Multiprocessing_Announce;
2009 
2010 
2011   --
2012   -- Debug Manager
2013   --
2014 
2015   procedure Debug_Enable (
2016      To_Be_Enabled : in     RTEMS.Debug_Set
2017   ) is
2018      procedure Debug_Enable_Base (
2019         To_Be_Enabled : RTEMS.Debug_Set
2020      );
2021   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
2022   begin
2023 
2024      Debug_Enable_Base ( To_Be_Enabled );
2025
2026   end Debug_Enable;
2027 
2028   procedure Debug_Disable (
2029      To_Be_Disabled : in     RTEMS.Debug_Set
2030   ) is
2031      procedure Debug_Disable_Base (
2032         To_Be_Disabled : RTEMS.Debug_Set
2033      );
2034   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
2035   begin
2036 
2037      Debug_Disable_Base ( To_Be_Disabled );
2038
2039   end Debug_Disable;
2040 
2041   function Debug_Is_Enabled (
2042      Level : in     RTEMS.Debug_Set
2043   ) return RTEMS.Boolean is
2044      function Debug_Is_Enabled_Base (
2045         Level : RTEMS.Debug_Set
2046      )  return RTEMS.Boolean;
2047      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
2048   begin
2049 
2050      return Debug_Is_Enabled_Base ( Level );
2051
2052   end Debug_Is_Enabled;
2053
2054    -- HACK
2055    -- function Configuration
2056    -- return RTEMS.Configuration_Table_Pointer is
2057    --    Configuration_base : RTEMS.Configuration_Table_Pointer;
2058    --    pragma Import (C, Configuration_base, "_Configuration_Table");
2059    -- begin
2060    --    return Configuration_Base;
2061    -- end Configuration;
2062
2063end RTEMS;
2064
Note: See TracBrowser for help on using the repository browser.