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

4.104.114.84.9
Last change on this file since a6ec372 was a6ec372, checked in by Joel Sherrill <joel.sherrill@…>, on Apr 2, 2007 at 8:53:05 PM

2007-04-02 Jennifer Averett <jennifer.averrett@…>

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