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

4.104.114.84.95
Last change on this file since d348ad96 was d348ad96, checked in by Joel Sherrill <joel.sherrill@…>, on Jun 3, 1997 at 3:11:39 PM

added more constants and fixed numer

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