source: rtems/cpukit/ada/rtems.adb @ a6b44a8a

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

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