source: rtems/c/src/ada/rtems.adb @ 0bc8e5c

4.104.114.9
Last change on this file since 0bc8e5c was 5ca28f6a, checked in by Joel Sherrill <joel.sherrill@…>, on Dec 4, 2007 at 10:16:17 PM

2007-12-04 Joel Sherrill <joel.sherrill@…>

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