Commit fa5537cb by Arnaud Charlet

New file.

Resync.

From-SVN: r123611
parent 8405d93c
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. -- -- modified version, any changes that you have made are clearly indicated. --
......
...@@ -133,7 +133,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -133,7 +133,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
begin begin
if HT.Busy > 0 then if HT.Busy > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if; end if;
while HT.Length > 0 loop while HT.Length > 0 loop
...@@ -171,14 +172,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -171,14 +172,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
begin begin
if HT.Length = 0 then if HT.Length = 0 then
raise Program_Error; raise Program_Error with
"attempt to delete node from empty hashed container";
end if; end if;
Indx := Index (HT, X); Indx := Index (HT, X);
Prev := HT.Buckets (Indx); Prev := HT.Buckets (Indx);
if Prev = null then if Prev = null then
raise Program_Error; raise Program_Error with
"attempt to delete node from empty hash bucket";
end if; end if;
if Prev = X then if Prev = X then
...@@ -188,14 +191,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -188,14 +191,16 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
if HT.Length = 1 then if HT.Length = 1 then
raise Program_Error; raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if; end if;
loop loop
Curr := Next (Prev); Curr := Next (Prev);
if Curr = null then if Curr = null then
raise Program_Error; raise Program_Error with
"attempt to delete node not in its proper hash bucket";
end if; end if;
if Curr = X then if Curr = X then
...@@ -288,16 +293,19 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -288,16 +293,19 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
return True; return True;
end if; end if;
L_Index := 0; -- Find the first node of hash table L
L_Index := 0;
loop loop
L_Node := L.Buckets (L_Index); L_Node := L.Buckets (L_Index);
exit when L_Node /= null; exit when L_Node /= null;
L_Index := L_Index + 1; L_Index := L_Index + 1;
end loop; end loop;
N := L.Length; -- For each node of hash table L, search for an equivalent node in hash
-- table R.
N := L.Length;
loop loop
if not Find (HT => R, Key => L_Node) then if not Find (HT => R, Key => L_Node) then
return False; return False;
...@@ -308,10 +316,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -308,10 +316,14 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
L_Node := Next (L_Node); L_Node := Next (L_Node);
if L_Node = null then if L_Node = null then
-- We have exhausted the nodes in this bucket
if N = 0 then if N = 0 then
return True; return True;
end if; end if;
-- Find the next bucket
loop loop
L_Index := L_Index + 1; L_Index := L_Index + 1;
L_Node := L.Buckets (L_Index); L_Node := L.Buckets (L_Index);
...@@ -347,7 +359,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -347,7 +359,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
------------------ ------------------
procedure Generic_Read procedure Generic_Read
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
HT : out Hash_Table_Type) HT : out Hash_Table_Type)
is is
N : Count_Type'Base; N : Count_Type'Base;
...@@ -359,13 +371,18 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -359,13 +371,18 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
Count_Type'Base'Read (Stream, N); Count_Type'Base'Read (Stream, N);
if N < 0 then if N < 0 then
raise Program_Error; raise Program_Error with "stream appears to be corrupt";
end if; end if;
if N = 0 then if N = 0 then
return; return;
end if; end if;
-- The RM does not specify whether or how the capacity changes when a
-- hash table is streamed in. Therefore we decide here to allocate a new
-- buckets array only when it's necessary to preserve representation
-- invariants.
if HT.Buckets = null if HT.Buckets = null
or else HT.Buckets'Length < N or else HT.Buckets'Length < N
then then
...@@ -393,7 +410,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -393,7 +410,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
------------------- -------------------
procedure Generic_Write procedure Generic_Write
(Stream : access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
HT : Hash_Table_Type) HT : Hash_Table_Type)
is is
procedure Write (Node : Node_Access); procedure Write (Node : Node_Access);
...@@ -411,6 +428,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -411,6 +428,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end Write; end Write;
begin begin
-- See Generic_Read for an explanation of why we do not stream out the
-- buckets array length too.
Count_Type'Base'Write (Stream, HT.Length); Count_Type'Base'Write (Stream, HT.Length);
Write (HT); Write (HT);
end Generic_Write; end Generic_Write;
...@@ -444,7 +464,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -444,7 +464,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
if Source.Busy > 0 then if Source.Busy > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if; end if;
Clear (Target); Clear (Target);
...@@ -507,6 +528,13 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -507,6 +528,13 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
if HT.Length = 0 then if HT.Length = 0 then
-- This is the easy case. There are no nodes, so no rehashing is
-- necessary. All we need to do is allocate a new buckets array
-- having a length implied by the specified capacity. (We say
-- "implied by" because bucket arrays are always allocated with a
-- length that corresponds to a prime number.)
if N = 0 then if N = 0 then
Free (HT.Buckets); Free (HT.Buckets);
return; return;
...@@ -537,6 +565,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -537,6 +565,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
if N < HT.Buckets'Length then if N < HT.Buckets'Length then
-- This is a request to contract the buckets array. The amount of
-- contraction is bounded in order to preserve the invariant that the
-- buckets array length is never smaller than the number of elements
-- (the load factor is 1).
if HT.Length >= HT.Buckets'Length then if HT.Length >= HT.Buckets'Length then
return; return;
end if; end if;
...@@ -556,7 +590,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -556,7 +590,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end if; end if;
if HT.Busy > 0 then if HT.Busy > 0 then
raise Program_Error; raise Program_Error with
"attempt to tamper with elements (container is busy)";
end if; end if;
Rehash : declare Rehash : declare
...@@ -622,7 +657,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -622,7 +657,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
end loop; end loop;
Free (Dst_Buckets); Free (Dst_Buckets);
raise Program_Error; raise Program_Error with
"hash function raised exception during rehash";
end; end;
Src_Index := Src_Index + 1; Src_Index := Src_Index + 1;
......
...@@ -6,11 +6,7 @@ ...@@ -6,11 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,6 +29,9 @@ ...@@ -33,6 +29,9 @@
-- This unit was originally developed by Matthew J Heaney. -- -- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package declares the hash-table type used to implement hashed
-- containers.
package Ada.Containers.Hash_Tables is package Ada.Containers.Hash_Tables is
pragma Preelaborate; pragma Preelaborate;
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G . R O U N D _ R O B I N --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body Ada.Dispatching.Round_Robin is
-----------------
-- Set_Quantum --
-----------------
procedure Set_Quantum
(Pri : System.Priority;
Quantum : Ada.Real_Time.Time_Span)
is
pragma Unreferenced (Quantum);
begin
if not Is_Round_Robin (Pri) then
raise Dispatching_Policy_Error;
end if;
end Set_Quantum;
-----------------
-- Set_Quantum --
-----------------
procedure Set_Quantum
(Low, High : System.Priority;
Quantum : Ada.Real_Time.Time_Span)
is
pragma Unreferenced (Quantum);
begin
for Index in Low .. High loop
if not Is_Round_Robin (Index) then
raise Dispatching_Policy_Error;
end if;
end loop;
end Set_Quantum;
--------------------
-- Actual_Quantum --
--------------------
function Actual_Quantum
(Pri : System.Priority) return Ada.Real_Time.Time_Span
is
begin
if Is_Round_Robin (Pri) then
return Default_Quantum;
else
raise Dispatching_Policy_Error;
end if;
end Actual_Quantum;
--------------------
-- Is_Round_Robin --
--------------------
function Is_Round_Robin (Pri : System.Priority) return Boolean is
function Get_Policy (Prio : System.Any_Priority) return Character;
pragma Import (C, Get_Policy, "__gnat_get_specific_dispatching");
begin
return Get_Policy (Pri) = 'R';
end Is_Round_Robin;
end Ada.Dispatching.Round_Robin;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G . E D F --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with Ada.Real_Time;
with Ada.Task_Identification;
package Ada.Dispatching.EDF is
pragma Preelaborate;
pragma Unimplemented_Unit;
subtype Deadline is Ada.Real_Time.Time;
Default_Deadline : constant Deadline := Ada.Real_Time.Time_Last;
procedure Set_Deadline
(D : Deadline;
T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task);
procedure Delay_Until_And_Set_Deadline
(Delay_Until_Time : Ada.Real_Time.Time;
Deadline_Offset : Ada.Real_Time.Time_Span);
function Get_Deadline
(T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task)
return Deadline;
end Ada.Dispatching.EDF;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E . G R O U P _ B U D G E T S --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with System;
package Ada.Execution_Time.Group_Budgets is
pragma Preelaborate;
pragma Unimplemented_Unit;
type Group_Budget is tagged limited private;
type Group_Budget_Handler is access
protected procedure (GB : in out Group_Budget);
type Task_Array is
array (Positive range <>) of Ada.Task_Identification.Task_Id;
Min_Handler_Ceiling : constant System.Any_Priority :=
System.Any_Priority'First;
-- Initial value is an arbitrary choice ???
procedure Add_Task
(GB : in out Group_Budget;
T : Ada.Task_Identification.Task_Id);
procedure Remove_Task
(GB : in out Group_Budget;
T : Ada.Task_Identification.Task_Id);
function Is_Member
(GB : Group_Budget;
T : Ada.Task_Identification.Task_Id) return Boolean;
function Is_A_Group_Member
(T : Ada.Task_Identification.Task_Id) return Boolean;
function Members (GB : Group_Budget) return Task_Array;
procedure Replenish
(GB : in out Group_Budget;
To : Ada.Real_Time.Time_Span);
procedure Add
(GB : in out Group_Budget;
Interval : Ada.Real_Time.Time_Span);
function Budget_Has_Expired (GB : Group_Budget) return Boolean;
function Budget_Remaining
(GB : Group_Budget) return Ada.Real_Time.Time_Span;
procedure Set_Handler
(GB : in out Group_Budget;
Handler : Group_Budget_Handler);
function Current_Handler (GB : Group_Budget) return Group_Budget_Handler;
procedure Cancel_Handler
(GB : in out Group_Budget;
Cancelled : out Boolean);
Group_Budget_Error : exception;
private
type Group_Budget is tagged limited null record;
end Ada.Execution_Time.Group_Budgets;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with Ada.Task_Identification;
with Ada.Real_Time;
package Ada.Execution_Time is
pragma Preelaborate;
pragma Unimplemented_Unit;
type CPU_Time is private;
CPU_Time_First : constant CPU_Time;
CPU_Time_Last : constant CPU_Time;
CPU_Time_Unit : constant := 0.000001;
CPU_Tick : constant Ada.Real_Time.Time_Span;
function Clock
(T : Ada.Task_Identification.Task_Id
:= Ada.Task_Identification.Current_Task)
return CPU_Time;
function "+"
(Left : CPU_Time;
Right : Ada.Real_Time.Time_Span) return CPU_Time;
function "+"
(Left : Ada.Real_Time.Time_Span;
Right : CPU_Time) return CPU_Time;
function "-"
(Left : CPU_Time;
Right : Ada.Real_Time.Time_Span) return CPU_Time;
function "-"
(Left : CPU_Time;
Right : CPU_Time) return Ada.Real_Time.Time_Span;
function "<" (Left, Right : CPU_Time) return Boolean;
function "<=" (Left, Right : CPU_Time) return Boolean;
function ">" (Left, Right : CPU_Time) return Boolean;
function ">=" (Left, Right : CPU_Time) return Boolean;
procedure Split
(T : CPU_Time;
SC : out Ada.Real_Time.Seconds_Count;
TS : out Ada.Real_Time.Time_Span);
function Time_Of
(SC : Ada.Real_Time.Seconds_Count;
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
return CPU_Time;
private
type CPU_Time is new Ada.Real_Time.Time;
CPU_Time_First : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_First);
CPU_Time_Last : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_Last);
CPU_Tick : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Tick;
end Ada.Execution_Time;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X E C U T I O N _ T I M E . T I M E R S --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
with System;
package Ada.Execution_Time.Timers is
pragma Preelaborate;
pragma Unimplemented_Unit;
type Timer (T : access Ada.Task_Identification.Task_Id) is
tagged limited private;
type Timer_Handler is
access protected procedure (TM : in out Timer);
Min_Handler_Ceiling : constant System.Any_Priority := System.Priority'Last;
procedure Set_Handler
(TM : in out Timer;
In_Time : Ada.Real_Time.Time_Span;
Handler : Timer_Handler);
procedure Set_Handler
(TM : in out Timer;
At_Time : CPU_Time;
Handler : Timer_Handler);
function Current_Handler (TM : Timer) return Timer_Handler;
procedure Cancel_Handler
(TM : in out Timer;
Cancelled : in out Boolean);
function Time_Remaining (TM : Timer) return Ada.Real_Time.Time_Span;
Timer_Resource_Error : exception;
private
type Timer (T : access Ada.Task_Identification.Task_Id) is
tagged limited null record;
end Ada.Execution_Time.Timers;
...@@ -39,9 +39,14 @@ ...@@ -39,9 +39,14 @@
#include <dirent.h> #include <dirent.h>
/* Constants used for the form parameter encoding values */
#define Encoding_UTF8 0
#define Encoding_8bits 1
typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */ typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */
extern int __gnat_max_path_len; extern int __gnat_max_path_len;
extern OS_Time __gnat_current_time (void);
extern void __gnat_to_gm_time (OS_Time *, int *, extern void __gnat_to_gm_time (OS_Time *, int *,
int *, int *, int *, int *,
int *, int *, int *, int *,
...@@ -66,8 +71,8 @@ extern int __gnat_open_new_temp (char *, int); ...@@ -66,8 +71,8 @@ extern int __gnat_open_new_temp (char *, int);
extern int __gnat_mkdir (char *); extern int __gnat_mkdir (char *);
extern int __gnat_stat (char *, extern int __gnat_stat (char *,
struct stat *); struct stat *);
extern FILE *__gnat_fopen (char *, char *); extern FILE *__gnat_fopen (char *, char *, int);
extern FILE *__gnat_freopen (char *, char *, FILE *); extern FILE *__gnat_freopen (char *, char *, FILE *, int);
extern int __gnat_open_read (char *, int); extern int __gnat_open_read (char *, int);
extern int __gnat_open_rw (char *, int); extern int __gnat_open_rw (char *, int);
extern int __gnat_open_create (char *, int); extern int __gnat_open_create (char *, int);
...@@ -117,7 +122,7 @@ extern char *__gnat_to_host_dir_spec (char *, int); ...@@ -117,7 +122,7 @@ extern char *__gnat_to_host_dir_spec (char *, int);
extern char *__gnat_to_host_file_spec (char *); extern char *__gnat_to_host_file_spec (char *);
extern char *__gnat_to_canonical_path_spec (char *); extern char *__gnat_to_canonical_path_spec (char *);
extern void __gnat_adjust_os_resource_limits (void); extern void __gnat_adjust_os_resource_limits (void);
extern void convert_addresses (void *, int, extern void convert_addresses (const char *, void *, int,
void *, int *); void *, int *);
extern int __gnat_copy_attribs (char *, char *, int); extern int __gnat_copy_attribs (char *, char *, int);
extern int __gnat_feof (FILE *); extern int __gnat_feof (FILE *);
......
...@@ -180,10 +180,10 @@ package body Bindusg is ...@@ -180,10 +180,10 @@ package body Bindusg is
Write_Line (" -s Require all source files to be present"); Write_Line (" -s Require all source files to be present");
-- Line for -Sxx switch -- Line for -S?? switch
Write_Line (" -S?? Sin/lo/hi/xx for Initialize_Scalars " & Write_Line (" -S?? Sin/lo/hi/xx/ev Initialize_Scalars " &
"invalid/low/high/hex"); "invalid/low/high/hex/env var");
-- Line for -static -- Line for -static
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,7 +32,8 @@ package Exp_Aggr is ...@@ -32,7 +32,8 @@ package Exp_Aggr is
procedure Expand_N_Extension_Aggregate (N : Node_Id); procedure Expand_N_Extension_Aggregate (N : Node_Id);
function Is_Delayed_Aggregate (N : Node_Id) return Boolean; function Is_Delayed_Aggregate (N : Node_Id) return Boolean;
-- returns True if N is a delayed aggregate of some kind -- Returns True if N is an aggregate of some kind whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag).
procedure Convert_Aggr_In_Object_Decl (N : Node_Id); procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be -- N is a N_Object_Declaration with an expression which must be
......
...@@ -198,7 +198,7 @@ package Exp_Tss is ...@@ -198,7 +198,7 @@ package Exp_Tss is
-- the corresponding base type (see Base_Init_Proc function). A special -- the corresponding base type (see Base_Init_Proc function). A special
-- case arises for concurrent types. Such types do not themselves have an -- case arises for concurrent types. Such types do not themselves have an
-- init proc TSS, but initialization is required. The init proc used is -- init proc TSS, but initialization is required. The init proc used is
-- the one fot the corresponding record type (see Base_Init_Proc). -- the one for the corresponding record type (see Base_Init_Proc).
function Base_Init_Proc (Typ : Entity_Id) return Entity_Id; function Base_Init_Proc (Typ : Entity_Id) return Entity_Id;
-- Obtains the _Init TSS entry from the base type of the entity, and also -- Obtains the _Init TSS entry from the base type of the entity, and also
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- vxworks zfp version of Put (C : Character)
with Interfaces.C; use Interfaces.C;
separate (GNAT.IO)
procedure Put (C : Character) is
function ioGlobalStdGet
(File : int) return int;
pragma Import (C, ioGlobalStdGet, "ioGlobalStdGet");
procedure fdprintf
(File : int;
Format : String;
Value : Character);
pragma Import (C, fdprintf, "fdprintf");
Stdout_ID : constant int := 1;
begin
fdprintf (ioGlobalStdGet (Stdout_ID), "%c" & ASCII.NUL, C);
end Put;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . I O --
-- --
-- B o d y --
-- --
-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- zfp version of Put (C : Character)
separate (GNAT.IO)
procedure Put (C : Character) is
procedure Putchar (C : Character);
pragma Import (C, Putchar, "putchar");
begin
Putchar (C);
end Put;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2006 Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2002-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2002-2006 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -41,15 +41,6 @@ package body Gnatvsn is ...@@ -41,15 +41,6 @@ package body Gnatvsn is
pragma Import (C, Version_String, "version_string"); pragma Import (C, Version_String, "version_string");
------------------------- -------------------------
-- Get_Gnat_Build_Type --
-------------------------
function Get_Gnat_Build_Type return Gnat_Build_Type is
begin
return FSF;
end Get_Gnat_Build_Type;
-------------------------
-- Gnat_Version_String -- -- Gnat_Version_String --
------------------------- -------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2006 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -449,7 +449,6 @@ package Rtsfind is ...@@ -449,7 +449,6 @@ package Rtsfind is
RE_Null, RE_Null,
RE_Exceptions_Available_In_HIE, -- Ada.Exceptions
RE_Code_Loc, -- Ada.Exceptions RE_Code_Loc, -- Ada.Exceptions
RE_Current_Target_Exception, -- Ada.Exceptions (JGNAT use only) RE_Current_Target_Exception, -- Ada.Exceptions (JGNAT use only)
RE_Exception_Id, -- Ada.Exceptions RE_Exception_Id, -- Ada.Exceptions
...@@ -457,7 +456,7 @@ package Rtsfind is ...@@ -457,7 +456,7 @@ package Rtsfind is
RE_Exception_Message, -- Ada.Exceptions RE_Exception_Message, -- Ada.Exceptions
RE_Exception_Name_Simple, -- Ada.Exceptions RE_Exception_Name_Simple, -- Ada.Exceptions
RE_Exception_Occurrence, -- Ada.Exceptions RE_Exception_Occurrence, -- Ada.Exceptions
RE_Null_Id, -- Ada.Exceptions RE_Local_Raise, -- Ada.Exceptions
RE_Null_Occurrence, -- Ada.Exceptions RE_Null_Occurrence, -- Ada.Exceptions
RE_Poll, -- Ada.Exceptions RE_Poll, -- Ada.Exceptions
RE_Raise_Exception, -- Ada.Exceptions RE_Raise_Exception, -- Ada.Exceptions
...@@ -483,24 +482,27 @@ package Rtsfind is ...@@ -483,24 +482,27 @@ package Rtsfind is
RE_Root_Stream_Type, -- Ada.Streams RE_Root_Stream_Type, -- Ada.Streams
RE_Stream_Element, -- Ada.Streams RE_Stream_Element, -- Ada.Streams
RE_Stream_Element_Count, -- Ada.Streams
RE_Stream_Element_Offset, -- Ada.Streams
RE_Stream_Element_Array, -- Ada.Streams
RE_Stream_Access, -- Ada.Streams.Stream_IO RE_Stream_Access, -- Ada.Streams.Stream_IO
RE_Abstract_Interface, -- Ada.Tags RE_Abstract_Interface, -- Ada.Tags
RE_Access_Level, -- Ada.Tags
RE_Addr_Ptr, -- Ada.Tags RE_Addr_Ptr, -- Ada.Tags
RE_Address_Array, -- Ada.Tags RE_Base_Address, -- Ada.Tags
RE_CW_Membership, -- Ada.Tags RE_Cstring_Ptr, -- Ada.Tags
RE_Default_Prim_Op_Count, -- Ada.Tags
RE_Descendant_Tag, -- Ada.Tags RE_Descendant_Tag, -- Ada.Tags
RE_Dispatch_Table, -- Ada.Tags
RE_Displace, -- Ada.Tags RE_Displace, -- Ada.Tags
RE_DT_Entry_Size, -- Ada.Tags RE_DT_Entry_Size, -- Ada.Tags
RE_DT_Min_Prologue_Size, -- Ada.Tags
RE_DT_Prologue_Size, -- Ada.Tags RE_DT_Prologue_Size, -- Ada.Tags
RE_DT_Typeinfo_Ptr_Size, -- Ada.Tags
RE_Expanded_Name, -- Ada.Tags
RE_External_Tag, -- Ada.Tags RE_External_Tag, -- Ada.Tags
RO_TA_External_Tag, -- Ada.Tags
RE_Get_Access_Level, -- Ada.Tags RE_Get_Access_Level, -- Ada.Tags
RE_Get_Entry_Index, -- Ada.Tags RE_Get_Entry_Index, -- Ada.Tags
RE_Get_External_Tag, -- Ada.Tags
RE_Get_Offset_Index, -- Ada.Tags RE_Get_Offset_Index, -- Ada.Tags
RE_Get_Predefined_Prim_Op_Address, -- Ada.Tags RE_Get_Predefined_Prim_Op_Address, -- Ada.Tags
RE_Get_Prim_Op_Address, -- Ada.Tags RE_Get_Prim_Op_Address, -- Ada.Tags
...@@ -508,16 +510,17 @@ package Rtsfind is ...@@ -508,16 +510,17 @@ package Rtsfind is
RE_Get_RC_Offset, -- Ada.Tags RE_Get_RC_Offset, -- Ada.Tags
RE_Get_Remotely_Callable, -- Ada.Tags RE_Get_Remotely_Callable, -- Ada.Tags
RE_Get_Tagged_Kind, -- Ada.Tags RE_Get_Tagged_Kind, -- Ada.Tags
RE_Inherit_CPP_DT, -- Ada.Tags RE_Idepth, -- Ada.Tags
RE_Inherit_DT, -- Ada.Tags RE_Ifaces_Table, -- Ada.Tags
RE_Inherit_TSD, -- Ada.Tags RE_Ifaces_Table_Ptr, -- Ada.Tags
RE_Interface_Data, -- Ada.Tags RE_Interface_Data, -- Ada.Tags
RE_Interface_Data_Ptr, -- Ada.Tags
RE_Interface_Tag, -- Ada.Tags RE_Interface_Tag, -- Ada.Tags
RE_Internal_Tag, -- Ada.Tags
RE_Is_Descendant_At_Same_Level, -- Ada.Tags
RE_IW_Membership, -- Ada.Tags RE_IW_Membership, -- Ada.Tags
RE_Nb_Ifaces, -- Ada.Tags
RE_Object_Specific_Data, -- Ada.Tags RE_Object_Specific_Data, -- Ada.Tags
RE_Offset_To_Top, -- Ada.Tags RE_Offset_To_Top, -- Ada.Tags
RE_Type_Specific_Data, -- Ada.Tags
RE_POK_Function, -- Ada.Tags RE_POK_Function, -- Ada.Tags
RE_POK_Procedure, -- Ada.Tags RE_POK_Procedure, -- Ada.Tags
RE_POK_Protected_Entry, -- Ada.Tags RE_POK_Protected_Entry, -- Ada.Tags
...@@ -528,15 +531,16 @@ package Rtsfind is ...@@ -528,15 +531,16 @@ package Rtsfind is
RE_POK_Task_Procedure, -- Ada.Tags RE_POK_Task_Procedure, -- Ada.Tags
RE_Prim_Op_Kind, -- Ada.Tags RE_Prim_Op_Kind, -- Ada.Tags
RE_Primary_DT, -- Ada.Tags RE_Primary_DT, -- Ada.Tags
RE_Prims_Ptr, -- Ada.Tags
RE_Register_Interface_Tag, -- Ada.Tags RE_Register_Interface_Tag, -- Ada.Tags
RE_Register_Tag, -- Ada.Tags RE_Register_Tag, -- Ada.Tags
RE_Remotely_Callable, -- Ada.Tags
RE_RC_Offset, -- Ada.Tags
RE_Secondary_DT, -- Ada.Tags RE_Secondary_DT, -- Ada.Tags
RE_Select_Specific_Data, -- Ada.Tags RE_Select_Specific_Data, -- Ada.Tags
RE_Set_Access_Level, -- Ada.Tags RE_Set_Access_Level, -- Ada.Tags
RE_Set_Entry_Index, -- Ada.Tags RE_Set_Entry_Index, -- Ada.Tags
RE_Set_Expanded_Name, -- Ada.Tags RE_Set_Expanded_Name, -- Ada.Tags
RE_Set_External_Tag, -- Ada.Tags
RE_Set_Interface_Table, -- Ada.Tags
RE_Set_Num_Prim_Ops, -- Ada.Tags RE_Set_Num_Prim_Ops, -- Ada.Tags
RE_Set_Offset_Index, -- Ada.Tags RE_Set_Offset_Index, -- Ada.Tags
RE_Set_Offset_To_Top, -- Ada.Tags RE_Set_Offset_To_Top, -- Ada.Tags
...@@ -552,16 +556,16 @@ package Rtsfind is ...@@ -552,16 +556,16 @@ package Rtsfind is
RE_Set_TSD, -- Ada.Tags RE_Set_TSD, -- Ada.Tags
RE_Tag, -- Ada.Tags RE_Tag, -- Ada.Tags
RE_Tag_Error, -- Ada.Tags RE_Tag_Error, -- Ada.Tags
RE_Tag_Ptr, -- Ada.Tags
RE_Tags_Table, -- Ada.Tags
RE_Tagged_Kind, -- Ada.Tags RE_Tagged_Kind, -- Ada.Tags
RE_TSD_Entry_Size, -- Ada.Tags RE_Type_Specific_Data_Ptr, -- Ada.Tags
RE_TSD_Prologue_Size, -- Ada.Tags
RE_TK_Abstract_Limited_Tagged, -- Ada.Tags RE_TK_Abstract_Limited_Tagged, -- Ada.Tags
RE_TK_Abstract_Tagged, -- Ada.Tags RE_TK_Abstract_Tagged, -- Ada.Tags
RE_TK_Limited_Tagged, -- Ada.Tags RE_TK_Limited_Tagged, -- Ada.Tags
RE_TK_Protected, -- Ada.Tags RE_TK_Protected, -- Ada.Tags
RE_TK_Tagged, -- Ada.Tags RE_TK_Tagged, -- Ada.Tags
RE_TK_Task, -- Ada.Tags RE_TK_Task, -- Ada.Tags
RE_Valid_Signature, -- Ada.Tags
RE_Abort_Task, -- Ada.Task_Identification RE_Abort_Task, -- Ada.Task_Identification
RE_Current_Task, -- Ada.Task_Identification RE_Current_Task, -- Ada.Task_Identification
...@@ -584,42 +588,13 @@ package Rtsfind is ...@@ -584,42 +588,13 @@ package Rtsfind is
RE_Unsigned_32, -- Interfaces RE_Unsigned_32, -- Interfaces
RE_Unsigned_64, -- Interfaces RE_Unsigned_64, -- Interfaces
RE_Vtable_Ptr, -- Interfaces.CPP
RE_Displaced_This, -- Interfaces.CPP
RE_CPP_CW_Membership, -- Interfaces.CPP
RE_CPP_DT_Entry_Size, -- Interfaces.CPP
RE_CPP_DT_Prologue_Size, -- Interfaces.CPP
RE_CPP_Get_External_Tag, -- Interfaces.CPP
RE_CPP_Get_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Get_RC_Offset, -- Interfaces.CPP
RE_CPP_Get_Remotely_Callable, -- Interfaces.CPP
RE_CPP_Inherit_DT, -- Interfaces.CPP
RE_CPP_Inherit_TSD, -- Interfaces.CPP
RE_CPP_Register_Tag, -- Interfaces.CPP
RE_CPP_Set_Expanded_Name, -- Interfaces.CPP
RE_CPP_Set_External_Tag, -- Interfaces.CPP
RE_CPP_Set_Prim_Op_Address, -- Interfaces.CPP
RE_CPP_Set_RC_Offset, -- Interfaces.CPP
RE_CPP_Set_Remotely_Callable, -- Interfaces.CPP
RE_CPP_Set_TSD, -- Interfaces.CPP
RE_CPP_TSD_Entry_Size, -- Interfaces.CPP
RE_CPP_TSD_Prologue_Size, -- Interfaces.CPP
RE_Packed_Size, -- Interfaces.Packed_Decimal
RE_Packed_To_Int32, -- Interfaces.Packed_Decimal
RE_Packed_To_Int64, -- Interfaces.Packed_Decimal
RE_Int32_To_Packed, -- Interfaces.Packed_Decimal
RE_Int64_To_Packed, -- Interfaces.Packed_Decimal
RE_Address, -- System RE_Address, -- System
RE_Any_Priority, -- System RE_Any_Priority, -- System
RE_Bit_Order, -- System RE_Bit_Order, -- System
RE_Default_Priority, -- System
RE_High_Order_First, -- System RE_High_Order_First, -- System
RE_Interrupt_Priority, -- System RE_Interrupt_Priority, -- System
RE_Lib_Stop, -- System RE_Lib_Stop, -- System
RE_Low_Order_First, -- System RE_Low_Order_First, -- System
RE_Max_Interrupt_Priority, -- System
RE_Max_Priority, -- System RE_Max_Priority, -- System
RE_Null_Address, -- System RE_Null_Address, -- System
RE_Priority, -- System RE_Priority, -- System
...@@ -654,7 +629,6 @@ package Rtsfind is ...@@ -654,7 +629,6 @@ package Rtsfind is
RE_Bit_Or, -- System.Bit_Ops RE_Bit_Or, -- System.Bit_Ops
RE_Bit_Xor, -- System.Bit_Ops RE_Bit_Xor, -- System.Bit_Ops
RE_Boolean_Array, -- System_Boolean_Array_Operations,
RE_Vector_Not, -- System_Boolean_Array_Operations, RE_Vector_Not, -- System_Boolean_Array_Operations,
RE_Vector_And, -- System_Boolean_Array_Operations, RE_Vector_And, -- System_Boolean_Array_Operations,
RE_Vector_Or, -- System_Boolean_Array_Operations, RE_Vector_Or, -- System_Boolean_Array_Operations,
...@@ -684,6 +658,8 @@ package Rtsfind is ...@@ -684,6 +658,8 @@ package Rtsfind is
RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_16 RE_Compare_Array_U64, -- System.Compare_Array_Unsigned_16
RE_Get_Active_Partition_Id, -- System.DSA_Services RE_Get_Active_Partition_Id, -- System.DSA_Services
RE_Get_Local_Partition_Id, -- System.DSA_Services
RE_Get_Passive_Partition_Id, -- System.DSA_Services
RE_Register_Exception, -- System.Exception_Table RE_Register_Exception, -- System.Exception_Table
...@@ -727,18 +703,14 @@ package Rtsfind is ...@@ -727,18 +703,14 @@ package Rtsfind is
RE_Fat_VAX_G, -- System.Fat_VAX_G_Float RE_Fat_VAX_G, -- System.Fat_VAX_G_Float
RE_Attach_To_Final_List, -- System.Finalization_Implementation RE_Attach_To_Final_List, -- System.Finalization_Implementation
RE_Finalizable_Ptr_Ptr, -- System.Finalization_Implementation
RE_Move_Final_List, -- System.Finalization_Implementation
RE_Finalize_List, -- System.Finalization_Implementation RE_Finalize_List, -- System.Finalization_Implementation
RE_Finalize_One, -- System.Finalization_Implementation RE_Finalize_One, -- System.Finalization_Implementation
RE_Global_Final_List, -- System.Finalization_Implementation RE_Global_Final_List, -- System.Finalization_Implementation
RE_Record_Controller, -- System.Finalization_Implementation RE_Record_Controller, -- System.Finalization_Implementation
RE_Limited_Record_Controller, -- System.Finalization_Implementation RE_Limited_Record_Controller, -- System.Finalization_Implementation
RE_Deep_Tag_Initialize, -- System.Finalization_Implementation
RE_Deep_Tag_Adjust, -- System.Finalization_Implementation
RE_Deep_Tag_Finalize, -- System.Finalization_Implementation
RE_Deep_Tag_Attach, -- System.Finalization_Implementation RE_Deep_Tag_Attach, -- System.Finalization_Implementation
RE_Deep_Rec_Initialize, -- System.Finalization_Implementation
RE_Deep_Rec_Adjust, -- System.Finalization_Implementation
RE_Deep_Rec_Finalize, -- System.Finalization_Implementation
RE_Root_Controlled, -- System.Finalization_Root RE_Root_Controlled, -- System.Finalization_Root
RE_Finalizable, -- System.Finalization_Root RE_Finalizable, -- System.Finalization_Root
...@@ -786,9 +758,6 @@ package Rtsfind is ...@@ -786,9 +758,6 @@ package Rtsfind is
RE_Mantissa_Value, -- System_Mantissa RE_Mantissa_Value, -- System_Mantissa
RE_memcpy, -- System_Memcop
RE_memmove, -- System_Memcop
RE_Bits_03, -- System.Pack_03 RE_Bits_03, -- System.Pack_03
RE_Get_03, -- System.Pack_03 RE_Get_03, -- System.Pack_03
RE_Set_03, -- System.Pack_03 RE_Set_03, -- System.Pack_03
...@@ -1076,13 +1045,9 @@ package Rtsfind is ...@@ -1076,13 +1045,9 @@ package Rtsfind is
RE_Unspecified_Size, -- System.Parameters RE_Unspecified_Size, -- System.Parameters
RE_DSA_Implementation, -- System.Partition_Interface RE_DSA_Implementation, -- System.Partition_Interface
RE_Get_Passive_Partition_Id, -- System.Partition_Interface
RE_Get_Local_Partition_Id, -- System.Partition_Interface
RE_Get_RCI_Package_Receiver, -- System.Partition_Interface RE_Get_RCI_Package_Receiver, -- System.Partition_Interface
RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface
RE_RACW_Stub_Type, -- System.Partition_Interface
RE_RACW_Stub_Type_Access, -- System.Partition_Interface RE_RACW_Stub_Type_Access, -- System.Partition_Interface
RE_RAS_Proxy_Type, -- System.Partition_Interface
RE_RAS_Proxy_Type_Access, -- System.Partition_Interface RE_RAS_Proxy_Type_Access, -- System.Partition_Interface
RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface
RE_Register_Passive_Package, -- System.Partition_Interface RE_Register_Passive_Package, -- System.Partition_Interface
...@@ -1105,7 +1070,6 @@ package Rtsfind is ...@@ -1105,7 +1070,6 @@ package Rtsfind is
RE_Partition_ID, -- System.RPC RE_Partition_ID, -- System.RPC
RE_To_PolyORB_String, -- System.Partition_Interface RE_To_PolyORB_String, -- System.Partition_Interface
RE_To_Standard_String, -- System.Partition_Interface
RE_Caseless_String_Eq, -- System.Partition_Interface RE_Caseless_String_Eq, -- System.Partition_Interface
RE_TypeCode, -- System.Partition_Interface RE_TypeCode, -- System.Partition_Interface
RE_Any, -- System.Partition_Interface RE_Any, -- System.Partition_Interface
...@@ -1122,6 +1086,7 @@ package Rtsfind is ...@@ -1122,6 +1086,7 @@ package Rtsfind is
RE_Content_Type, -- System.Partition_Interface RE_Content_Type, -- System.Partition_Interface
RE_Any_Member_Type, -- System.Partition_Interface RE_Any_Member_Type, -- System.Partition_Interface
RE_Get_Nested_Sequence_Length, -- System.Partition_Interface RE_Get_Nested_Sequence_Length, -- System.Partition_Interface
RE_Get_Any_Type, -- System.Partition_Interface
RE_Extract_Union_Value, -- System.Partition_Interface RE_Extract_Union_Value, -- System.Partition_Interface
RE_NVList_Ref, -- System.Partition_Interface RE_NVList_Ref, -- System.Partition_Interface
RE_NVList_Create, -- System.Partition_Interface RE_NVList_Create, -- System.Partition_Interface
...@@ -1133,7 +1098,7 @@ package Rtsfind is ...@@ -1133,7 +1098,7 @@ package Rtsfind is
RE_Request_Raise_Occurrence, -- System.Partition_Interface RE_Request_Raise_Occurrence, -- System.Partition_Interface
RE_Nil_Exc_List, -- System.Partition_Interface RE_Nil_Exc_List, -- System.Partition_Interface
RE_Servant, -- System.Partition_Interface RE_Servant, -- System.Partition_Interface
RE_Copy_Any_Value, -- System.Partition_Interface RE_Move_Any_Value, -- System.Partition_Interface
RE_Set_Result, -- System.Partition_Interface RE_Set_Result, -- System.Partition_Interface
RE_Register_Obj_Receiving_Stub, -- System.Partition_Interface RE_Register_Obj_Receiving_Stub, -- System.Partition_Interface
RE_Register_Pkg_Receiving_Stub, -- System.Partition_Interface RE_Register_Pkg_Receiving_Stub, -- System.Partition_Interface
...@@ -1145,7 +1110,6 @@ package Rtsfind is ...@@ -1145,7 +1110,6 @@ package Rtsfind is
RE_Make_Ref, -- System.Partition_Interface RE_Make_Ref, -- System.Partition_Interface
RE_Get_Local_Address, -- System.Partition_Interface RE_Get_Local_Address, -- System.Partition_Interface
RE_Get_Reference, -- System.Partition_Interface RE_Get_Reference, -- System.Partition_Interface
RE_Local_Oid_To_Address, -- System.Partition_Interface
RE_Asynchronous_P_To_Sync_Scope, -- System.Partition_Interface RE_Asynchronous_P_To_Sync_Scope, -- System.Partition_Interface
RE_Buffer_Stream_Type, -- System.Partition_Interface RE_Buffer_Stream_Type, -- System.Partition_Interface
RE_Allocate_Buffer, -- System.Partition_Interface RE_Allocate_Buffer, -- System.Partition_Interface
...@@ -1153,8 +1117,6 @@ package Rtsfind is ...@@ -1153,8 +1117,6 @@ package Rtsfind is
RE_BS_To_Any, -- System.Partition_Interface RE_BS_To_Any, -- System.Partition_Interface
RE_Any_To_BS, -- System.Partition_Interface RE_Any_To_BS, -- System.Partition_Interface
RE_FA_AD, -- System.Partition_Interface
RE_FA_AS, -- System.Partition_Interface
RE_FA_B, -- System.Partition_Interface RE_FA_B, -- System.Partition_Interface
RE_FA_C, -- System.Partition_Interface RE_FA_C, -- System.Partition_Interface
RE_FA_F, -- System.Partition_Interface RE_FA_F, -- System.Partition_Interface
...@@ -1176,8 +1138,7 @@ package Rtsfind is ...@@ -1176,8 +1138,7 @@ package Rtsfind is
RE_FA_String, -- System.Partition_Interface RE_FA_String, -- System.Partition_Interface
RE_FA_ObjRef, -- System.Partition_Interface RE_FA_ObjRef, -- System.Partition_Interface
RE_TA_AD, -- System.Partition_Interface RE_TA_A, -- System.Partition_Interface
RE_TA_AS, -- System.Partition_Interface
RE_TA_B, -- System.Partition_Interface RE_TA_B, -- System.Partition_Interface
RE_TA_C, -- System.Partition_Interface RE_TA_C, -- System.Partition_Interface
RE_TA_F, -- System.Partition_Interface RE_TA_F, -- System.Partition_Interface
...@@ -1205,8 +1166,6 @@ package Rtsfind is ...@@ -1205,8 +1166,6 @@ package Rtsfind is
RE_Get_TC, -- System.Partition_Interface RE_Get_TC, -- System.Partition_Interface
RE_Set_TC, -- System.Partition_Interface RE_Set_TC, -- System.Partition_Interface
RE_TC_Any, -- System.Partition_Interface RE_TC_Any, -- System.Partition_Interface
RE_TC_AD, -- System.Partition_Interface
RE_TC_AS, -- System.Partition_Interface
RE_TC_B, -- System.Partition_Interface RE_TC_B, -- System.Partition_Interface
RE_TC_C, -- System.Partition_Interface RE_TC_C, -- System.Partition_Interface
RE_TC_F, -- System.Partition_Interface RE_TC_F, -- System.Partition_Interface
...@@ -1271,16 +1230,12 @@ package Rtsfind is ...@@ -1271,16 +1230,12 @@ package Rtsfind is
RE_Integer_Address, -- System.Storage_Elements RE_Integer_Address, -- System.Storage_Elements
RE_Storage_Offset, -- System.Storage_Elements RE_Storage_Offset, -- System.Storage_Elements
RE_Storage_Array, -- System.Storage_Elements RE_Storage_Array, -- System.Storage_Elements
RE_Storage_Element, -- System.Storage_Elements
RE_To_Address, -- System.Storage_Elements RE_To_Address, -- System.Storage_Elements
RE_Root_Storage_Pool, -- System.Storage_Pools RE_Root_Storage_Pool, -- System.Storage_Pools
RE_Allocate_Any, -- System_Storage_Pools, RE_Allocate_Any, -- System_Storage_Pools,
RE_Deallocate_Any, -- System_Storage_Pools, RE_Deallocate_Any, -- System_Storage_Pools,
RE_Thin_Pointer, -- System.Stream_Attributes
RE_Fat_Pointer, -- System.Stream_Attributes
RE_I_AD, -- System.Stream_Attributes RE_I_AD, -- System.Stream_Attributes
RE_I_AS, -- System.Stream_Attributes RE_I_AS, -- System.Stream_Attributes
RE_I_B, -- System.Stream_Attributes RE_I_B, -- System.Stream_Attributes
...@@ -1323,8 +1278,6 @@ package Rtsfind is ...@@ -1323,8 +1278,6 @@ package Rtsfind is
RE_W_WC, -- System.Stream_Attributes RE_W_WC, -- System.Stream_Attributes
RE_W_WWC, -- System.Stream_Attributes RE_W_WWC, -- System.Stream_Attributes
RE_Block_Stream_Ops_OK, -- System.Stream_Attributes
RE_Str_Concat, -- System.String_Ops RE_Str_Concat, -- System.String_Ops
RE_Str_Concat_CC, -- System.String_Ops RE_Str_Concat_CC, -- System.String_Ops
RE_Str_Concat_CS, -- System.String_Ops RE_Str_Concat_CS, -- System.String_Ops
...@@ -1339,8 +1292,6 @@ package Rtsfind is ...@@ -1339,8 +1292,6 @@ package Rtsfind is
RE_Task_Info_Type, -- System.Task_Info RE_Task_Info_Type, -- System.Task_Info
RE_Unspecified_Task_Info, -- System.Task_Info RE_Unspecified_Task_Info, -- System.Task_Info
RE_Library_Task_Level, -- System.Tasking
RE_Task_Procedure_Access, -- System.Tasking RE_Task_Procedure_Access, -- System.Tasking
RO_ST_Task_Id, -- System.Tasking RO_ST_Task_Id, -- System.Tasking
...@@ -1350,22 +1301,15 @@ package Rtsfind is ...@@ -1350,22 +1301,15 @@ package Rtsfind is
RE_Simple_Call, -- System.Tasking RE_Simple_Call, -- System.Tasking
RE_Conditional_Call, -- System.Tasking RE_Conditional_Call, -- System.Tasking
RE_Asynchronous_Call, -- System.Tasking RE_Asynchronous_Call, -- System.Tasking
RE_Timed_Call, -- System.Tasking
RE_Ada_Task_Control_Block, -- System.Tasking RE_Ada_Task_Control_Block, -- System.Tasking
RE_Task_List, -- System.Tasking RE_Task_List, -- System.Tasking
RE_Accept_Alternative, -- System.Tasking
RE_Accept_List, -- System.Tasking RE_Accept_List, -- System.Tasking
RE_Accept_List_Access, -- System.Tasking
RE_Max_Select, -- System.Tasking
RE_Max_Task_Entry, -- System.Tasking
RE_No_Rendezvous, -- System.Tasking RE_No_Rendezvous, -- System.Tasking
RE_Null_Task_Entry, -- System.Tasking RE_Null_Task_Entry, -- System.Tasking
RE_Positive_Select_Index, -- System.Tasking
RE_Select_Index, -- System.Tasking RE_Select_Index, -- System.Tasking
RE_Select_Modes, -- System.Tasking
RE_Else_Mode, -- System.Tasking RE_Else_Mode, -- System.Tasking
RE_Simple_Mode, -- System.Tasking RE_Simple_Mode, -- System.Tasking
RE_Terminate_Mode, -- System.Tasking RE_Terminate_Mode, -- System.Tasking
...@@ -1377,6 +1321,7 @@ package Rtsfind is ...@@ -1377,6 +1321,7 @@ package Rtsfind is
RE_Unspecified_Priority, -- System.Tasking RE_Unspecified_Priority, -- System.Tasking
RE_Activation_Chain, -- System.Tasking RE_Activation_Chain, -- System.Tasking
RE_Activation_Chain_Access, -- System.Tasking
RE_Storage_Size, -- System.Tasking RE_Storage_Size, -- System.Tasking
RE_Abort_Defer, -- System.Soft_Links RE_Abort_Defer, -- System.Soft_Links
...@@ -1525,7 +1470,6 @@ package Rtsfind is ...@@ -1525,7 +1470,6 @@ package Rtsfind is
RE_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Entries, -- Tasking.Protected_Objects.Entries RE_Lock_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Read_Only_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries
RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries RO_PE_Set_Ceiling, -- Tasking.Protected_Objects.Entries
RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries RE_Unlock_Entries, -- Tasking.Protected_Objects.Entries
...@@ -1546,7 +1490,6 @@ package Rtsfind is ...@@ -1546,7 +1490,6 @@ package Rtsfind is
RE_Protection_Entry, -- Protected_Objects.Single_Entry RE_Protection_Entry, -- Protected_Objects.Single_Entry
RE_Initialize_Protection_Entry, -- Protected_Objects.Single_Entry RE_Initialize_Protection_Entry, -- Protected_Objects.Single_Entry
RE_Lock_Entry, -- Protected_Objects.Single_Entry RE_Lock_Entry, -- Protected_Objects.Single_Entry
RE_Lock_Read_Only_Entry, -- Protected_Objects.Single_Entry
RE_Unlock_Entry, -- Protected_Objects.Single_Entry RE_Unlock_Entry, -- Protected_Objects.Single_Entry
RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry
RE_Service_Entry, -- Protected_Objects.Single_Entry RE_Service_Entry, -- Protected_Objects.Single_Entry
...@@ -1562,7 +1505,6 @@ package Rtsfind is ...@@ -1562,7 +1505,6 @@ package Rtsfind is
RE_Initialize_Protection, -- System.Tasking.Protected_Objects RE_Initialize_Protection, -- System.Tasking.Protected_Objects
RE_Finalize_Protection, -- System.Tasking.Protected_Objects RE_Finalize_Protection, -- System.Tasking.Protected_Objects
RE_Lock, -- System.Tasking.Protected_Objects RE_Lock, -- System.Tasking.Protected_Objects
RE_Lock_Read_Only, -- System.Tasking.Protected_Objects
RE_Get_Ceiling, -- System.Tasking.Protected_Objects RE_Get_Ceiling, -- System.Tasking.Protected_Objects
RE_Set_Ceiling, -- System.Tasking.Protected_Objects RE_Set_Ceiling, -- System.Tasking.Protected_Objects
RE_Unlock, -- System.Tasking.Protected_Objects RE_Unlock, -- System.Tasking.Protected_Objects
...@@ -1603,6 +1545,7 @@ package Rtsfind is ...@@ -1603,6 +1545,7 @@ package Rtsfind is
RE_Complete_Task, -- System.Tasking.Stages RE_Complete_Task, -- System.Tasking.Stages
RE_Free_Task, -- System.Tasking.Stages RE_Free_Task, -- System.Tasking.Stages
RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages RE_Expunge_Unactivated_Tasks, -- System.Tasking.Stages
RE_Move_Activation_Chain, -- System_Tasking_Stages
RE_Terminated); -- System.Tasking.Stages RE_Terminated); -- System.Tasking.Stages
-- The following declarations build a table that is indexed by the -- The following declarations build a table that is indexed by the
...@@ -1613,7 +1556,6 @@ package Rtsfind is ...@@ -1613,7 +1556,6 @@ package Rtsfind is
RE_Null => RTU_Null, RE_Null => RTU_Null,
RE_Exceptions_Available_In_HIE => Ada_Exceptions,
RE_Code_Loc => Ada_Exceptions, RE_Code_Loc => Ada_Exceptions,
RE_Current_Target_Exception => Ada_Exceptions, -- of JGNAT RE_Current_Target_Exception => Ada_Exceptions, -- of JGNAT
RE_Exception_Id => Ada_Exceptions, RE_Exception_Id => Ada_Exceptions,
...@@ -1621,7 +1563,7 @@ package Rtsfind is ...@@ -1621,7 +1563,7 @@ package Rtsfind is
RE_Exception_Message => Ada_Exceptions, RE_Exception_Message => Ada_Exceptions,
RE_Exception_Name_Simple => Ada_Exceptions, RE_Exception_Name_Simple => Ada_Exceptions,
RE_Exception_Occurrence => Ada_Exceptions, RE_Exception_Occurrence => Ada_Exceptions,
RE_Null_Id => Ada_Exceptions, RE_Local_Raise => Ada_Exceptions,
RE_Null_Occurrence => Ada_Exceptions, RE_Null_Occurrence => Ada_Exceptions,
RE_Poll => Ada_Exceptions, RE_Poll => Ada_Exceptions,
RE_Raise_Exception => Ada_Exceptions, RE_Raise_Exception => Ada_Exceptions,
...@@ -1647,24 +1589,27 @@ package Rtsfind is ...@@ -1647,24 +1589,27 @@ package Rtsfind is
RE_Root_Stream_Type => Ada_Streams, RE_Root_Stream_Type => Ada_Streams,
RE_Stream_Element => Ada_Streams, RE_Stream_Element => Ada_Streams,
RE_Stream_Element_Count => Ada_Streams,
RE_Stream_Element_Offset => Ada_Streams,
RE_Stream_Element_Array => Ada_Streams,
RE_Stream_Access => Ada_Streams_Stream_IO, RE_Stream_Access => Ada_Streams_Stream_IO,
RE_Abstract_Interface => Ada_Tags, RE_Abstract_Interface => Ada_Tags,
RE_Access_Level => Ada_Tags,
RE_Addr_Ptr => Ada_Tags, RE_Addr_Ptr => Ada_Tags,
RE_Address_Array => Ada_Tags, RE_Base_Address => Ada_Tags,
RE_CW_Membership => Ada_Tags, RE_Cstring_Ptr => Ada_Tags,
RE_Default_Prim_Op_Count => Ada_Tags,
RE_Descendant_Tag => Ada_Tags, RE_Descendant_Tag => Ada_Tags,
RE_Dispatch_Table => Ada_Tags,
RE_Displace => Ada_Tags, RE_Displace => Ada_Tags,
RE_DT_Entry_Size => Ada_Tags, RE_DT_Entry_Size => Ada_Tags,
RE_DT_Min_Prologue_Size => Ada_Tags,
RE_DT_Prologue_Size => Ada_Tags, RE_DT_Prologue_Size => Ada_Tags,
RE_DT_Typeinfo_Ptr_Size => Ada_Tags,
RE_Expanded_Name => Ada_Tags,
RE_External_Tag => Ada_Tags, RE_External_Tag => Ada_Tags,
RO_TA_External_Tag => Ada_Tags,
RE_Get_Access_Level => Ada_Tags, RE_Get_Access_Level => Ada_Tags,
RE_Get_Entry_Index => Ada_Tags, RE_Get_Entry_Index => Ada_Tags,
RE_Get_External_Tag => Ada_Tags,
RE_Get_Offset_Index => Ada_Tags, RE_Get_Offset_Index => Ada_Tags,
RE_Get_Predefined_Prim_Op_Address => Ada_Tags, RE_Get_Predefined_Prim_Op_Address => Ada_Tags,
RE_Get_Prim_Op_Address => Ada_Tags, RE_Get_Prim_Op_Address => Ada_Tags,
...@@ -1672,16 +1617,17 @@ package Rtsfind is ...@@ -1672,16 +1617,17 @@ package Rtsfind is
RE_Get_RC_Offset => Ada_Tags, RE_Get_RC_Offset => Ada_Tags,
RE_Get_Remotely_Callable => Ada_Tags, RE_Get_Remotely_Callable => Ada_Tags,
RE_Get_Tagged_Kind => Ada_Tags, RE_Get_Tagged_Kind => Ada_Tags,
RE_Inherit_CPP_DT => Ada_Tags, RE_Idepth => Ada_Tags,
RE_Inherit_DT => Ada_Tags, RE_Ifaces_Table => Ada_Tags,
RE_Inherit_TSD => Ada_Tags, RE_Ifaces_Table_Ptr => Ada_Tags,
RE_Interface_Data => Ada_Tags, RE_Interface_Data => Ada_Tags,
RE_Interface_Data_Ptr => Ada_Tags,
RE_Interface_Tag => Ada_Tags, RE_Interface_Tag => Ada_Tags,
RE_Internal_Tag => Ada_Tags,
RE_Is_Descendant_At_Same_Level => Ada_Tags,
RE_IW_Membership => Ada_Tags, RE_IW_Membership => Ada_Tags,
RE_Nb_Ifaces => Ada_Tags,
RE_Object_Specific_Data => Ada_Tags, RE_Object_Specific_Data => Ada_Tags,
RE_Offset_To_Top => Ada_Tags, RE_Offset_To_Top => Ada_Tags,
RE_Type_Specific_Data => Ada_Tags,
RE_POK_Function => Ada_Tags, RE_POK_Function => Ada_Tags,
RE_POK_Procedure => Ada_Tags, RE_POK_Procedure => Ada_Tags,
RE_POK_Protected_Entry => Ada_Tags, RE_POK_Protected_Entry => Ada_Tags,
...@@ -1692,15 +1638,16 @@ package Rtsfind is ...@@ -1692,15 +1638,16 @@ package Rtsfind is
RE_POK_Task_Procedure => Ada_Tags, RE_POK_Task_Procedure => Ada_Tags,
RE_Prim_Op_Kind => Ada_Tags, RE_Prim_Op_Kind => Ada_Tags,
RE_Primary_DT => Ada_Tags, RE_Primary_DT => Ada_Tags,
RE_Prims_Ptr => Ada_Tags,
RE_Register_Interface_Tag => Ada_Tags, RE_Register_Interface_Tag => Ada_Tags,
RE_Register_Tag => Ada_Tags, RE_Register_Tag => Ada_Tags,
RE_Remotely_Callable => Ada_Tags,
RE_RC_Offset => Ada_Tags,
RE_Secondary_DT => Ada_Tags, RE_Secondary_DT => Ada_Tags,
RE_Select_Specific_Data => Ada_Tags, RE_Select_Specific_Data => Ada_Tags,
RE_Set_Access_Level => Ada_Tags, RE_Set_Access_Level => Ada_Tags,
RE_Set_Entry_Index => Ada_Tags, RE_Set_Entry_Index => Ada_Tags,
RE_Set_Expanded_Name => Ada_Tags, RE_Set_Expanded_Name => Ada_Tags,
RE_Set_External_Tag => Ada_Tags,
RE_Set_Interface_Table => Ada_Tags,
RE_Set_Num_Prim_Ops => Ada_Tags, RE_Set_Num_Prim_Ops => Ada_Tags,
RE_Set_Offset_Index => Ada_Tags, RE_Set_Offset_Index => Ada_Tags,
RE_Set_Offset_To_Top => Ada_Tags, RE_Set_Offset_To_Top => Ada_Tags,
...@@ -1716,16 +1663,16 @@ package Rtsfind is ...@@ -1716,16 +1663,16 @@ package Rtsfind is
RE_Set_TSD => Ada_Tags, RE_Set_TSD => Ada_Tags,
RE_Tag => Ada_Tags, RE_Tag => Ada_Tags,
RE_Tag_Error => Ada_Tags, RE_Tag_Error => Ada_Tags,
RE_Tag_Ptr => Ada_Tags,
RE_Tags_Table => Ada_Tags,
RE_Tagged_Kind => Ada_Tags, RE_Tagged_Kind => Ada_Tags,
RE_TSD_Entry_Size => Ada_Tags, RE_Type_Specific_Data_Ptr => Ada_Tags,
RE_TSD_Prologue_Size => Ada_Tags,
RE_TK_Abstract_Limited_Tagged => Ada_Tags, RE_TK_Abstract_Limited_Tagged => Ada_Tags,
RE_TK_Abstract_Tagged => Ada_Tags, RE_TK_Abstract_Tagged => Ada_Tags,
RE_TK_Limited_Tagged => Ada_Tags, RE_TK_Limited_Tagged => Ada_Tags,
RE_TK_Protected => Ada_Tags, RE_TK_Protected => Ada_Tags,
RE_TK_Tagged => Ada_Tags, RE_TK_Tagged => Ada_Tags,
RE_TK_Task => Ada_Tags, RE_TK_Task => Ada_Tags,
RE_Valid_Signature => Ada_Tags,
RE_Abort_Task => Ada_Task_Identification, RE_Abort_Task => Ada_Task_Identification,
RE_Current_Task => Ada_Task_Identification, RE_Current_Task => Ada_Task_Identification,
...@@ -1746,42 +1693,13 @@ package Rtsfind is ...@@ -1746,42 +1693,13 @@ package Rtsfind is
RE_Unsigned_32 => Interfaces, RE_Unsigned_32 => Interfaces,
RE_Unsigned_64 => Interfaces, RE_Unsigned_64 => Interfaces,
RE_Vtable_Ptr => Interfaces_CPP,
RE_Displaced_This => Interfaces_CPP,
RE_CPP_CW_Membership => Interfaces_CPP,
RE_CPP_DT_Entry_Size => Interfaces_CPP,
RE_CPP_DT_Prologue_Size => Interfaces_CPP,
RE_CPP_Get_External_Tag => Interfaces_CPP,
RE_CPP_Get_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Get_RC_Offset => Interfaces_CPP,
RE_CPP_Get_Remotely_Callable => Interfaces_CPP,
RE_CPP_Inherit_DT => Interfaces_CPP,
RE_CPP_Inherit_TSD => Interfaces_CPP,
RE_CPP_Register_Tag => Interfaces_CPP,
RE_CPP_Set_Expanded_Name => Interfaces_CPP,
RE_CPP_Set_External_Tag => Interfaces_CPP,
RE_CPP_Set_Prim_Op_Address => Interfaces_CPP,
RE_CPP_Set_RC_Offset => Interfaces_CPP,
RE_CPP_Set_Remotely_Callable => Interfaces_CPP,
RE_CPP_Set_TSD => Interfaces_CPP,
RE_CPP_TSD_Entry_Size => Interfaces_CPP,
RE_CPP_TSD_Prologue_Size => Interfaces_CPP,
RE_Packed_Size => Interfaces_Packed_Decimal,
RE_Packed_To_Int32 => Interfaces_Packed_Decimal,
RE_Packed_To_Int64 => Interfaces_Packed_Decimal,
RE_Int32_To_Packed => Interfaces_Packed_Decimal,
RE_Int64_To_Packed => Interfaces_Packed_Decimal,
RE_Address => System, RE_Address => System,
RE_Any_Priority => System, RE_Any_Priority => System,
RE_Bit_Order => System, RE_Bit_Order => System,
RE_Default_Priority => System,
RE_High_Order_First => System, RE_High_Order_First => System,
RE_Interrupt_Priority => System, RE_Interrupt_Priority => System,
RE_Lib_Stop => System, RE_Lib_Stop => System,
RE_Low_Order_First => System, RE_Low_Order_First => System,
RE_Max_Interrupt_Priority => System,
RE_Max_Priority => System, RE_Max_Priority => System,
RE_Null_Address => System, RE_Null_Address => System,
RE_Priority => System, RE_Priority => System,
...@@ -1818,7 +1736,6 @@ package Rtsfind is ...@@ -1818,7 +1736,6 @@ package Rtsfind is
RE_Checked_Pool => System_Checked_Pools, RE_Checked_Pool => System_Checked_Pools,
RE_Boolean_Array => System_Boolean_Array_Operations,
RE_Vector_Not => System_Boolean_Array_Operations, RE_Vector_Not => System_Boolean_Array_Operations,
RE_Vector_And => System_Boolean_Array_Operations, RE_Vector_And => System_Boolean_Array_Operations,
RE_Vector_Or => System_Boolean_Array_Operations, RE_Vector_Or => System_Boolean_Array_Operations,
...@@ -1846,6 +1763,8 @@ package Rtsfind is ...@@ -1846,6 +1763,8 @@ package Rtsfind is
RE_Compare_Array_U64 => System_Compare_Array_Unsigned_64, RE_Compare_Array_U64 => System_Compare_Array_Unsigned_64,
RE_Get_Active_Partition_Id => System_DSA_Services, RE_Get_Active_Partition_Id => System_DSA_Services,
RE_Get_Local_Partition_Id => System_DSA_Services,
RE_Get_Passive_Partition_Id => System_DSA_Services,
RE_Register_Exception => System_Exception_Table, RE_Register_Exception => System_Exception_Table,
...@@ -1889,18 +1808,14 @@ package Rtsfind is ...@@ -1889,18 +1808,14 @@ package Rtsfind is
RE_Fat_VAX_G => System_Fat_VAX_G_Float, RE_Fat_VAX_G => System_Fat_VAX_G_Float,
RE_Attach_To_Final_List => System_Finalization_Implementation, RE_Attach_To_Final_List => System_Finalization_Implementation,
RE_Finalizable_Ptr_Ptr => System_Finalization_Implementation,
RE_Move_Final_List => System_Finalization_Implementation,
RE_Finalize_List => System_Finalization_Implementation, RE_Finalize_List => System_Finalization_Implementation,
RE_Finalize_One => System_Finalization_Implementation, RE_Finalize_One => System_Finalization_Implementation,
RE_Global_Final_List => System_Finalization_Implementation, RE_Global_Final_List => System_Finalization_Implementation,
RE_Record_Controller => System_Finalization_Implementation, RE_Record_Controller => System_Finalization_Implementation,
RE_Limited_Record_Controller => System_Finalization_Implementation, RE_Limited_Record_Controller => System_Finalization_Implementation,
RE_Deep_Tag_Initialize => System_Finalization_Implementation,
RE_Deep_Tag_Adjust => System_Finalization_Implementation,
RE_Deep_Tag_Finalize => System_Finalization_Implementation,
RE_Deep_Tag_Attach => System_Finalization_Implementation, RE_Deep_Tag_Attach => System_Finalization_Implementation,
RE_Deep_Rec_Initialize => System_Finalization_Implementation,
RE_Deep_Rec_Adjust => System_Finalization_Implementation,
RE_Deep_Rec_Finalize => System_Finalization_Implementation,
RE_Root_Controlled => System_Finalization_Root, RE_Root_Controlled => System_Finalization_Root,
RE_Finalizable => System_Finalization_Root, RE_Finalizable => System_Finalization_Root,
...@@ -1948,9 +1863,6 @@ package Rtsfind is ...@@ -1948,9 +1863,6 @@ package Rtsfind is
RE_Mantissa_Value => System_Mantissa, RE_Mantissa_Value => System_Mantissa,
RE_memcpy => System_Memcop,
RE_memmove => System_Memcop,
RE_Bits_03 => System_Pack_03, RE_Bits_03 => System_Pack_03,
RE_Get_03 => System_Pack_03, RE_Get_03 => System_Pack_03,
RE_Set_03 => System_Pack_03, RE_Set_03 => System_Pack_03,
...@@ -2238,13 +2150,9 @@ package Rtsfind is ...@@ -2238,13 +2150,9 @@ package Rtsfind is
RE_Unspecified_Size => System_Parameters, RE_Unspecified_Size => System_Parameters,
RE_DSA_Implementation => System_Partition_Interface, RE_DSA_Implementation => System_Partition_Interface,
RE_Get_Passive_Partition_Id => System_Partition_Interface,
RE_Get_Local_Partition_Id => System_Partition_Interface,
RE_Get_RCI_Package_Receiver => System_Partition_Interface, RE_Get_RCI_Package_Receiver => System_Partition_Interface,
RE_Get_Unique_Remote_Pointer => System_Partition_Interface, RE_Get_Unique_Remote_Pointer => System_Partition_Interface,
RE_RACW_Stub_Type => System_Partition_Interface,
RE_RACW_Stub_Type_Access => System_Partition_Interface, RE_RACW_Stub_Type_Access => System_Partition_Interface,
RE_RAS_Proxy_Type => System_Partition_Interface,
RE_RAS_Proxy_Type_Access => System_Partition_Interface, RE_RAS_Proxy_Type_Access => System_Partition_Interface,
RE_Raise_Program_Error_Unknown_Tag => System_Partition_Interface, RE_Raise_Program_Error_Unknown_Tag => System_Partition_Interface,
RE_Register_Passive_Package => System_Partition_Interface, RE_Register_Passive_Package => System_Partition_Interface,
...@@ -2258,7 +2166,6 @@ package Rtsfind is ...@@ -2258,7 +2166,6 @@ package Rtsfind is
RE_Get_RAS_Info => System_Partition_Interface, RE_Get_RAS_Info => System_Partition_Interface,
RE_To_PolyORB_String => System_Partition_Interface, RE_To_PolyORB_String => System_Partition_Interface,
RE_To_Standard_String => System_Partition_Interface,
RE_Caseless_String_Eq => System_Partition_Interface, RE_Caseless_String_Eq => System_Partition_Interface,
RE_TypeCode => System_Partition_Interface, RE_TypeCode => System_Partition_Interface,
RE_Any => System_Partition_Interface, RE_Any => System_Partition_Interface,
...@@ -2275,6 +2182,7 @@ package Rtsfind is ...@@ -2275,6 +2182,7 @@ package Rtsfind is
RE_Content_Type => System_Partition_Interface, RE_Content_Type => System_Partition_Interface,
RE_Any_Member_Type => System_Partition_Interface, RE_Any_Member_Type => System_Partition_Interface,
RE_Get_Nested_Sequence_Length => System_Partition_Interface, RE_Get_Nested_Sequence_Length => System_Partition_Interface,
RE_Get_Any_Type => System_Partition_Interface,
RE_Extract_Union_Value => System_Partition_Interface, RE_Extract_Union_Value => System_Partition_Interface,
RE_NVList_Ref => System_Partition_Interface, RE_NVList_Ref => System_Partition_Interface,
RE_NVList_Create => System_Partition_Interface, RE_NVList_Create => System_Partition_Interface,
...@@ -2286,7 +2194,7 @@ package Rtsfind is ...@@ -2286,7 +2194,7 @@ package Rtsfind is
RE_Request_Raise_Occurrence => System_Partition_Interface, RE_Request_Raise_Occurrence => System_Partition_Interface,
RE_Nil_Exc_List => System_Partition_Interface, RE_Nil_Exc_List => System_Partition_Interface,
RE_Servant => System_Partition_Interface, RE_Servant => System_Partition_Interface,
RE_Copy_Any_Value => System_Partition_Interface, RE_Move_Any_Value => System_Partition_Interface,
RE_Set_Result => System_Partition_Interface, RE_Set_Result => System_Partition_Interface,
RE_Register_Obj_Receiving_Stub => System_Partition_Interface, RE_Register_Obj_Receiving_Stub => System_Partition_Interface,
RE_Register_Pkg_Receiving_Stub => System_Partition_Interface, RE_Register_Pkg_Receiving_Stub => System_Partition_Interface,
...@@ -2298,7 +2206,6 @@ package Rtsfind is ...@@ -2298,7 +2206,6 @@ package Rtsfind is
RE_Make_Ref => System_Partition_Interface, RE_Make_Ref => System_Partition_Interface,
RE_Get_Local_Address => System_Partition_Interface, RE_Get_Local_Address => System_Partition_Interface,
RE_Get_Reference => System_Partition_Interface, RE_Get_Reference => System_Partition_Interface,
RE_Local_Oid_To_Address => System_Partition_Interface,
RE_Asynchronous_P_To_Sync_Scope => System_Partition_Interface, RE_Asynchronous_P_To_Sync_Scope => System_Partition_Interface,
RE_Buffer_Stream_Type => System_Partition_Interface, RE_Buffer_Stream_Type => System_Partition_Interface,
RE_Allocate_Buffer => System_Partition_Interface, RE_Allocate_Buffer => System_Partition_Interface,
...@@ -2306,8 +2213,6 @@ package Rtsfind is ...@@ -2306,8 +2213,6 @@ package Rtsfind is
RE_BS_To_Any => System_Partition_Interface, RE_BS_To_Any => System_Partition_Interface,
RE_Any_To_BS => System_Partition_Interface, RE_Any_To_BS => System_Partition_Interface,
RE_FA_AD => System_Partition_Interface,
RE_FA_AS => System_Partition_Interface,
RE_FA_B => System_Partition_Interface, RE_FA_B => System_Partition_Interface,
RE_FA_C => System_Partition_Interface, RE_FA_C => System_Partition_Interface,
RE_FA_F => System_Partition_Interface, RE_FA_F => System_Partition_Interface,
...@@ -2329,8 +2234,7 @@ package Rtsfind is ...@@ -2329,8 +2234,7 @@ package Rtsfind is
RE_FA_String => System_Partition_Interface, RE_FA_String => System_Partition_Interface,
RE_FA_ObjRef => System_Partition_Interface, RE_FA_ObjRef => System_Partition_Interface,
RE_TA_AD => System_Partition_Interface, RE_TA_A => System_Partition_Interface,
RE_TA_AS => System_Partition_Interface,
RE_TA_B => System_Partition_Interface, RE_TA_B => System_Partition_Interface,
RE_TA_C => System_Partition_Interface, RE_TA_C => System_Partition_Interface,
RE_TA_F => System_Partition_Interface, RE_TA_F => System_Partition_Interface,
...@@ -2358,8 +2262,6 @@ package Rtsfind is ...@@ -2358,8 +2262,6 @@ package Rtsfind is
RE_Get_TC => System_Partition_Interface, RE_Get_TC => System_Partition_Interface,
RE_Set_TC => System_Partition_Interface, RE_Set_TC => System_Partition_Interface,
RE_TC_Any => System_Partition_Interface, RE_TC_Any => System_Partition_Interface,
RE_TC_AD => System_Partition_Interface,
RE_TC_AS => System_Partition_Interface,
RE_TC_B => System_Partition_Interface, RE_TC_B => System_Partition_Interface,
RE_TC_C => System_Partition_Interface, RE_TC_C => System_Partition_Interface,
RE_TC_F => System_Partition_Interface, RE_TC_F => System_Partition_Interface,
...@@ -2433,16 +2335,12 @@ package Rtsfind is ...@@ -2433,16 +2335,12 @@ package Rtsfind is
RE_Integer_Address => System_Storage_Elements, RE_Integer_Address => System_Storage_Elements,
RE_Storage_Offset => System_Storage_Elements, RE_Storage_Offset => System_Storage_Elements,
RE_Storage_Array => System_Storage_Elements, RE_Storage_Array => System_Storage_Elements,
RE_Storage_Element => System_Storage_Elements,
RE_To_Address => System_Storage_Elements, RE_To_Address => System_Storage_Elements,
RE_Root_Storage_Pool => System_Storage_Pools, RE_Root_Storage_Pool => System_Storage_Pools,
RE_Allocate_Any => System_Storage_Pools, RE_Allocate_Any => System_Storage_Pools,
RE_Deallocate_Any => System_Storage_Pools, RE_Deallocate_Any => System_Storage_Pools,
RE_Thin_Pointer => System_Stream_Attributes,
RE_Fat_Pointer => System_Stream_Attributes,
RE_I_AD => System_Stream_Attributes, RE_I_AD => System_Stream_Attributes,
RE_I_AS => System_Stream_Attributes, RE_I_AS => System_Stream_Attributes,
RE_I_B => System_Stream_Attributes, RE_I_B => System_Stream_Attributes,
...@@ -2484,7 +2382,6 @@ package Rtsfind is ...@@ -2484,7 +2382,6 @@ package Rtsfind is
RE_W_U => System_Stream_Attributes, RE_W_U => System_Stream_Attributes,
RE_W_WC => System_Stream_Attributes, RE_W_WC => System_Stream_Attributes,
RE_W_WWC => System_Stream_Attributes, RE_W_WWC => System_Stream_Attributes,
RE_Block_Stream_Ops_OK => System_Stream_Attributes,
RE_Str_Concat => System_String_Ops, RE_Str_Concat => System_String_Ops,
RE_Str_Concat_CC => System_String_Ops, RE_Str_Concat_CC => System_String_Ops,
...@@ -2500,8 +2397,6 @@ package Rtsfind is ...@@ -2500,8 +2397,6 @@ package Rtsfind is
RE_Task_Info_Type => System_Task_Info, RE_Task_Info_Type => System_Task_Info,
RE_Unspecified_Task_Info => System_Task_Info, RE_Unspecified_Task_Info => System_Task_Info,
RE_Library_Task_Level => System_Tasking,
RE_Task_Procedure_Access => System_Tasking, RE_Task_Procedure_Access => System_Tasking,
RO_ST_Task_Id => System_Tasking, RO_ST_Task_Id => System_Tasking,
...@@ -2511,22 +2406,15 @@ package Rtsfind is ...@@ -2511,22 +2406,15 @@ package Rtsfind is
RE_Simple_Call => System_Tasking, RE_Simple_Call => System_Tasking,
RE_Conditional_Call => System_Tasking, RE_Conditional_Call => System_Tasking,
RE_Asynchronous_Call => System_Tasking, RE_Asynchronous_Call => System_Tasking,
RE_Timed_Call => System_Tasking,
RE_Ada_Task_Control_Block => System_Tasking, RE_Ada_Task_Control_Block => System_Tasking,
RE_Task_List => System_Tasking, RE_Task_List => System_Tasking,
RE_Accept_Alternative => System_Tasking,
RE_Accept_List => System_Tasking, RE_Accept_List => System_Tasking,
RE_Accept_List_Access => System_Tasking,
RE_Max_Select => System_Tasking,
RE_Max_Task_Entry => System_Tasking,
RE_No_Rendezvous => System_Tasking, RE_No_Rendezvous => System_Tasking,
RE_Null_Task_Entry => System_Tasking, RE_Null_Task_Entry => System_Tasking,
RE_Positive_Select_Index => System_Tasking,
RE_Select_Index => System_Tasking, RE_Select_Index => System_Tasking,
RE_Select_Modes => System_Tasking,
RE_Else_Mode => System_Tasking, RE_Else_Mode => System_Tasking,
RE_Simple_Mode => System_Tasking, RE_Simple_Mode => System_Tasking,
RE_Terminate_Mode => System_Tasking, RE_Terminate_Mode => System_Tasking,
...@@ -2538,6 +2426,7 @@ package Rtsfind is ...@@ -2538,6 +2426,7 @@ package Rtsfind is
RE_Unspecified_Priority => System_Tasking, RE_Unspecified_Priority => System_Tasking,
RE_Activation_Chain => System_Tasking, RE_Activation_Chain => System_Tasking,
RE_Activation_Chain_Access => System_Tasking,
RE_Storage_Size => System_Tasking, RE_Storage_Size => System_Tasking,
RE_Abort_Defer => System_Soft_Links, RE_Abort_Defer => System_Soft_Links,
...@@ -2691,8 +2580,6 @@ package Rtsfind is ...@@ -2691,8 +2580,6 @@ package Rtsfind is
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Lock_Entries => RE_Lock_Entries =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Lock_Read_Only_Entries =>
System_Tasking_Protected_Objects_Entries,
RO_PE_Get_Ceiling => RO_PE_Get_Ceiling =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RO_PE_Set_Ceiling => RO_PE_Set_Ceiling =>
...@@ -2732,8 +2619,6 @@ package Rtsfind is ...@@ -2732,8 +2619,6 @@ package Rtsfind is
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Lock_Entry => RE_Lock_Entry =>
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Lock_Read_Only_Entry =>
System_Tasking_Protected_Objects_Single_Entry,
RE_Unlock_Entry => RE_Unlock_Entry =>
System_Tasking_Protected_Objects_Single_Entry, System_Tasking_Protected_Objects_Single_Entry,
RE_Protected_Single_Entry_Call => RE_Protected_Single_Entry_Call =>
...@@ -2757,7 +2642,6 @@ package Rtsfind is ...@@ -2757,7 +2642,6 @@ package Rtsfind is
RE_Initialize_Protection => System_Tasking_Protected_Objects, RE_Initialize_Protection => System_Tasking_Protected_Objects,
RE_Finalize_Protection => System_Tasking_Protected_Objects, RE_Finalize_Protection => System_Tasking_Protected_Objects,
RE_Lock => System_Tasking_Protected_Objects, RE_Lock => System_Tasking_Protected_Objects,
RE_Lock_Read_Only => System_Tasking_Protected_Objects,
RE_Get_Ceiling => System_Tasking_Protected_Objects, RE_Get_Ceiling => System_Tasking_Protected_Objects,
RE_Set_Ceiling => System_Tasking_Protected_Objects, RE_Set_Ceiling => System_Tasking_Protected_Objects,
RE_Unlock => System_Tasking_Protected_Objects, RE_Unlock => System_Tasking_Protected_Objects,
...@@ -2801,6 +2685,7 @@ package Rtsfind is ...@@ -2801,6 +2685,7 @@ package Rtsfind is
RE_Complete_Task => System_Tasking_Stages, RE_Complete_Task => System_Tasking_Stages,
RE_Free_Task => System_Tasking_Stages, RE_Free_Task => System_Tasking_Stages,
RE_Expunge_Unactivated_Tasks => System_Tasking_Stages, RE_Expunge_Unactivated_Tasks => System_Tasking_Stages,
RE_Move_Activation_Chain => System_Tasking_Stages,
RE_Terminated => System_Tasking_Stages); RE_Terminated => System_Tasking_Stages);
-------------------------------- --------------------------------
...@@ -2864,27 +2749,51 @@ package Rtsfind is ...@@ -2864,27 +2749,51 @@ package Rtsfind is
-- Subprograms -- -- Subprograms --
----------------- -----------------
RE_Not_Available : exception;
-- Raised by RTE if the requested entity is not available. This can
-- occur either because the file in which the entity should be found
-- does not exist, or because the entity is not present in the file.
procedure Initialize; procedure Initialize;
-- Procedure to initialize data structures used by RTE. Called at the -- Procedure to initialize data structures used by RTE. Called at the
-- start of processing a new main source file. Must be called after -- start of processing a new main source file. Must be called after
-- Initialize_Snames (since names it enters into name table must come -- Initialize_Snames (since names it enters into name table must come
-- after names entered by Snames). -- after names entered by Snames).
RE_Not_Available : exception; function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean;
-- Raised by RTE if the requested entity is not available. This can -- This function determines if the given entity corresponds to the entity
-- occur either because the file in which the entity should be found -- referenced by RE_Id. It is similar in effect to (Ent = RTE (E)) except
-- does not exist, or because the entity is not present in the file. -- that the latter would unconditionally load the unit containing E. For
-- this call, if the unit is not loaded, then a result of False is returned
-- immediately, since obviously Ent cannot be the entity in question if the
-- corresponding unit has not been loaded.
function Is_RTU (Ent : Entity_Id; U : RTU_Id) return Boolean;
pragma Inline (Is_RTU);
-- This function determines if the given entity corresponds to the entity
-- for the unit referenced by U. If this unit has not been loaded, the
-- answer will always be False. If the unit has been loaded, then the
-- entity id values are compared and True is returned if Ent is the
-- entity for this unit.
function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean;
-- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada,
-- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or
-- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
-- that is specially handled as described above for Text_IO_Kludge.
function RTE (E : RE_Id) return Entity_Id; function RTE (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the -- Given the entity defined in the above tables, as identified by the
-- corresponding value in the RE_Id enumeration type, returns the Id -- corresponding value in the RE_Id enumeration type, returns the Id of the
-- of the corresponding entity, first loading in (parsing, analyzing and -- corresponding entity, first loading in (parsing, analyzing and
-- expanding) its spec if the unit has not already been loaded. -- expanding) its spec if the unit has not already been loaded. For
-- efficiency reasons, this routine restricts the search to the package
-- entity chain.
-- --
-- Note: In the case of a package, RTE can return either an entity that -- Note: In the case of a package, RTE can return either an entity that is
-- is declared at the top level of the package, or the package entity -- declared at the top level of the package, or the package entity itself.
-- itself. If an entity within the package has the same simple name as -- If an entity within the package has the same simple name as the package,
-- the package, then the entity within the package is returned. -- then the entity within the package is returned.
-- --
-- If RTE returns, the returned value is the required entity -- If RTE returns, the returned value is the required entity
-- --
...@@ -2898,27 +2807,46 @@ package Rtsfind is ...@@ -2898,27 +2807,46 @@ package Rtsfind is
-- RE_Not_Available, which should terminate the expansion of the current -- RE_Not_Available, which should terminate the expansion of the current
-- construct. -- construct.
function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean;
-- This function determines if the given entity corresponds to the entity
-- referenced by RE_Id. It is similar in effect to (Ent = RTE (E)) except
-- that the latter would unconditionally load the unit containing E. For
-- this call, if the unit is not loaded, then a result of False is returned
-- immediately, since obviously Ent cannot be the entity in question if the
-- corresponding unit has not been loaded.
function Is_RTU (Ent : Entity_Id; U : RTU_Id) return Boolean;
pragma Inline (Is_RTU);
-- This function determines if the given entity corresponds to the entity
-- for the unit referenced by U. If this unit has not been loaded, the
-- answer will always be False. If the unit has been loaded, then the
-- entity id values are compared and True is returned if Ent is the
-- entity for this unit.
function RTE_Available (E : RE_Id) return Boolean; function RTE_Available (E : RE_Id) return Boolean;
-- Returns true if a call to RTE will succeed without raising an -- Returns true if a call to RTE will succeed without raising an
-- exception and without generating an error message, i.e. if the -- exception and without generating an error message, i.e. if the
-- call will obtain the desired entity without any problems. -- call will obtain the desired entity without any problems.
function RTE_Record_Component (E : RE_Id) return Entity_Id;
-- Given the entity defined in the above tables, as identified by the
-- corresponding value in the RE_Id enumeration type, returns the Id of
-- the corresponding entity, first loading in (parsing, analyzing and
-- expanding) its spec if the unit has not already been loaded. For
-- efficiency reasons, this routine restricts the search of E to fields
-- of record type declarations found in the package entity chain.
--
-- Note: In the case of a package, RTE can return either an entity that is
-- declared at the top level of the package, or the package entity itself.
-- If an entity within the package has the same simple name as the package,
-- then the entity within the package is returned.
--
-- If RTE returns, the returned value is the required entity
--
-- If the entity is not available, then an error message is given. The
-- form of the message depends on whether we are in configurable run time
-- mode or not. In configurable run time mode, a missing entity is not
-- that surprising and merely says that the particular construct is not
-- supported by the run-time in use. If we are not in configurable run
-- time mode, a missing entity is some kind of run-time configuration
-- error. In either case, the result of the call is to raise the exception
-- RE_Not_Available, which should terminate the expansion of the current
-- construct.
function RTE_Record_Component_Available (E : RE_Id) return Boolean;
-- Returns true if a call to RTE_Record_Component will succeed without
-- raising an exception and without generating an error message, i.e.
-- if the call will obtain the desired entity without any problems.
function RTU_Entity (U : RTU_Id) return Entity_Id;
pragma Inline (RTU_Entity);
-- This function returns the entity for the unit referenced by U. If
-- this unit has not been loaded, it returns Empty.
function RTU_Loaded (U : RTU_Id) return Boolean; function RTU_Loaded (U : RTU_Id) return Boolean;
pragma Inline (RTU_Loaded); pragma Inline (RTU_Loaded);
-- Returns true if indicated unit has already been successfully loaded. -- Returns true if indicated unit has already been successfully loaded.
...@@ -2942,10 +2870,4 @@ package Rtsfind is ...@@ -2942,10 +2870,4 @@ package Rtsfind is
-- is not necessary, but that doesn't matter. Wide_[Wide_]Text_IO is -- is not necessary, but that doesn't matter. Wide_[Wide_]Text_IO is
-- handled in a similar manner. -- handled in a similar manner.
function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean;
-- Returns True if the given Nam is an Expanded Name, whose Prefix is Ada,
-- and whose selector is either Text_IO.xxx or Wide_Text_IO.xxx or
-- Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
-- that is specially handled as described above for Text_IO_Kludge.
end Rtsfind; end Rtsfind;
...@@ -78,9 +78,8 @@ package body System.Interrupt_Management is ...@@ -78,9 +78,8 @@ package body System.Interrupt_Management is
function State (Int : Interrupt_ID) return Character; function State (Int : Interrupt_ID) return Character;
pragma Import (C, State, "__gnat_get_interrupt_state"); pragma Import (C, State, "__gnat_get_interrupt_state");
-- Get interrupt state. Defined in init.c -- Get interrupt state. Defined in init.c The input argument is the
-- The input argument is the interrupt number, -- interrupt number, and the result is one of the following:
-- and the result is one of the following:
User : constant Character := 'u'; User : constant Character := 'u';
Runtime : constant Character := 'r'; Runtime : constant Character := 'r';
...@@ -95,10 +94,10 @@ package body System.Interrupt_Management is ...@@ -95,10 +94,10 @@ package body System.Interrupt_Management is
(signo : Signal; (signo : Signal;
siginfo : System.Address; siginfo : System.Address;
ucontext : System.Address); ucontext : System.Address);
-- This function identifies the Ada exception to be raised using -- This function identifies the Ada exception to be raised using the
-- the information when the system received a synchronous signal. -- information when the system received a synchronous signal. Since this
-- Since this function is machine and OS dependent, different code -- function is machine and OS dependent, different code has to be provided
-- has to be provided for different target. -- for different target.
---------------------- ----------------------
-- Notify_Exception -- -- Notify_Exception --
...@@ -114,10 +113,10 @@ package body System.Interrupt_Management is ...@@ -114,10 +113,10 @@ package body System.Interrupt_Management is
is is
pragma Unreferenced (siginfo); pragma Unreferenced (siginfo);
-- The GCC unwinder requires adjustments to the signal's machine -- The GCC unwinder requires adjustments to the signal's machine context
-- context to be able to properly unwind through the signal handler. -- to be able to properly unwind through the signal handler. This is
-- This is achieved by the target specific subprogram below, provided -- achieved by the target specific subprogram below, provided by init.c
-- by init.c to be usable by the non-tasking handler also. -- to be usable by the non-tasking handler also.
procedure Adjust_Context_For_Raise procedure Adjust_Context_For_Raise
(signo : Signal; (signo : Signal;
...@@ -125,7 +124,7 @@ package body System.Interrupt_Management is ...@@ -125,7 +124,7 @@ package body System.Interrupt_Management is
pragma Import pragma Import
(C, Adjust_Context_For_Raise, "__gnat_adjust_context_for_raise"); (C, Adjust_Context_For_Raise, "__gnat_adjust_context_for_raise");
Result : Interfaces.C.int; Result : Interfaces.C.int;
begin begin
-- With the __builtin_longjmp, the signal mask is not restored, so we -- With the __builtin_longjmp, the signal mask is not restored, so we
...@@ -139,9 +138,8 @@ package body System.Interrupt_Management is ...@@ -139,9 +138,8 @@ package body System.Interrupt_Management is
Adjust_Context_For_Raise (signo, ucontext); Adjust_Context_For_Raise (signo, ucontext);
-- Check that treatment of exception propagation here -- Check that treatment of exception propagation here is consistent with
-- is consistent with treatment of the abort signal in -- treatment of the abort signal in System.Task_Primitives.Operations.
-- System.Task_Primitives.Operations.
case signo is case signo is
when SIGFPE => when SIGFPE =>
...@@ -199,18 +197,19 @@ package body System.Interrupt_Management is ...@@ -199,18 +197,19 @@ package body System.Interrupt_Management is
-- handler execution we do not change the Signal_Mask to be masked for -- handler execution we do not change the Signal_Mask to be masked for
-- the Signal. -- the Signal.
-- This is a temporary fix to the problem that the Signal_Mask is -- This is a temporary fix to the problem that the Signal_Mask is not
-- not restored after the exception (longjmp) from the handler. -- restored after the exception (longjmp) from the handler. The right
-- The right fix should be made in sigsetjmp so that we save -- fix should be made in sigsetjmp so that we save the Signal_Set and
-- the Signal_Set and restore it after a longjmp. -- restore it after a longjmp.
-- Since SA_NODEFER is obsolete, instead we reset explicitely -- Since SA_NODEFER is obsolete, instead we reset explicitely the mask
-- the mask in the exception handler. -- in the exception handler.
Result := sigemptyset (Signal_Mask'Access); Result := sigemptyset (Signal_Mask'Access);
pragma Assert (Result = 0); pragma Assert (Result = 0);
-- Add signals that map to Ada exceptions to the mask. -- Add signals that map to Ada exceptions to the mask
for J in Exception_Interrupts'Range loop for J in Exception_Interrupts'Range loop
if State (Exception_Interrupts (J)) /= Default then if State (Exception_Interrupts (J)) /= Default then
Result := Result :=
...@@ -225,6 +224,7 @@ package body System.Interrupt_Management is ...@@ -225,6 +224,7 @@ package body System.Interrupt_Management is
pragma Assert (Reserve = (Interrupt_ID'Range => False)); pragma Assert (Reserve = (Interrupt_ID'Range => False));
-- Process state of exception signals -- Process state of exception signals
for J in Exception_Interrupts'Range loop for J in Exception_Interrupts'Range loop
if State (Exception_Interrupts (J)) /= User then if State (Exception_Interrupts (J)) /= User then
Keep_Unmasked (Exception_Interrupts (J)) := True; Keep_Unmasked (Exception_Interrupts (J)) := True;
...@@ -245,16 +245,16 @@ package body System.Interrupt_Management is ...@@ -245,16 +245,16 @@ package body System.Interrupt_Management is
Reserve (Abort_Task_Interrupt) := True; Reserve (Abort_Task_Interrupt) := True;
end if; end if;
-- Set SIGINT to unmasked state as long as it is not in "User" -- Set SIGINT to unmasked state as long as it is not in "User" state.
-- state. Check for Unreserve_All_Interrupts last -- Check for Unreserve_All_Interrupts last
if State (SIGINT) /= User then if State (SIGINT) /= User then
Keep_Unmasked (SIGINT) := True; Keep_Unmasked (SIGINT) := True;
Reserve (SIGINT) := True; Reserve (SIGINT) := True;
end if; end if;
-- Check all signals for state that requires keeping them -- Check all signals for state that requires keeping them unmasked and
-- unmasked and reserved -- reserved
for J in Interrupt_ID'Range loop for J in Interrupt_ID'Range loop
if State (J) = Default or else State (J) = Runtime then if State (J) = Default or else State (J) = Runtime then
...@@ -276,18 +276,17 @@ package body System.Interrupt_Management is ...@@ -276,18 +276,17 @@ package body System.Interrupt_Management is
Reserve (Interrupt_ID (Reserved (J))) := True; Reserve (Interrupt_ID (Reserved (J))) := True;
end loop; end loop;
-- Process pragma Unreserve_All_Interrupts. This overrides any -- Process pragma Unreserve_All_Interrupts. This overrides any settings
-- settings due to pragma Interrupt_State: -- due to pragma Interrupt_State:
if Unreserve_All_Interrupts /= 0 then if Unreserve_All_Interrupts /= 0 then
Keep_Unmasked (SIGINT) := False; Keep_Unmasked (SIGINT) := False;
Reserve (SIGINT) := False; Reserve (SIGINT) := False;
end if; end if;
-- We do not have Signal 0 in reality. We just use this value -- We do not really have Signal 0. We just use this value to identify
-- to identify non-existent signals (see s-intnam.ads). Therefore, -- non-existent signals (see s-intnam.ads). Therefore, Signal should not
-- Signal 0 should not be used in all signal related operations hence -- be used in all signal related operations hence mark it as reserved.
-- mark it as reserved.
Reserve (0) := True; Reserve (0) := True;
end Initialize; end Initialize;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2006 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* Body * * Body *
* * * *
* Copyright (C) 1992-2004 Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 2000-2005, AdaCore * * Copyright (C) 2000-2006, AdaCore *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment