source: rtems/c/src/ada/rtems.adb @ 8fe6d358

4.104.114.84.95
Last change on this file since 8fe6d358 was 63cebf6, checked in by Joel Sherrill <joel.sherrill@…>, on 09/30/97 at 14:44:28

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