source: rtems/c/src/ada/rtems.adb @ dc17e8ed

4.104.114.84.95
Last change on this file since dc17e8ed was 7003847, checked in by Joel Sherrill <joel.sherrill@…>, on 02/01/02 at 18:58:21

2001-02-01 Joel Sherrill <joel@…>

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