source: rtems/cpukit/ada/rtems.adb @ 7e3dcbc

4.104.114.84.95
Last change on this file since 7e3dcbc was 7e3dcbc, checked in by Joel Sherrill <joel.sherrill@…>, on 06/03/97 at 00:33:48

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