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

4.104.114.95
Last change on this file since f10fe707 was f10fe707, checked in by Joel Sherrill <joel.sherrill@…>, on Oct 1, 2007 at 10:57:52 PM

2007-10-01 Joel Sherrill <joel.sherrill@…>

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