source: rtems/cpukit/ada/rtems.adb @ 80f2885b

4.104.114.84.95
Last change on this file since 80f2885b was 80f2885b, checked in by Joel Sherrill <joel.sherrill@…>, on 05/20/05 at 19:15:41

2005-05-14 Sergei Organov <osv@…>

PR 746/rtems
Optimize realloc(). The problem is that realloc() can neither grow
nor shrink efficiently the current memory region without support
from underlying heap/region modules. The patch introduces one new
routine for each of heap and region modules, _Heap_Resize_block(),
and rtems_region_resize_segment(), respectively, and uses the
latter to optimize realloc().

The implementation of _Heap_Resize_block() lead to changing of the
heap allocation strategy: now the heap manager, when splits larger
free block into used and new free parts, makes the first part of
the block used, not the last one as it was before. Due to this new
strategy, _Heap_Resize_block() never needs to change the user
pointer.

Caveat: unlike previous heap implementation, first few bytes of
the contents of the memory allocated from the heap are now almost
never all zero. This can trigger bugs in client code that have not
been visible before this patch.

  • libcsupport/src/malloc.c (realloc): try to resize segment in place using new rtems_region_resize_segment() routine before falling back to the malloc()/free() method.
  • score/src/heap.c: (_Heap_Initialize): change initial heap layout to reflect new allocation strategy of using of the lower part of a previously free block when splitting it for the purpose of allocation. (_Heap_Block_allocate): when split, make the lower part used, and leave the upper part free. Return type changed from Heap_Block* to uint32_t.
  • score/include/rtems/score/heap.h: (Heap_Statistics): added 'resizes' field. (Heap_Resize_status): new enum. (_Heap_Resize_block): new routine. (_Heap_Block_allocate): return type changed from Heap_Block* to uint32_t.
  • score/src/heapwalk.c: reflect new heap layout in checks.
  • score/src/heapsizeofuserarea.c: more assertions added.
  • score/src/heapresizeblock.c: new file. (_Heap_Resize_block): new routine.
  • score/src/heapfree.c: reverse the checks _Heap_Is_block_in() and _Heap_Is_prev_used() on entry to be in this order.
  • score/src/heapallocate.c, score/src/heapallocatealigned.c: ignore return value of _Heap_Block_allocate().
  • score/Makefile.am (HEAP_C_FILES): added src/heapresizeblock.c.
  • rtems/include/rtems/rtems/region.h: (rtems_region_resize_segment): new interface routine. (_Region_Process_queue): new internal routine called from rtems_region_resize_segment() and rtems_region_return_segment().
  • rtems/src/regionreturnsegment.c: move queue management code into the new internal routine _Region_Process_queue() and call it.
  • rtems/src/regionresizesegment.c: new file. (rtems_region_resize_segment): new interface routine.
  • rtems/src/regionprocessqueue.c: new file. (_Region_Process_queue): new internal routine containing queue management code factored out from 'regionreturnsegment.c'.
  • rtems/Makefile.am (REGION_C_FILES): Added src/regionresizesegment.c, and src/regionprocessqueue.c.
  • ada/rtems.adb, ada/rtems.ads: Added Region_Resize_Segment.
  • 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         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.