source: rtems/c/src/ada/rtems.adb @ 6666ea88

4.104.114.84.95
Last change on this file since 6666ea88 was 6666ea88, checked in by Joel Sherrill <joel.sherrill@…>, on 06/03/97 at 18:07:30

Added True and False constants for RTEMS.Boolean types. This necessitated
making sure every True/False? reference was fully qualified.

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