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

4.104.114.84.95
Last change on this file since e56a2ef was f3f06f79, checked in by Joel Sherrill <joel.sherrill@…>, on 06/02/97 at 20:52:48

added new files from test area.

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