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

4.104.114.84.9
Last change on this file since cb19f3f8 was cb19f3f8, checked in by Joel Sherrill <joel.sherrill@…>, on Nov 17, 2005 at 2:29:23 PM

2005-11-17 Joel Sherrill <joel@…>

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