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

4.104.114.95
Last change on this file since d14963b was d14963b, checked in by Glenn Humphrey <glenn.humphrey@…>, on Oct 10, 2007 at 8:46:33 PM

2007-10-10 Glenn Humphrey <glenn.humphrey@…>

  • rtems.adb, rtems.ads: Cleaned up binding and removed bindings for things that are not reasonable to do in Ada.
  • Property mode set to 100644
File size: 48.6 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_Variable_Add (
453      ID            : in     RTEMS.ID;
454      Task_Variable : in     RTEMS.Address;
455      Dtor          : in     RTEMS.Task_Variable_Dtor;
456      Result        :    out RTEMS.Status_Codes
457   ) is
458      function Task_Variable_Add_Base (
459         ID            : RTEMS.ID;
460         Task_Variable : RTEMS.Address;
461         Dtor          : RTEMS.Task_Variable_Dtor
462      )  return RTEMS.Status_Codes;
463      pragma Import (C, Task_Variable_Add_Base, "rtems_task_variable_add");
464   begin
465
466      Result := Task_Variable_Add_Base ( ID, Task_Variable, Dtor );
467
468   end Task_Variable_Add;
469
470   procedure Task_Variable_Get (
471      ID                  : in     RTEMS.ID;
472      Task_Variable       :    out RTEMS.Address;
473      Task_Variable_Value :    out RTEMS.Address;
474      Result              :    out RTEMS.Status_Codes
475   ) is
476      function Task_Variable_Get_Base (
477         ID                  : RTEMS.ID;
478         Task_Variable       : access RTEMS.Address;
479         Task_Variable_Value : access RTEMS.Address
480      )  return RTEMS.Status_Codes;
481      pragma Import (C, Task_Variable_Get_Base, "rtems_task_variable_get");
482      Task_Variable_Base       : aliased RTEMS.Address;
483      Task_Variable_Value_Base : aliased RTEMS.Address;
484   begin
485
486      Result := Task_Variable_Get_Base (
487         ID,
488         Task_Variable_Base'Unchecked_Access,
489         Task_Variable_Value_Base'Unchecked_Access
490      );
491      Task_Variable := Task_Variable_Base;
492      Task_Variable_Value := Task_Variable_Value_Base;
493
494   end Task_Variable_Get;
495
496   procedure Task_Variable_Delete (
497      ID                  : in     RTEMS.ID;
498      Task_Variable       :    out RTEMS.Address;
499      Result              :    out RTEMS.Status_Codes
500   ) is
501      function Task_Variable_Delete_Base (
502         ID                  : RTEMS.ID;
503         Task_Variable       : access RTEMS.Address
504      )  return RTEMS.Status_Codes;
505      pragma Import (
506         C, Task_Variable_Delete_Base, "rtems_task_variable_delete"
507      );
508      Task_Variable_Base : aliased RTEMS.Address;
509   begin
510
511      Result := Task_Variable_Delete_Base (
512         ID, Task_Variable_Base'Unchecked_Access
513      );
514      Task_Variable := Task_Variable_Base;
515
516   end Task_Variable_Delete;
517
518   procedure Task_Wake_When (
519      Time_Buffer : in     RTEMS.Time_Of_Day;
520      Result      :    out RTEMS.Status_Codes
521   ) is
522      function Task_Wake_When_Base (
523         Time_Buffer : RTEMS.Time_Of_Day
524      )  return RTEMS.Status_Codes;
525      pragma Import (C, Task_Wake_When_Base, "rtems_task_wake_when");
526   begin
527
528      Result := Task_Wake_When_Base ( Time_Buffer );
529
530   end Task_Wake_When;
531 
532   procedure Task_Wake_After (
533      Ticks  : in     RTEMS.Interval;
534      Result :    out RTEMS.Status_Codes
535   ) is
536      function Task_Wake_After_Base (
537         Ticks : RTEMS.Interval
538      )  return RTEMS.Status_Codes;
539      pragma Import (C, Task_Wake_After_Base, "rtems_task_wake_after");
540   begin
541
542      Result := Task_Wake_After_Base ( Ticks );
543
544   end Task_Wake_After;
545 
546   --
547   -- Interrupt Manager
548   --
549
550   -- Interrupt_Disable is interfaced in the specification
551   -- Interrupt_Enable is interfaced in the specification
552   -- Interrupt_Flash is interfaced in the specification
553   -- Interrupt_Is_In_Progress is interfaced in the specification
554
555   --
556   -- Clock Manager
557   --
558 
559   procedure Clock_Get (
560      Option      : in     RTEMS.Clock_Get_Options;
561      Time_Buffer : in     RTEMS.Address;
562      Result      :    out RTEMS.Status_Codes
563   ) is
564      function Clock_Get_base (
565         Option      : RTEMS.Clock_Get_Options;
566         Time_Buffer : RTEMS.Address
567      )  return RTEMS.Status_Codes;
568      pragma Import (C, Clock_Get_base, "rtems_clock_get");
569   begin
570
571      Result := Clock_Get_base ( Option, Time_Buffer );
572
573   end Clock_Get;
574 
575   procedure Clock_Set (
576      Time_Buffer : in     RTEMS.Time_Of_Day;
577      Result      :    out RTEMS.Status_Codes
578   ) is
579      function Clock_Set_base (
580         Time_Buffer : RTEMS.Time_Of_Day
581      )  return RTEMS.Status_Codes;
582      pragma Import (C, Clock_Set_base, "rtems_clock_set");
583   begin
584 
585      Result := Clock_Set_base ( Time_Buffer );
586
587   end Clock_Set;
588 
589   procedure Clock_Tick (
590      Result :    out RTEMS.Status_Codes
591   ) is
592      function Clock_Tick_Base return RTEMS.Status_Codes;
593      pragma Import (C, Clock_Tick_Base, "rtems_clock_tick");
594   begin
595
596      Result := Clock_Tick_Base;
597
598   end Clock_Tick;
599 
600   --
601   -- Extension Manager
602   --
603 
604   procedure Extension_Create (
605      Name   : in     RTEMS.Name;
606      Table  : in     RTEMS.Extensions_Table_Pointer;
607      ID     :    out RTEMS.ID;
608      Result :    out RTEMS.Status_Codes
609   ) is
610      function Extension_Create_Base (
611         Name   : RTEMS.Name;
612         Table  : RTEMS.Extensions_Table_Pointer;
613         ID     : access RTEMS.ID
614      )  return RTEMS.Status_Codes;
615      pragma Import (C, Extension_Create_Base, "rtems_extension_create");
616      ID_Base : aliased RTEMS.ID;
617   begin
618 
619      Result := Extension_Create_Base ( Name, Table, ID_Base'Unchecked_Access );
620      ID := ID_Base;
621
622   end Extension_Create;
623 
624   procedure Extension_Ident (
625      Name   : in     RTEMS.Name;
626      ID     :    out RTEMS.ID;
627      Result :    out RTEMS.Status_Codes
628   ) is
629      function Extension_Ident_Base (
630         Name   : RTEMS.Name;
631         ID     : access RTEMS.ID
632      )  return RTEMS.Status_Codes;
633      pragma Import (C, Extension_Ident_Base, "rtems_extension_ident");
634      ID_Base : aliased RTEMS.ID;
635   begin
636 
637      Result := Extension_Ident_Base ( Name, ID_Base'Unchecked_Access ); 
638      ID := ID_Base;
639
640   end Extension_Ident;
641 
642   procedure Extension_Delete (
643      ID     : in     RTEMS.ID;
644      Result :    out RTEMS.Status_Codes
645   ) is
646      function Extension_Delete_Base (
647         ID : RTEMS.ID
648      )  return RTEMS.Status_Codes;
649      pragma Import (C, Extension_Delete_Base, "rtems_extension_delete");
650   begin
651 
652      Result := Extension_Delete_Base ( ID );
653
654   end Extension_Delete;
655 
656   --
657   -- Timer Manager
658   --
659 
660   procedure Timer_Create (
661      Name   : in     RTEMS.Name;
662      ID     :    out RTEMS.ID;
663      Result :    out RTEMS.Status_Codes
664   ) is
665      function Timer_Create_Base (
666         Name   : RTEMS.Name;
667         ID     : access RTEMS.ID
668      )  return RTEMS.Status_Codes;
669      pragma Import (C, Timer_Create_Base, "rtems_timer_create");
670      ID_Base : aliased RTEMS.ID;
671   begin
672 
673      Result := Timer_Create_Base ( Name, ID_Base'Unchecked_Access );
674      ID := ID_Base;
675
676   end Timer_Create;
677 
678   procedure Timer_Ident (
679      Name   : in     RTEMS.Name;
680      ID     :    out RTEMS.ID;
681      Result :    out RTEMS.Status_Codes
682   ) is
683      function Timer_Ident_Base (
684         Name   : RTEMS.Name;
685         ID     : access RTEMS.ID
686      )  return RTEMS.Status_Codes;
687      pragma Import (C, Timer_Ident_Base, "rtems_timer_ident");
688      ID_Base : aliased RTEMS.ID;
689   begin
690 
691      Result := Timer_Ident_Base ( Name, ID_Base'Unchecked_Access );
692      ID := ID_Base;
693
694   end Timer_Ident;
695 
696   procedure Timer_Delete (
697      ID     : in     RTEMS.ID;
698      Result :    out RTEMS.Status_Codes
699   ) is
700      function Timer_Delete_Base (
701         ID : RTEMS.ID
702      )  return RTEMS.Status_Codes;
703      pragma Import (C, Timer_Delete_Base, "rtems_timer_delete");
704   begin
705 
706      Result := Timer_Delete_Base ( ID );
707
708   end Timer_Delete;
709 
710   procedure Timer_Fire_After (
711      ID        : in     RTEMS.ID;
712      Ticks     : in     RTEMS.Interval;
713      Routine   : in     RTEMS.Timer_Service_Routine;
714      User_Data : in     RTEMS.Address;
715      Result    :    out RTEMS.Status_Codes
716   ) is
717      function Timer_Fire_After_Base (
718         ID        : RTEMS.ID;
719         Ticks     : RTEMS.Interval;
720         Routine   : RTEMS.Timer_Service_Routine;
721         User_Data : RTEMS.Address
722      )  return RTEMS.Status_Codes;
723      pragma Import (C, Timer_Fire_After_Base, "rtems_timer_fire_after");
724   begin
725 
726      Result := Timer_Fire_After_Base ( ID, Ticks, Routine, User_Data );
727
728   end Timer_Fire_After;
729 
730   procedure Timer_Server_Fire_After (
731      ID        : in     RTEMS.ID;
732      Ticks     : in     RTEMS.Interval;
733      Routine   : in     RTEMS.Timer_Service_Routine;
734      User_Data : in     RTEMS.Address;
735      Result    :    out RTEMS.Status_Codes
736   ) is
737      function Timer_Server_Fire_After_Base (
738         ID        : RTEMS.ID;
739         Ticks     : RTEMS.Interval;
740         Routine   : RTEMS.Timer_Service_Routine;
741         User_Data : RTEMS.Address
742      )  return RTEMS.Status_Codes;
743      pragma Import (
744        C,
745        Timer_Server_Fire_After_Base,
746        "rtems_timer_server_fire_after"
747      );
748   begin
749 
750      Result := Timer_Server_Fire_After_Base ( ID, Ticks, Routine, User_Data ); 
751
752   end Timer_Server_Fire_After;
753 
754   procedure Timer_Fire_When (
755      ID        : in     RTEMS.ID;
756      Wall_Time : in     RTEMS.Time_Of_Day;
757      Routine   : in     RTEMS.Timer_Service_Routine;
758      User_Data : in     RTEMS.Address;
759      Result    :    out RTEMS.Status_Codes
760   ) is
761      function Timer_Fire_When_Base (
762         ID        : RTEMS.ID;
763         Wall_Time : RTEMS.Time_Of_Day;
764         Routine   : RTEMS.Timer_Service_Routine;
765         User_Data : RTEMS.Address
766      )  return RTEMS.Status_Codes;
767      pragma Import (C, Timer_Fire_When_Base, "rtems_timer_fire_when");
768   begin
769 
770      Result := Timer_Fire_When_Base ( ID, Wall_Time, Routine, User_Data );
771
772   end Timer_Fire_When;
773 
774   procedure Timer_Server_Fire_When (
775      ID        : in     RTEMS.ID;
776      Wall_Time : in     RTEMS.Time_Of_Day;
777      Routine   : in     RTEMS.Timer_Service_Routine;
778      User_Data : in     RTEMS.Address;
779      Result    :    out RTEMS.Status_Codes
780   ) is
781      function Timer_Server_Fire_When_Base (
782         ID        : RTEMS.ID;
783         Wall_Time : RTEMS.Time_Of_Day;
784         Routine   : RTEMS.Timer_Service_Routine;
785         User_Data : RTEMS.Address
786      )  return RTEMS.Status_Codes;
787      pragma Import (
788         C,
789         Timer_Server_Fire_When_Base,
790         "rtems_timer_server_fire_when"
791      );
792   begin
793 
794      Result :=
795         Timer_Server_Fire_When_Base ( ID, Wall_Time, Routine, User_Data ); 
796   end Timer_Server_Fire_When;
797 
798   procedure Timer_Reset (
799      ID     : in     RTEMS.ID;
800      Result :    out RTEMS.Status_Codes
801   ) is
802      function Timer_Reset_Base (
803         ID : RTEMS.ID
804      )  return RTEMS.Status_Codes;
805      pragma Import (C, Timer_Reset_Base, "rtems_timer_reset");
806   begin
807 
808      Result := Timer_Reset_Base ( ID );
809
810   end Timer_Reset;
811 
812   procedure Timer_Cancel (
813      ID     : in     RTEMS.ID;
814      Result :    out RTEMS.Status_Codes
815   ) is
816      function Timer_Cancel_Base (
817         ID : RTEMS.ID
818      )  return RTEMS.Status_Codes;
819      pragma Import (C, Timer_Cancel_Base, "rtems_timer_cancel");
820   begin
821 
822      Result := Timer_Cancel_Base ( ID );
823
824   end Timer_Cancel;
825 
826   procedure Timer_Initiate_Server (
827      Server_Priority : in     RTEMS.Task_Priority;
828      Stack_Size      : in     RTEMS.Unsigned32;
829      Attribute_Set   : in     RTEMS.Attribute;
830      Result          :    out RTEMS.Status_Codes
831   ) is
832      function Timer_Initiate_Server_Base (
833         Server_Priority : RTEMS.Task_Priority;
834         Stack_Size      : RTEMS.Unsigned32;
835         Attribute_Set   : RTEMS.Attribute
836      )  return RTEMS.Status_Codes;
837      pragma Import (
838         C,
839         Timer_Initiate_Server_Base,
840         "rtems_timer_initiate_server"
841      );
842   begin
843      Result := Timer_Initiate_Server_Base (
844         Server_Priority,
845         Stack_Size,
846         Attribute_Set
847      );
848   end Timer_Initiate_Server;
849
850   --
851   -- Semaphore Manager
852   --
853 
854   procedure Semaphore_Create (
855      Name             : in     RTEMS.Name;
856      Count            : in     RTEMS.Unsigned32;
857      Attribute_Set    : in     RTEMS.Attribute;
858      Priority_Ceiling : in     RTEMS.Task_Priority;
859      ID               :    out RTEMS.ID;
860      Result           :    out RTEMS.Status_Codes
861   ) is
862      function Semaphore_Create_Base (
863         Name             : RTEMS.Name;
864         Count            : RTEMS.Unsigned32;
865         Attribute_Set    : RTEMS.Attribute;
866         Priority_Ceiling : RTEMS.Task_Priority;
867         ID               : access RTEMS.ID
868      )  return RTEMS.Status_Codes;
869      pragma Import (C, Semaphore_Create_Base, "rtems_semaphore_create");
870      ID_Base : aliased RTEMS.ID;
871   begin
872 
873      Result := Semaphore_Create_Base (
874         Name,
875         Count,
876         Attribute_Set,
877         Priority_Ceiling,
878         ID_Base'Unchecked_Access
879      );
880      ID := ID_Base;
881
882   end Semaphore_Create;
883 
884   procedure Semaphore_Delete (
885      ID     : in     RTEMS.ID;
886      Result :    out RTEMS.Status_Codes
887   ) is
888      function Semaphore_Delete_Base (
889         ID : RTEMS.ID
890      )  return RTEMS.Status_Codes;
891      pragma Import (C, Semaphore_Delete_Base, "rtems_semaphore_delete");
892   begin
893 
894      Result := Semaphore_Delete_Base ( ID );
895
896   end Semaphore_Delete;
897 
898   procedure Semaphore_Ident (
899      Name   : in     RTEMS.Name;
900      Node   : in     RTEMS.Unsigned32;
901      ID     :    out RTEMS.ID;
902      Result :    out RTEMS.Status_Codes
903   ) is
904      function Semaphore_Ident_Base (
905         Name : RTEMS.Name;
906         Node : RTEMS.Unsigned32;
907         ID   : access RTEMS.ID
908      )  return RTEMS.Status_Codes;
909      pragma Import (C, Semaphore_Ident_Base, "rtems_semaphore_ident");
910      ID_Base : aliased RTEMS.ID;
911   begin
912 
913      Result := Semaphore_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
914      ID := ID_Base;
915
916   end Semaphore_Ident;
917 
918   procedure Semaphore_Obtain (
919      ID         : in     RTEMS.ID;
920      Option_Set : in     RTEMS.Option;
921      Timeout    : in     RTEMS.Interval;
922      Result     :    out RTEMS.Status_Codes
923   ) is
924      function Semaphore_Obtain_Base (
925         ID         : RTEMS.ID;
926         Option_Set : RTEMS.Option;
927         Timeout    : RTEMS.Interval
928      )  return RTEMS.Status_Codes;
929      pragma Import (C, Semaphore_Obtain_Base, "rtems_semaphore_obtain");
930   begin
931 
932      Result := Semaphore_Obtain_Base ( ID, Option_Set, Timeout );
933
934   end Semaphore_Obtain;
935 
936   procedure Semaphore_Release (
937      ID     : in     RTEMS.ID;
938      Result :    out RTEMS.Status_Codes
939   ) is
940      function Semaphore_Release_Base (
941         ID : RTEMS.ID
942      )  return RTEMS.Status_Codes;
943      pragma Import (C, Semaphore_Release_Base, "rtems_semaphore_release");
944   begin
945 
946      Result := Semaphore_Release_Base ( ID );
947
948   end Semaphore_Release;
949 
950   --
951   -- Message Queue Manager
952   --
953 
954   procedure Message_Queue_Create (
955      Name             : in     RTEMS.Name;
956      Count            : in     RTEMS.Unsigned32;
957      Max_Message_Size : in     RTEMS.Unsigned32;
958      Attribute_Set    : in     RTEMS.Attribute;
959      ID               :    out RTEMS.ID;
960      Result           :    out RTEMS.Status_Codes
961   ) is
962      --  XXX broken
963      function Message_Queue_Create_Base (
964         Name             : RTEMS.Name;
965         Count            : RTEMS.Unsigned32;
966         Max_Message_Size : RTEMS.Unsigned32;
967         Attribute_Set    : RTEMS.Attribute;
968         ID               : access RTEMS.ID
969      )  return RTEMS.Status_Codes;
970      pragma Import (C,
971        Message_Queue_Create_Base, "rtems_message_queue_create");
972      ID_Base : aliased RTEMS.ID;
973   begin
974 
975      Result := Message_Queue_Create_Base (
976         Name,
977         Count,
978         Max_Message_Size,
979         Attribute_Set,
980         ID_Base'Unchecked_Access
981      );
982      ID := ID_Base;
983
984   end Message_Queue_Create;
985 
986   procedure Message_Queue_Ident (
987      Name   : in     RTEMS.Name;
988      Node   : in     RTEMS.Unsigned32;
989      ID     :    out RTEMS.ID;
990      Result :    out RTEMS.Status_Codes
991   ) is
992      function Message_Queue_Ident_Base (
993         Name : RTEMS.Name;
994         Node : RTEMS.Unsigned32;
995         ID   : access RTEMS.ID
996      )  return RTEMS.Status_Codes;
997      pragma Import (C, Message_Queue_Ident_Base, "rtems_message_queue_ident");
998      ID_Base : aliased RTEMS.ID;
999   begin
1000 
1001      Result :=
1002         Message_Queue_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
1003      ID := ID_Base;
1004
1005   end Message_Queue_Ident;
1006 
1007   procedure Message_Queue_Delete (
1008      ID     : in     RTEMS.ID;
1009      Result :    out RTEMS.Status_Codes
1010   ) is
1011      function Message_Queue_Delete_Base (
1012         ID : RTEMS.ID
1013      )  return RTEMS.Status_Codes;
1014      pragma Import (
1015         C, Message_Queue_Delete_Base, "rtems_message_queue_delete");
1016   begin
1017 
1018      Result := Message_Queue_Delete_Base ( ID );
1019
1020   end Message_Queue_Delete;
1021 
1022   procedure Message_Queue_Send (
1023      ID     : in     RTEMS.ID;
1024      Buffer : in     RTEMS.Address;
1025      Size   : in     RTEMS.Unsigned32;
1026      Result :    out RTEMS.Status_Codes
1027   ) is
1028      function Message_Queue_Send_Base (
1029         ID     : RTEMS.ID;
1030         Buffer : RTEMS.Address;
1031         Size   : RTEMS.Unsigned32
1032      )  return RTEMS.Status_Codes;
1033      pragma Import (C, Message_Queue_Send_Base, "rtems_message_queue_send");
1034   begin
1035 
1036      Result := Message_Queue_Send_Base ( ID, Buffer, Size );
1037
1038   end Message_Queue_Send;
1039 
1040   procedure Message_Queue_Urgent (
1041      ID     : in     RTEMS.ID;
1042      Buffer : in     RTEMS.Address;
1043      Size   : in     RTEMS.Unsigned32;
1044      Result :    out RTEMS.Status_Codes
1045   ) is
1046      function Message_Queue_Urgent_Base (
1047         ID     : RTEMS.ID;
1048         Buffer : RTEMS.Address;
1049         Size   : RTEMS.Unsigned32
1050      )  return RTEMS.Status_Codes;
1051      pragma Import (C, Message_Queue_Urgent_Base,
1052         "rtems_message_queue_urgent");
1053   begin
1054 
1055      Result := Message_Queue_Urgent_Base ( ID, Buffer, Size );
1056
1057   end Message_Queue_Urgent;
1058 
1059   procedure Message_Queue_Broadcast (
1060      ID     : in     RTEMS.ID;
1061      Buffer : in     RTEMS.Address;
1062      Size   : in     RTEMS.Unsigned32;
1063      Count  :    out RTEMS.Unsigned32;
1064      Result :    out RTEMS.Status_Codes
1065   ) is
1066      function Message_Queue_Broadcast_Base (
1067         ID     : RTEMS.ID;
1068         Buffer : RTEMS.Address;
1069         Size   : RTEMS.Unsigned32;
1070         Count  : access RTEMS.Unsigned32 
1071      )  return RTEMS.Status_Codes;
1072      pragma Import (C, Message_Queue_Broadcast_Base,
1073         "rtems_message_queue_broadcast");
1074      Count_Base : aliased RTEMS.Unsigned32;
1075   begin
1076 
1077      Result := Message_Queue_Broadcast_Base ( 
1078         ID, 
1079         Buffer, 
1080         Size,
1081         Count_Base'Unchecked_Access
1082      );
1083      Count := Count_Base;
1084
1085   end Message_Queue_Broadcast;
1086 
1087   procedure Message_Queue_Receive (
1088      ID         : in     RTEMS.ID;
1089      Buffer     : in     RTEMS.Address;
1090      Option_Set : in     RTEMS.Option;
1091      Timeout    : in     RTEMS.Interval;
1092      Size       :    out RTEMS.Unsigned32;
1093      Result     :    out RTEMS.Status_Codes
1094   ) is
1095      function Message_Queue_Receive_Base (
1096         ID         : RTEMS.ID;
1097         Buffer     : RTEMS.Address;
1098         Size       : access RTEMS.Unsigned32;
1099         Option_Set : RTEMS.Option;
1100         Timeout    : RTEMS.Interval
1101      )  return RTEMS.Status_Codes;
1102      pragma Import (C, Message_Queue_Receive_Base,
1103         "rtems_message_queue_receive");
1104      Size_Base : aliased RTEMS.Unsigned32;
1105   begin
1106 
1107      Result := Message_Queue_Receive_Base ( 
1108         ID,
1109         Buffer, 
1110         Size_Base'Unchecked_Access,
1111         Option_Set, 
1112         Timeout
1113      );
1114      Size := Size_Base;
1115
1116   end Message_Queue_Receive;
1117 
1118   procedure Message_Queue_Flush (
1119      ID     : in     RTEMS.ID;
1120      Count  :    out RTEMS.Unsigned32;
1121      Result :    out RTEMS.Status_Codes
1122   ) is
1123      function Message_Queue_Flush_Base (
1124         ID    : RTEMS.ID;
1125         Count : access RTEMS.Unsigned32
1126      )  return RTEMS.Status_Codes;
1127      pragma Import (C, Message_Queue_Flush_Base, "rtems_message_queue_flush");
1128      COUNT_Base : aliased RTEMS.Unsigned32;
1129   begin
1130 
1131      Result := Message_Queue_Flush_Base ( ID, COUNT_Base'Unchecked_Access );
1132      Count := COUNT_Base;
1133
1134   end Message_Queue_Flush;
1135 
1136   --
1137   -- Event Manager
1138   --
1139
1140   procedure Event_Send (
1141      ID       : in     RTEMS.ID;
1142      Event_In : in     RTEMS.Event_Set;
1143      Result   :    out RTEMS.Status_Codes
1144   ) is
1145      function Event_Send_Base (
1146         ID       : RTEMS.ID;
1147         Event_In : RTEMS.Event_Set
1148      )  return RTEMS.Status_Codes;
1149      pragma Import (C, Event_Send_Base, "rtems_event_send");
1150   begin
1151
1152      Result := Event_Send_Base ( ID, Event_In );
1153
1154   end Event_Send;
1155
1156   procedure Event_Receive (
1157      Event_In   : in     RTEMS.Event_Set;
1158      Option_Set : in     RTEMS.Option;
1159      Ticks      : in     RTEMS.Interval;
1160      Event_Out  :    out RTEMS.Event_Set;
1161      Result     :    out RTEMS.Status_Codes
1162   ) is
1163      function Event_Receive_Base (
1164         Event_In   : RTEMS.Event_Set;
1165         Option_Set : RTEMS.Option;
1166         Ticks      : RTEMS.Interval;
1167         Event_Out  : access RTEMS.Event_Set
1168      )  return RTEMS.Status_Codes;
1169      pragma Import (C, Event_Receive_Base, "rtems_event_receive");
1170      Event_Out_Base : aliased RTEMS.Event_Set;
1171   begin
1172
1173      Result := Event_Receive_Base (
1174         Event_In,
1175         Option_Set,
1176         Ticks,
1177         Event_Out_Base'Access
1178      ); 
1179      Event_Out := Event_Out_Base;
1180
1181   end Event_Receive;
1182
1183   --
1184   -- Signal Manager
1185   --
1186 
1187   procedure Signal_Catch (
1188      ASR_Handler : in     RTEMS.ASR_Handler;
1189      Mode_Set    : in     RTEMS.Mode;
1190      Result      :    out RTEMS.Status_Codes
1191   ) is
1192      function Signal_Catch_Base (
1193         ASR_Handler : RTEMS.ASR_Handler;
1194         Mode_Set    : RTEMS.Mode
1195      )  return RTEMS.Status_Codes;
1196      pragma Import (C, Signal_Catch_Base, "rtems_signal_catch");
1197   begin
1198
1199      Result := Signal_Catch_Base ( ASR_Handler, Mode_Set );
1200
1201   end Signal_Catch;
1202 
1203   procedure Signal_Send (
1204      ID         : in     RTEMS.ID;
1205      Signal_Set : in     RTEMS.Signal_Set;
1206      Result     :    out RTEMS.Status_Codes
1207   ) is
1208      function Signal_Send_Base (
1209         ID         : RTEMS.ID;
1210         Signal_Set : RTEMS.Signal_Set
1211      )  return RTEMS.Status_Codes;
1212      pragma Import (C, Signal_Send_Base, "rtems_signal_send");
1213   begin
1214 
1215      Result := Signal_Send_Base ( ID, Signal_Set );
1216
1217   end Signal_Send;
1218 
1219 
1220   --
1221   -- Partition Manager
1222   --
1223 
1224   procedure Partition_Create (
1225      Name             : in     RTEMS.Name;
1226      Starting_Address : in     RTEMS.Address;
1227      Length           : in     RTEMS.Unsigned32;
1228      Buffer_Size      : in     RTEMS.Unsigned32;
1229      Attribute_Set    : in     RTEMS.Attribute;
1230      ID               :    out RTEMS.ID;
1231      Result           :    out RTEMS.Status_Codes
1232   ) is
1233      function Partition_Create_Base (
1234         Name             : RTEMS.Name;
1235         Starting_Address : RTEMS.Address;
1236         Length           : RTEMS.Unsigned32;
1237         Buffer_Size      : RTEMS.Unsigned32;
1238         Attribute_Set    : RTEMS.Attribute;
1239         ID               : access RTEMS.Event_Set
1240      )  return RTEMS.Status_Codes;
1241      pragma Import (C, Partition_Create_Base, "rtems_partition_create");
1242      ID_Base : aliased RTEMS.ID;
1243   begin
1244 
1245      Result := Partition_Create_Base (
1246         Name,
1247         Starting_Address,
1248         Length,
1249         Buffer_Size,
1250         Attribute_Set,
1251         ID_Base'Unchecked_Access
1252      );
1253      ID := ID_Base;
1254 
1255   end Partition_Create;
1256 
1257   procedure Partition_Ident (
1258      Name   : in     RTEMS.Name;
1259      Node   : in     RTEMS.Unsigned32;
1260      ID     :    out RTEMS.ID;
1261      Result :    out RTEMS.Status_Codes
1262   ) is
1263      function Partition_Ident_Base (
1264         Name : RTEMS.Name;
1265         Node : RTEMS.Unsigned32;
1266         ID   : access RTEMS.Event_Set
1267      )  return RTEMS.Status_Codes;
1268      pragma Import (C, Partition_Ident_Base, "rtems_partition_ident");
1269      ID_Base : aliased RTEMS.ID;
1270   begin
1271 
1272      Result := Partition_Ident_Base ( Name, Node, ID_Base'Unchecked_Access );
1273      ID := ID_Base;
1274
1275   end Partition_Ident;
1276 
1277   procedure Partition_Delete (
1278      ID     : in     RTEMS.ID;
1279      Result :    out RTEMS.Status_Codes
1280   ) is
1281      function Partition_Delete_Base (
1282         ID : RTEMS.ID
1283      )  return RTEMS.Status_Codes;
1284      pragma Import (C, Partition_Delete_Base, "rtems_partition_delete");
1285   begin
1286 
1287      Result := Partition_Delete_Base ( ID );
1288
1289   end Partition_Delete;
1290 
1291   procedure Partition_Get_Buffer (
1292      ID     : in     RTEMS.ID;
1293      Buffer :    out RTEMS.Address;
1294      Result :    out RTEMS.Status_Codes
1295   ) is
1296      function Partition_Get_Buffer_Base (
1297         ID     : RTEMS.ID;
1298         Buffer : access RTEMS.Address
1299      )  return RTEMS.Status_Codes;
1300      pragma Import (C, Partition_Get_Buffer_Base,
1301         "rtems_partition_get_buffer");
1302      Buffer_Base : aliased RTEMS.Address;
1303   begin
1304 
1305      Result := Partition_Get_Buffer_Base ( ID, Buffer_Base'Unchecked_Access );
1306      Buffer := Buffer_Base;
1307
1308   end Partition_Get_Buffer;
1309 
1310   procedure Partition_Return_Buffer (
1311      ID     : in     RTEMS.ID;
1312      Buffer : in     RTEMS.Address;
1313      Result :    out RTEMS.Status_Codes
1314   ) is
1315      function Partition_Return_Buffer_Base (
1316         ID     : RTEMS.Name;
1317         Buffer : RTEMS.Address
1318      )  return RTEMS.Status_Codes;
1319      pragma Import (C, Partition_Return_Buffer_Base,
1320         "rtems_partition_return_buffer");
1321   begin
1322 
1323      Result := Partition_Return_Buffer_Base ( ID, Buffer );
1324
1325   end Partition_Return_Buffer;
1326
1327   --
1328   -- Region Manager
1329   --
1330 
1331   procedure Region_Create (
1332      Name             : in     RTEMS.Name;
1333      Starting_Address : in     RTEMS.Address;
1334      Length           : in     RTEMS.Unsigned32;
1335      Page_Size        : in     RTEMS.Unsigned32;
1336      Attribute_Set    : in     RTEMS.Attribute;
1337      ID               :    out RTEMS.ID;
1338      Result           :    out RTEMS.Status_Codes
1339   ) is
1340      function Region_Create_Base (
1341         Name             : RTEMS.Name;
1342         Starting_Address : RTEMS.Address;
1343         Length           : RTEMS.Unsigned32;
1344         Page_Size        : RTEMS.Unsigned32;
1345         Attribute_Set    : RTEMS.Attribute;
1346         ID               : access RTEMS.ID
1347      )  return RTEMS.Status_Codes;
1348      pragma Import (C, Region_Create_Base, "rtems_region_create");
1349      ID_Base : aliased RTEMS.ID;
1350   begin
1351 
1352      Result := Region_Create_Base (
1353         Name,
1354         Starting_Address,
1355         Length,
1356         Page_Size,
1357         Attribute_Set,
1358         ID_Base'Unchecked_Access
1359      );
1360      ID := ID_Base;
1361
1362   end Region_Create;
1363 
1364   procedure Region_Ident (
1365      Name   : in     RTEMS.Name;
1366      ID     :    out RTEMS.ID;
1367      Result :    out RTEMS.Status_Codes
1368   ) is
1369      function Region_Ident_Base (
1370         Name   : RTEMS.Name;
1371         ID     : access RTEMS.ID
1372      )  return RTEMS.Status_Codes;
1373      pragma Import (C, Region_Ident_Base, "rtems_region_ident");
1374      ID_Base : aliased RTEMS.ID;
1375   begin
1376 
1377      Result := Region_Ident_Base ( Name, ID_Base'Unchecked_Access );
1378      ID := ID_Base;
1379
1380   end Region_Ident;
1381 
1382   procedure Region_Delete (
1383      ID     : in     RTEMS.ID;
1384      Result :    out RTEMS.Status_Codes
1385   ) is
1386      function Region_Delete_Base (
1387         ID : RTEMS.ID
1388      )  return RTEMS.Status_Codes;
1389      pragma Import (C, Region_Delete_Base, "rtems_region_delete");
1390   begin
1391 
1392      Result := Region_Delete_Base ( ID );
1393
1394   end Region_Delete;
1395 
1396   procedure Region_Extend (
1397      ID               : in     RTEMS.ID;
1398      Starting_Address : in     RTEMS.Address;
1399      Length           : in     RTEMS.Unsigned32;
1400      Result           :    out RTEMS.Status_Codes
1401   ) is
1402      function Region_Extend_Base (
1403         ID               : RTEMS.ID;
1404         Starting_Address : RTEMS.Address;
1405         Length           : RTEMS.Unsigned32
1406      )  return RTEMS.Status_Codes;
1407      pragma Import (C, Region_Extend_Base, "rtems_region_extend");
1408   begin
1409 
1410      Result := Region_Extend_Base ( ID, Starting_Address, Length );
1411
1412   end Region_Extend;
1413 
1414   procedure Region_Get_Segment (
1415      ID         : in     RTEMS.ID;
1416      Size       : in     RTEMS.Unsigned32;
1417      Option_Set : in     RTEMS.Option;
1418      Timeout    : in     RTEMS.Interval;
1419      Segment    :    out RTEMS.Address;
1420      Result     :    out RTEMS.Status_Codes
1421   ) is
1422      function Region_Get_Segment_Base (
1423         ID         : RTEMS.ID;
1424         Size       : RTEMS.Unsigned32;
1425         Option_Set : RTEMS.Option;
1426         Timeout    : RTEMS.Interval;
1427         Segment    : access RTEMS.Address
1428      )  return RTEMS.Status_Codes;
1429      pragma Import (C, Region_Get_Segment_Base, "rtems_region_get_segment");
1430      Segment_Base : aliased RTEMS.Address;
1431   begin
1432 
1433      Result := Region_Get_Segment_Base (
1434         ID,
1435         Size,
1436         Option_Set,
1437         Timeout,
1438         Segment_Base'Unchecked_Access
1439      );
1440      Segment := SEGMENT_Base;
1441
1442   end Region_Get_Segment;
1443 
1444   procedure Region_Get_Segment_Size (
1445      ID      : in     RTEMS.ID;
1446      Segment : in     RTEMS.Address;
1447      Size    :    out RTEMS.Unsigned32;
1448      Result  :    out RTEMS.Status_Codes
1449   ) is
1450      function Region_Get_Segment_Size_Base (
1451         ID      : RTEMS.ID;
1452         Segment : RTEMS.Address;
1453         Size    : access RTEMS.Unsigned32
1454      )  return RTEMS.Status_Codes;
1455      pragma Import (C, Region_Get_Segment_Size_Base,
1456         "rtems_region_get_segment_size");
1457      Size_Base : aliased RTEMS.Unsigned32;
1458   begin
1459 
1460      Result := Region_Get_Segment_Size_Base (
1461         ID,
1462         Segment,
1463         Size_Base'Unchecked_Access
1464      );
1465      Size := SIZE_Base;
1466
1467   end Region_Get_Segment_Size;
1468 
1469   procedure Region_Return_Segment (
1470      ID      : in     RTEMS.ID;
1471      Segment : in     RTEMS.Address;
1472      Result  :    out RTEMS.Status_Codes
1473   ) is
1474      function Region_Return_Segment_Base (
1475         ID      : RTEMS.ID;
1476         Segment : RTEMS.Address
1477      )  return RTEMS.Status_Codes;
1478      pragma Import (C, Region_Return_Segment_Base,
1479         "rtems_region_return_segment");
1480   begin
1481 
1482      Result := Region_Return_Segment_Base ( ID, Segment );
1483
1484   end Region_Return_Segment;
1485 
1486   --
1487   -- Dual Ported Memory Manager
1488   --
1489 
1490   procedure Port_Create (
1491      Name           : in     RTEMS.Name;
1492      Internal_Start : in     RTEMS.Address;
1493      External_Start : in     RTEMS.Address;
1494      Length         : in     RTEMS.Unsigned32;
1495      ID             :    out RTEMS.ID;
1496      Result         :    out RTEMS.Status_Codes
1497   ) is
1498      function Port_Create_Base (
1499         Name           : RTEMS.Name;
1500         Internal_Start : RTEMS.Address;
1501         External_Start : RTEMS.Address;
1502         Length         : RTEMS.Unsigned32;
1503         ID             : access RTEMS.ID
1504      )  return RTEMS.Status_Codes;
1505      pragma Import (C, Port_Create_Base, "rtems_port_create");
1506      ID_Base : aliased RTEMS.ID;
1507   begin
1508 
1509      Result := Port_Create_Base (
1510         Name,
1511         Internal_Start,
1512         External_Start,
1513         Length,
1514         ID_Base'Unchecked_Access
1515      );
1516      ID := ID_Base;
1517
1518   end Port_Create;
1519 
1520   procedure Port_Ident (
1521      Name   : in     RTEMS.Name;
1522      ID     :    out RTEMS.ID;
1523      Result :    out RTEMS.Status_Codes
1524   ) is
1525      function Port_Ident_Base (
1526         Name : RTEMS.Name;
1527         ID   : access RTEMS.ID
1528      )  return RTEMS.Status_Codes;
1529      pragma Import (C, Port_Ident_Base, "rtems_port_ident");
1530      ID_Base : aliased RTEMS.ID;
1531   begin
1532 
1533      Result := Port_Ident_Base ( Name, ID_Base'Unchecked_Access );
1534      ID := ID_Base;
1535
1536   end Port_Ident;
1537 
1538   procedure Port_Delete (
1539      ID     : in     RTEMS.ID;
1540      Result :    out RTEMS.Status_Codes
1541   ) is
1542      function Port_Delete_Base (
1543         ID : RTEMS.ID
1544      )  return RTEMS.Status_Codes;
1545      pragma Import (C, Port_Delete_Base, "rtems_port_delete");
1546   begin
1547 
1548      Result := Port_Delete_Base ( ID );
1549
1550   end Port_Delete;
1551 
1552   procedure Port_External_To_Internal (
1553      ID       : in     RTEMS.ID;
1554      External : in     RTEMS.Address;
1555      Internal :    out RTEMS.Address;
1556      Result   :    out RTEMS.Status_Codes
1557   ) is
1558      function Port_External_To_Internal_Base (
1559         ID       : RTEMS.ID;
1560         External : RTEMS.Address;
1561         Internal : access RTEMS.Address
1562      )  return RTEMS.Status_Codes;
1563      pragma Import (C, Port_External_To_Internal_Base,
1564         "rtems_port_external_to_internal");
1565      Internal_Base : aliased RTEMS.Address;
1566   begin
1567 
1568      Result := Port_External_To_Internal_Base (
1569         ID,
1570         External,
1571         Internal_Base'Unchecked_Access
1572      );
1573      Internal := INTERNAL_Base;
1574
1575   end Port_External_To_Internal;
1576 
1577   procedure Port_Internal_To_External (
1578      ID       : in     RTEMS.ID;
1579      Internal : in     RTEMS.Address;
1580      External :    out RTEMS.Address;
1581      Result   :    out RTEMS.Status_Codes
1582   ) is
1583      function Port_Internal_To_External_Base (
1584         ID       : RTEMS.ID;
1585         Internal : RTEMS.Address;
1586         External : access RTEMS.Address
1587      )  return RTEMS.Status_Codes;
1588      pragma Import (C, Port_Internal_To_External_Base,
1589         "rtems_port_internal_to_external");
1590      External_Base : aliased RTEMS.Address;
1591   begin
1592 
1593      Result := Port_Internal_To_External_Base (
1594         ID,
1595         Internal,
1596         External_Base'Unchecked_Access
1597      );
1598      External := EXTERNAL_Base;
1599
1600   end Port_Internal_To_External;
1601 
1602 
1603   --
1604   -- Fatal Error Manager
1605   --
1606 
1607   procedure Fatal_Error_Occurred (
1608      The_Error : in     RTEMS.Unsigned32
1609   ) is
1610      procedure Fatal_Error_Occurred_base (
1611         The_Error : RTEMS.Unsigned32
1612      );
1613   pragma Import (C, Fatal_Error_Occurred_Base, "rtems_fatal_error_occurred");
1614   begin
1615 
1616      Fatal_Error_Occurred_Base ( The_Error );
1617
1618   end Fatal_Error_Occurred;
1619
1620
1621   --
1622   -- Rate Monotonic Manager
1623   --
1624 
1625   procedure Rate_Monotonic_Create (
1626      Name   : in     RTEMS.Name;
1627      ID     :    out RTEMS.ID;
1628      Result :    out RTEMS.Status_Codes
1629   ) is
1630      function Rate_Monotonic_Create_base (
1631         Name   : RTEMS.Name;
1632         ID     : access RTEMS.ID
1633      )  return RTEMS.Status_Codes;
1634      pragma Import (C, Rate_Monotonic_Create_base, "rtems_rate_monotonic_create");
1635      ID_Base : aliased RTEMS.ID;
1636   begin
1637 
1638      Result := Rate_Monotonic_Create_base ( Name, ID_Base'Unchecked_Access );
1639      ID := ID_Base;
1640
1641   end Rate_Monotonic_Create;
1642 
1643   procedure Rate_Monotonic_Ident (
1644      Name   : in     RTEMS.Name;
1645      ID     :    out RTEMS.ID;
1646      Result :    out RTEMS.Status_Codes
1647   ) is
1648      function Rate_Monotonic_Ident_Base (
1649         Name   : RTEMS.Name;
1650         ID     : access RTEMS.ID
1651      )  return RTEMS.Status_Codes;
1652      pragma Import (C, Rate_Monotonic_Ident_Base, "rtems_rate_monotonic_ident");
1653      ID_Base : aliased RTEMS.ID;
1654   begin
1655 
1656      Result := Rate_Monotonic_Ident_Base ( Name, ID_Base'Unchecked_Access );
1657 
1658      ID := ID_Base;
1659
1660   end Rate_Monotonic_Ident;
1661 
1662   procedure Rate_Monotonic_Delete (
1663      ID     : in     RTEMS.ID;
1664      Result :    out RTEMS.Status_Codes
1665   ) is
1666      function Rate_Monotonic_Delete_Base (
1667         ID : RTEMS.ID
1668      )  return RTEMS.Status_Codes;
1669      pragma Import (C, Rate_Monotonic_Delete_Base,
1670         "rtems_rate_monotonic_delete");
1671   begin
1672 
1673      Result := Rate_Monotonic_Delete_base ( ID );
1674
1675   end Rate_Monotonic_Delete;
1676 
1677   procedure Rate_Monotonic_Cancel (
1678      ID     : in     RTEMS.ID;
1679      Result :    out RTEMS.Status_Codes
1680   ) is
1681      function Rate_Monotonic_Cancel_Base (
1682         ID : RTEMS.ID
1683      )  return RTEMS.Status_Codes;
1684      pragma Import (C, Rate_Monotonic_Cancel_Base,
1685         "rtems_rate_monotonic_cancel");
1686   begin
1687 
1688      Result := Rate_Monotonic_Cancel_Base ( ID );
1689
1690   end Rate_Monotonic_Cancel;
1691 
1692   procedure Rate_Monotonic_Period (
1693      ID      : in     RTEMS.ID;
1694      Length  : in     RTEMS.Interval;
1695      Result  :    out RTEMS.Status_Codes
1696   ) is
1697      function Rate_Monotonic_Period_Base (
1698         ID     : RTEMS.ID;
1699         Length : RTEMS.Interval
1700      )  return RTEMS.Status_Codes;
1701      pragma Import (C, Rate_Monotonic_Period_Base,
1702         "rtems_rate_monotonic_period");
1703   begin
1704 
1705      Result := Rate_Monotonic_Period_base ( ID, Length );
1706
1707   end Rate_Monotonic_Period;
1708 
1709 
1710   procedure Rate_Monotonic_Get_Status (
1711      ID      : in     RTEMS.ID;
1712      Status  :    out RTEMS.Rate_Monotonic_Period_Status;
1713      Result  :    out RTEMS.Status_Codes
1714   ) is
1715      function Rate_Monotonic_Get_Status_Base (
1716         ID      : RTEMS.ID;
1717         Status  : access RTEMS.Rate_Monotonic_Period_Status
1718      )  return RTEMS.Status_Codes;
1719      pragma Import (C, Rate_Monotonic_Get_Status_Base,
1720         "rtems_rate_monotonic_get_status");
1721
1722      Status_Base : aliased RTEMS.Rate_Monotonic_Period_Status;
1723   begin
1724
1725      Result := Rate_Monotonic_Get_Status_Base (
1726         ID,
1727         Status_Base'Unchecked_Access
1728      );
1729
1730      Status := Status_Base;
1731
1732
1733   end Rate_Monotonic_Get_Status;
1734
1735 
1736   --
1737   -- Debug Manager
1738   --
1739 
1740   procedure Debug_Enable (
1741      To_Be_Enabled : in     RTEMS.Debug_Set
1742   ) is
1743      procedure Debug_Enable_Base (
1744         To_Be_Enabled : RTEMS.Debug_Set
1745      );
1746   pragma Import (C, Debug_Enable_Base, "rtems_debug_enable");
1747   begin
1748 
1749      Debug_Enable_Base ( To_Be_Enabled );
1750
1751   end Debug_Enable;
1752 
1753   procedure Debug_Disable (
1754      To_Be_Disabled : in     RTEMS.Debug_Set
1755   ) is
1756      procedure Debug_Disable_Base (
1757         To_Be_Disabled : RTEMS.Debug_Set
1758      );
1759   pragma Import (C, Debug_Disable_Base, "rtems_debug_disable");
1760   begin
1761 
1762      Debug_Disable_Base ( To_Be_Disabled );
1763
1764   end Debug_Disable;
1765 
1766   function Debug_Is_Enabled (
1767      Level : in     RTEMS.Debug_Set
1768   ) return RTEMS.Boolean is
1769      function Debug_Is_Enabled_Base (
1770         Level : RTEMS.Debug_Set
1771      )  return RTEMS.Boolean;
1772      pragma Import (C, Debug_Is_Enabled_Base, "_Debug_Is_enabled");
1773   begin
1774 
1775      return Debug_Is_Enabled_Base ( Level );
1776
1777   end Debug_Is_Enabled;
1778
1779end RTEMS;
Note: See TracBrowser for help on using the repository browser.