source: rtems/c/src/ada/rtems.adb @ 44b4cf4

4.104.114.84.95
Last change on this file since 44b4cf4 was cc1aee94, checked in by Joel Sherrill <joel.sherrill@…>, on 05/23/05 at 17:15:26

2005-05-23 Joel Sherrill <joel@…>

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