Skip to content

R
riscv-gcc-1
Commit 0712790c by Ed Schonberg Committed by Arnaud Charlet
Options

exp_util.ads, [...] (Expand_Subtype_From_Expr): In Ada2005... 

2007-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_util.ads, exp_util.adb (Expand_Subtype_From_Expr): In Ada2005, an
	object of a limited type can be initialized with a call to a function
	that returns in place. If the limited type has unknown discriminants,
	and the underlying type is a constrained composite type, build an actual
	subtype from the function call, as is done for private types.
	(Side_Effect_Free): An expression that is the renaming of an object or
	whose prefix is the renaming of a object, is not side-effect free
	because it may be assigned through the renaming and its value must be
	captured in a temporary.
	(Has_Controlled_Coextensions): New routine.
	(Expand_Subtype_From_Expr): Do nothing if type is a limited interface,
	as is done for other limited types.
	(Non_Limited_Designated_Type): new predicate.
	(Make_CW_Equivalent_Type): Modified to handle class-wide interface
	objects.
	Remove all handling of with_type clauses.

        * par-ch10.adb: Remove all handling of with_type clauses.

	* lib-load.ads, lib-load.adb (Load_Main_Source): Do not get the
	checksum if the main source could not be parsed.
	(Loat_Unit): When processing a child unit, determine properly whether
	the parent unit is a renaming when the parent is itself a child unit.
	Remove handling of with_type clauses.

	* sinfo.ads, sinfo.adb (Is_Static_Coextension): New function.
	(Set_Is_Static_Coextension): New procedure.
	(Has_Local_Raise): New function
	(Set_Has_Local_Raise): New procedure
	(Renaming_Exception): New field
	(Has_Init_Expression): New flag
	(Delay_Finalize_Attach): Remove because flag is obsolete.
	(Set_Delay_Finalize_Attach): Remove because flag is obsolete.
	Remove all handling of with_type clauses.
	(Exception_Junk): Can now be set in N_Block_Statement

From-SVN: r125410
parent 2ed216d0
Showing with 490 additions and 157 deletions
gcc/ada/exp_util.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, 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,11 +32,9 @@ with Elists; use Elists; ...@@ -32,11 +32,9 @@ with Elists; use Elists;
with Errout; use Errout; with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr; with Exp_Aggr; use Exp_Aggr;
with Exp_Ch7; use Exp_Ch7; with Exp_Ch7; use Exp_Ch7;
with Hostparm; use Hostparm;
with Inline; use Inline; with Inline; use Inline;
with Itypes; use Itypes; with Itypes; use Itypes;
with Lib; use Lib; with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
...@@ -653,7 +651,7 @@ package body Exp_Util is ...@@ -653,7 +651,7 @@ package body Exp_Util is
Expr := Make_Function_Call (Loc, Expr := Make_Function_Call (Loc,
Name => New_Occurrence_Of (Defining_Entity (Fun), Loc)); Name => New_Occurrence_Of (Defining_Entity (Fun), Loc));
if not In_Init_Proc then if not In_Init_Proc and then VM_Target = No_VM then
Set_Uses_Sec_Stack (Defining_Entity (Fun)); Set_Uses_Sec_Stack (Defining_Entity (Fun));
end if; end if;
end if; end if;
...@@ -1289,11 +1287,35 @@ package body Exp_Util is ...@@ -1289,11 +1287,35 @@ package body Exp_Util is
then then
null; null;
-- Nothing to be done if the type of the expression is limited, because -- In Ada95, Nothing to be done if the type of the expression is
-- in this case the expression cannot be copied, and its use can only -- limited, because in this case the expression cannot be copied,
-- be by reference and there is no need for the actual subtype. -- and its use can only be by reference.
elsif Is_Limited_Type (Exp_Typ) then -- In Ada2005, the context can be an object declaration whose expression
-- is a function that returns in place. If the nominal subtype has
-- unknown discriminants, the call still provides constraints on the
-- object, and we have to create an actual subtype from it.
-- If the type is class-wide, the expression is dynamically tagged and
-- we do not create an actual subtype either. Ditto for an interface.
elsif Is_Limited_Type (Exp_Typ)
and then
(Is_Class_Wide_Type (Exp_Typ)
or else Is_Interface (Exp_Typ)
or else not Has_Unknown_Discriminants (Exp_Typ)
or else not Is_Composite_Type (Unc_Type))
then
null;
-- For limited interfaces, nothing to be done
-- This branch may be redundant once the limited interface issue is
-- sorted out???
elsif Is_Interface (Exp_Typ)
and then Is_Limited_Interface (Exp_Typ)
then
null; null;
else else
...@@ -2106,6 +2128,44 @@ package body Exp_Util is ...@@ -2106,6 +2128,44 @@ package body Exp_Util is
end; end;
end Get_Current_Value_Condition; end Get_Current_Value_Condition;
---------------------------------
-- Has_Controlled_Coextensions --
---------------------------------
function Has_Controlled_Coextensions (Typ : Entity_Id) return Boolean is
D_Typ : Entity_Id;
Discr : Entity_Id;
begin
-- Only consider record types
if Ekind (Typ) /= E_Record_Type
and then Ekind (Typ) /= E_Record_Subtype
then
return False;
end if;
if Has_Discriminants (Typ) then
Discr := First_Discriminant (Typ);
while Present (Discr) loop
D_Typ := Etype (Discr);
if Ekind (D_Typ) = E_Anonymous_Access_Type
and then
(Is_Controlled (Directly_Designated_Type (D_Typ))
or else
Is_Concurrent_Type (Directly_Designated_Type (D_Typ)))
then
return True;
end if;
Next_Discriminant (Discr);
end loop;
end if;
return False;
end Has_Controlled_Coextensions;
-------------------- --------------------
-- Homonym_Number -- -- Homonym_Number --
-------------------- --------------------
...@@ -2725,8 +2785,7 @@ package body Exp_Util is ...@@ -2725,8 +2785,7 @@ package body Exp_Util is
N_Variant | N_Variant |
N_Variant_Part | N_Variant_Part |
N_Validate_Unchecked_Conversion | N_Validate_Unchecked_Conversion |
N_With_Clause | N_With_Clause
N_With_Type_Clause
=> =>
null; null;
...@@ -2755,13 +2814,14 @@ package body Exp_Util is ...@@ -2755,13 +2814,14 @@ package body Exp_Util is
P := Parent (N); P := Parent (N);
end if; end if;
end loop; end loop;
end Insert_Actions; end Insert_Actions;
-- Version with check(s) suppressed -- Version with check(s) suppressed
procedure Insert_Actions procedure Insert_Actions
(Assoc_Node : Node_Id; Ins_Actions : List_Id; Suppress : Check_Id) (Assoc_Node : Node_Id;
Ins_Actions : List_Id;
Suppress : Check_Id)
is is
begin begin
if Suppress = All_Checks then if Suppress = All_Checks then
...@@ -2810,7 +2870,8 @@ package body Exp_Util is ...@@ -2810,7 +2870,8 @@ package body Exp_Util is
Aux : constant Node_Id := Aux_Decls_Node (Cunit (Main_Unit)); Aux : constant Node_Id := Aux_Decls_Node (Cunit (Main_Unit));
begin begin
New_Scope (Cunit_Entity (Main_Unit)); Push_Scope (Cunit_Entity (Main_Unit));
-- ??? should this be Current_Sem_Unit instead of Main_Unit?
if No (Actions (Aux)) then if No (Actions (Aux)) then
Set_Actions (Aux, New_List (N)); Set_Actions (Aux, New_List (N));
...@@ -2831,7 +2892,8 @@ package body Exp_Util is ...@@ -2831,7 +2892,8 @@ package body Exp_Util is
begin begin
if Is_Non_Empty_List (L) then if Is_Non_Empty_List (L) then
New_Scope (Cunit_Entity (Main_Unit)); Push_Scope (Cunit_Entity (Main_Unit));
-- ??? should this be Current_Sem_Unit instead of Main_Unit?
if No (Actions (Aux)) then if No (Actions (Aux)) then
Set_Actions (Aux, L); Set_Actions (Aux, L);
...@@ -3078,14 +3140,7 @@ package body Exp_Util is ...@@ -3078,14 +3140,7 @@ package body Exp_Util is
function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is
begin begin
-- ??? GCC3 will eventually handle strings with arbitrary alignments, -- Go to renamed object
-- but for now the following check must be disabled.
-- if get_gcc_version >= 3 then
-- return False;
-- end if;
-- For renaming case, go to renamed object
if Is_Entity_Name (N) if Is_Entity_Name (N)
and then Is_Object (Entity (N)) and then Is_Object (Entity (N))
...@@ -3589,6 +3644,7 @@ package body Exp_Util is ...@@ -3589,6 +3644,7 @@ package body Exp_Util is
Loc : constant Source_Ptr := Sloc (E); Loc : constant Source_Ptr := Sloc (E);
Root_Typ : constant Entity_Id := Root_Type (T); Root_Typ : constant Entity_Id := Root_Type (T);
List_Def : constant List_Id := Empty_List; List_Def : constant List_Id := Empty_List;
Comp_List : constant List_Id := New_List;
Equiv_Type : Entity_Id; Equiv_Type : Entity_Id;
Range_Type : Entity_Id; Range_Type : Entity_Id;
Str_Type : Entity_Id; Str_Type : Entity_Id;
...@@ -3611,11 +3667,14 @@ package body Exp_Util is ...@@ -3611,11 +3667,14 @@ package body Exp_Util is
Make_Subtype_From_Expr (E, Root_Typ))); Make_Subtype_From_Expr (E, Root_Typ)));
end if; end if;
-- subtype rg__xx is Storage_Offset range -- Generate the range subtype declaration
-- (Expr'size - typ'size) / Storage_Unit
Range_Type := Make_Defining_Identifier (Loc, New_Internal_Name ('G')); Range_Type := Make_Defining_Identifier (Loc, New_Internal_Name ('G'));
if not Is_Interface (Root_Typ) then
-- subtype rg__xx is
-- Storage_Offset range 1 .. (Expr'size - typ'size) / Storage_Unit
Sizexpr := Sizexpr :=
Make_Op_Subtract (Loc, Make_Op_Subtract (Loc,
Left_Opnd => Left_Opnd =>
...@@ -3627,6 +3686,16 @@ package body Exp_Util is ...@@ -3627,6 +3686,16 @@ package body Exp_Util is
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Constr_Root, Loc), Prefix => New_Reference_To (Constr_Root, Loc),
Attribute_Name => Name_Object_Size)); Attribute_Name => Name_Object_Size));
else
-- subtype rg__xx is
-- Storage_Offset range 1 .. Expr'size / Storage_Unit
Sizexpr :=
Make_Attribute_Reference (Loc,
Prefix =>
OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)),
Attribute_Name => Name_Size);
end if;
Set_Paren_Count (Sizexpr, 1); Set_Paren_Count (Sizexpr, 1);
...@@ -3661,7 +3730,7 @@ package body Exp_Util is ...@@ -3661,7 +3730,7 @@ package body Exp_Util is
New_List (New_Reference_To (Range_Type, Loc)))))); New_List (New_Reference_To (Range_Type, Loc))))));
-- type Equiv_T is record -- type Equiv_T is record
-- _parent : Tnn; -- [ _parent : Tnn; ]
-- E : Str_Type; -- E : Str_Type;
-- end Equiv_T; -- end Equiv_T;
...@@ -3682,23 +3751,18 @@ package body Exp_Util is ...@@ -3682,23 +3751,18 @@ package body Exp_Util is
Set_Ekind (Equiv_Type, E_Record_Type); Set_Ekind (Equiv_Type, E_Record_Type);
Set_Parent_Subtype (Equiv_Type, Constr_Root); Set_Parent_Subtype (Equiv_Type, Constr_Root);
Append_To (List_Def, if not Is_Interface (Root_Typ) then
Make_Full_Type_Declaration (Loc, Append_To (Comp_List,
Defining_Identifier => Equiv_Type,
Type_Definition =>
Make_Record_Definition (Loc,
Component_List => Make_Component_List (Loc,
Component_Items => New_List (
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uParent), Make_Defining_Identifier (Loc, Name_uParent),
Component_Definition => Component_Definition =>
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => False, Aliased_Present => False,
Subtype_Indication => Subtype_Indication => New_Reference_To (Constr_Root, Loc))));
New_Reference_To (Constr_Root, Loc))), end if;
Append_To (Comp_List,
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
...@@ -3706,12 +3770,22 @@ package body Exp_Util is ...@@ -3706,12 +3770,22 @@ package body Exp_Util is
Component_Definition => Component_Definition =>
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => False, Aliased_Present => False,
Subtype_Indication => Subtype_Indication => New_Reference_To (Str_Type, Loc))));
New_Reference_To (Str_Type, Loc)))),
Append_To (List_Def,
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Equiv_Type,
Type_Definition =>
Make_Record_Definition (Loc,
Component_List =>
Make_Component_List (Loc,
Component_Items => Comp_List,
Variant_Part => Empty)))); Variant_Part => Empty))));
Insert_Actions (E, List_Def); -- Suppress all checks during the analysis of the expanded code
-- to avoid the generation of spurious warnings under ZFP run-time.
Insert_Actions (E, List_Def, Suppress => All_Checks);
return Equiv_Type; return Equiv_Type;
end Make_CW_Equivalent_Type; end Make_CW_Equivalent_Type;
...@@ -3839,12 +3913,12 @@ package body Exp_Util is ...@@ -3839,12 +3913,12 @@ package body Exp_Util is
EQ_Typ : Entity_Id := Empty; EQ_Typ : Entity_Id := Empty;
begin begin
-- A class-wide equivalent type is not needed when Java_VM -- A class-wide equivalent type is not needed when VM_Target
-- because the JVM back end handles the class-wide object -- because the VM back-ends handle the class-wide object
-- initialization itself (and doesn't need or want the -- initialization itself (and doesn't need or want the
-- additional intermediate type to handle the assignment). -- additional intermediate type to handle the assignment).
if Expander_Active and then not Java_VM then if Expander_Active and then VM_Target = No_VM then
EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E); EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E);
end if; end if;
...@@ -3952,6 +4026,22 @@ package body Exp_Util is ...@@ -3952,6 +4026,22 @@ package body Exp_Util is
return (Res); return (Res);
end New_Class_Wide_Subtype; end New_Class_Wide_Subtype;
--------------------------------
-- Non_Limited_Designated_Type --
---------------------------------
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id is
Desig : constant Entity_Id := Designated_Type (T);
begin
if Ekind (Desig) = E_Incomplete_Type
and then Present (Non_Limited_View (Desig))
then
return Non_Limited_View (Desig);
else
return Desig;
end if;
end Non_Limited_Designated_Type;
----------------------------------- -----------------------------------
-- OK_To_Do_Constant_Replacement -- -- OK_To_Do_Constant_Replacement --
----------------------------------- -----------------------------------
...@@ -4019,6 +4109,69 @@ package body Exp_Util is ...@@ -4019,6 +4109,69 @@ package body Exp_Util is
end if; end if;
end OK_To_Do_Constant_Replacement; end OK_To_Do_Constant_Replacement;
------------------------------------
-- Possible_Bit_Aligned_Component --
------------------------------------
function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean is
begin
case Nkind (N) is
-- Case of indexed component
when N_Indexed_Component =>
declare
P : constant Node_Id := Prefix (N);
Ptyp : constant Entity_Id := Etype (P);
begin
-- If we know the component size and it is less than 64, then
-- we are definitely OK. The back end always does assignment
-- of misaligned small objects correctly.
if Known_Static_Component_Size (Ptyp)
and then Component_Size (Ptyp) <= 64
then
return False;
-- Otherwise, we need to test the prefix, to see if we are
-- indexing from a possibly unaligned component.
else
return Possible_Bit_Aligned_Component (P);
end if;
end;
-- Case of selected component
when N_Selected_Component =>
declare
P : constant Node_Id := Prefix (N);
Comp : constant Entity_Id := Entity (Selector_Name (N));
begin
-- If there is no component clause, then we are in the clear
-- since the back end will never misalign a large component
-- unless it is forced to do so. In the clear means we need
-- only the recursive test on the prefix.
if Component_May_Be_Bit_Aligned (Comp) then
return True;
else
return Possible_Bit_Aligned_Component (P);
end if;
end;
-- If we have neither a record nor array component, it means that we
-- have fallen off the top testing prefixes recursively, and we now
-- have a stand alone object, where we don't have a problem.
when others =>
return False;
end case;
end Possible_Bit_Aligned_Component;
------------------------- -------------------------
-- Remove_Side_Effects -- -- Remove_Side_Effects --
------------------------- -------------------------
...@@ -4171,6 +4324,17 @@ package body Exp_Util is ...@@ -4171,6 +4324,17 @@ package body Exp_Util is
elsif Compile_Time_Known_Value (N) then elsif Compile_Time_Known_Value (N) then
return True; return True;
-- A variable renaming is not side-effet free, because the
-- renaming will function like a macro in the front-end in
-- some cases, and an assignment can modify the the component
-- designated by N, so we need to create a temporary for it.
elsif Is_Entity_Name (Original_Node (N))
and then Is_Renaming_Of_Object (Entity (Original_Node (N)))
and then Ekind (Entity (Original_Node (N))) /= E_Constant
then
return False;
end if; end if;
-- For other than entity names and compile time known values, -- For other than entity names and compile time known values,
......
gcc/ada/exp_util.ads
...@@ -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-2007, 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- --
...@@ -27,6 +27,7 @@ ...@@ -27,6 +27,7 @@
-- Package containing utility procedures used throughout the expander -- Package containing utility procedures used throughout the expander
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Namet; use Namet;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Types; use Types; with Types; use Types;
...@@ -393,7 +394,7 @@ package Exp_Util is ...@@ -393,7 +394,7 @@ package Exp_Util is
-- or not known at all. In the first two cases, Get_Current_Condition will -- or not known at all. In the first two cases, Get_Current_Condition will
-- return with Op set to the appropriate conditional operator (inverted if -- return with Op set to the appropriate conditional operator (inverted if
-- the condition is known false), and Val set to the constant value. If the -- the condition is known false), and Val set to the constant value. If the
-- condition is not known, then Cond and Val are set for the empty case -- condition is not known, then Op and Val are set for the empty case
-- (N_Empty and Empty). -- (N_Empty and Empty).
-- --
-- The check for whether the condition is true/false unknown depends -- The check for whether the condition is true/false unknown depends
...@@ -411,6 +412,10 @@ package Exp_Util is ...@@ -411,6 +412,10 @@ package Exp_Util is
-- N_Op_Eq), or to determine the result of some other test in other cases -- N_Op_Eq), or to determine the result of some other test in other cases
-- (e.g. no access check required if N_Op_Ne Null). -- (e.g. no access check required if N_Op_Ne Null).
function Has_Controlled_Coextensions (Typ : Entity_Id) return Boolean;
-- Determine whether a record type has anonymous access discriminants with
-- a controlled designated type.
function Homonym_Number (Subp : Entity_Id) return Nat; function Homonym_Number (Subp : Entity_Id) return Nat;
-- Here subp is the entity for a subprogram. This routine returns the -- Here subp is the entity for a subprogram. This routine returns the
-- homonym number used to disambiguate overloaded subprograms in the same -- homonym number used to disambiguate overloaded subprograms in the same
...@@ -520,6 +525,11 @@ package Exp_Util is ...@@ -520,6 +525,11 @@ package Exp_Util is
-- caller has to check whether stack checking is actually enabled in order -- caller has to check whether stack checking is actually enabled in order
-- to guide the expansion (typically of a function call). -- to guide the expansion (typically of a function call).
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;
-- An anonymous access type may designate a limited view. Check whether
-- non-limited view is available during expansion, to examine components
-- or other characteristics of the full type.
function OK_To_Do_Constant_Replacement (E : Entity_Id) return Boolean; function OK_To_Do_Constant_Replacement (E : Entity_Id) return Boolean;
-- This function is used when testing whether or not to replace a reference -- This function is used when testing whether or not to replace a reference
-- to entity E by a known constant value. Such replacement must be done -- to entity E by a known constant value. Such replacement must be done
...@@ -532,6 +542,14 @@ package Exp_Util is ...@@ -532,6 +542,14 @@ package Exp_Util is
-- address might be captured in a way we do not detect. A value of True is -- address might be captured in a way we do not detect. A value of True is
-- returned only if the replacement is safe. -- returned only if the replacement is safe.
function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean;
-- This function is used in processing the assignment of a record or
-- indexed component. The argument N is either the left hand or right
-- hand side of an assignment, and this function determines if there
-- is a record component reference where the record may be bit aligned
-- in a manner that causes trouble for the back end (see description
-- of Exp_Util.Component_May_Be_Bit_Aligned for further details).
procedure Remove_Side_Effects procedure Remove_Side_Effects
(Exp : Node_Id; (Exp : Node_Id;
Name_Req : Boolean := False; Name_Req : Boolean := False;
......
gcc/ada/lib-load.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, 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- --
...@@ -30,7 +30,6 @@ with Einfo; use Einfo; ...@@ -30,7 +30,6 @@ with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Fname; use Fname; with Fname; use Fname;
with Fname.UF; use Fname.UF; with Fname.UF; use Fname.UF;
with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
...@@ -71,6 +70,69 @@ package body Lib.Load is ...@@ -71,6 +70,69 @@ package body Lib.Load is
-- This procedure is used to generate error message info lines that -- This procedure is used to generate error message info lines that
-- trace the current dependency chain when a load error occurs. -- trace the current dependency chain when a load error occurs.
------------------------------
-- Change_Main_Unit_To_Spec --
------------------------------
procedure Change_Main_Unit_To_Spec is
U : Unit_Record renames Units.Table (Main_Unit);
N : File_Name_Type;
X : Source_File_Index;
begin
-- Get name of unit body
Get_Name_String (U.Unit_File_Name);
-- Note: for the following we should really generalize and consult the
-- file name pattern data, but for now we just deal with the common
-- naming cases, which is probably good enough in practice ???
-- Change .adb to .ads
if Name_Len >= 5
and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
then
Name_Buffer (Name_Len) := 's';
-- Change .2.ada to .1.ada (Rational convention)
elsif Name_Len >= 7
and then Name_Buffer (Name_Len - 5 .. Name_Len) = ".2.ada"
then
Name_Buffer (Name_Len - 4) := '1';
-- Change .ada to _.ada (DEC convention)
elsif Name_Len >= 5
and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ada"
then
Name_Buffer (Name_Len - 3 .. Name_Len + 1) := "_.ada";
Name_Len := Name_Len + 1;
-- No match, don't make the change
else
return;
end if;
-- Try loading the spec
N := Name_Find;
X := Load_Source_File (N);
-- No change if we did not find the spec
if X = No_Source_File then
return;
end if;
-- Otherwise modify Main_Unit entry to point to spec
U.Unit_File_Name := N;
U.Source_Index := X;
end Change_Main_Unit_To_Spec;
------------------------------- -------------------------------
-- Create_Dummy_Package_Unit -- -- Create_Dummy_Package_Unit --
------------------------------- -------------------------------
...@@ -219,6 +281,7 @@ package body Lib.Load is ...@@ -219,6 +281,7 @@ package body Lib.Load is
procedure Load_Main_Source is procedure Load_Main_Source is
Fname : File_Name_Type; Fname : File_Name_Type;
Version : Word := 0;
begin begin
Load_Stack.Increment_Last; Load_Stack.Increment_Last;
...@@ -239,13 +302,17 @@ package body Lib.Load is ...@@ -239,13 +302,17 @@ package body Lib.Load is
Main_Source_File := Load_Source_File (Fname); Main_Source_File := Load_Source_File (Fname);
Current_Error_Source_File := Main_Source_File; Current_Error_Source_File := Main_Source_File;
if Main_Source_File /= No_Source_File then
Version := Source_Checksum (Main_Source_File);
end if;
Units.Table (Main_Unit) := ( Units.Table (Main_Unit) := (
Cunit => Empty, Cunit => Empty,
Cunit_Entity => Empty, Cunit_Entity => Empty,
Dependency_Num => 0, Dependency_Num => 0,
Dynamic_Elab => False, Dynamic_Elab => False,
Error_Location => No_Location, Error_Location => No_Location,
Expected_Unit => No_Name, Expected_Unit => No_Unit_Name,
Fatal_Error => False, Fatal_Error => False,
Generate_Code => False, Generate_Code => False,
Has_RACW => False, Has_RACW => False,
...@@ -256,8 +323,8 @@ package body Lib.Load is ...@@ -256,8 +323,8 @@ package body Lib.Load is
Serial_Number => 0, Serial_Number => 0,
Source_Index => Main_Source_File, Source_Index => Main_Source_File,
Unit_File_Name => Fname, Unit_File_Name => Fname,
Unit_Name => No_Name, Unit_Name => No_Unit_Name,
Version => Source_Checksum (Main_Source_File)); Version => Version);
end if; end if;
end Load_Main_Source; end Load_Main_Source;
...@@ -303,13 +370,10 @@ package body Lib.Load is ...@@ -303,13 +370,10 @@ package body Lib.Load is
-- If parent is a renaming, then we use the renamed package as -- If parent is a renaming, then we use the renamed package as
-- the actual parent for the subsequent load operation. -- the actual parent for the subsequent load operation.
if Nkind (Parent (Cunit_Entity (Unump))) = if Nkind (Unit (Cunit (Unump))) = N_Package_Renaming_Declaration then
N_Package_Renaming_Declaration
then
Uname_Actual := Uname_Actual :=
New_Child New_Child
(Load_Name, (Load_Name, Get_Unit_Name (Name (Unit (Cunit (Unump)))));
Get_Unit_Name (Name (Parent (Cunit_Entity (Unump)))));
-- Save the renaming entity, to establish its visibility when -- Save the renaming entity, to establish its visibility when
-- installing the context. The implicit with is on this entity, -- installing the context. The implicit with is on this entity,
...@@ -382,7 +446,7 @@ package body Lib.Load is ...@@ -382,7 +446,7 @@ package body Lib.Load is
-- Note: Unit_Name (Main_Unit) is not set if we are parsing gnat.adc. -- Note: Unit_Name (Main_Unit) is not set if we are parsing gnat.adc.
if Present (Error_Node) if Present (Error_Node)
and then Unit_Name (Main_Unit) /= No_Name and then Unit_Name (Main_Unit) /= No_Unit_Name
then then
-- It seems like In_Extended_Main_Source_Unit (Error_Node) would -- It seems like In_Extended_Main_Source_Unit (Error_Node) would
-- do the trick here, but that's wrong, it is much too early to -- do the trick here, but that's wrong, it is much too early to
...@@ -408,9 +472,6 @@ package body Lib.Load is ...@@ -408,9 +472,6 @@ package body Lib.Load is
-- If the load is called from a with_type clause, the error -- If the load is called from a with_type clause, the error
-- node is correct. -- node is correct.
elsif Nkind (Parent (Error_Node)) = N_With_Type_Clause then
Load_Msg_Sloc := Sloc (Error_Node);
-- Otherwise, check for the subunit case, and if so, consider -- Otherwise, check for the subunit case, and if so, consider
-- we have a match if one name is a prefix of the other name. -- we have a match if one name is a prefix of the other name.
...@@ -474,14 +535,13 @@ package body Lib.Load is ...@@ -474,14 +535,13 @@ package body Lib.Load is
if Present (Error_Node) then if Present (Error_Node) then
if Is_Predefined_File_Name (Fname) then if Is_Predefined_File_Name (Fname) then
Error_Msg_Name_1 := Uname_Actual; Error_Msg_Unit_1 := Uname_Actual;
Error_Msg Error_Msg
("% is not a language defined unit", Load_Msg_Sloc); ("$$ is not a language defined unit", Load_Msg_Sloc);
else else
Error_Msg_Name_1 := Fname; Error_Msg_File_1 := Fname;
Error_Msg_Unit_1 := Uname_Actual; Error_Msg_Unit_1 := Uname_Actual;
Error_Msg Error_Msg ("File{ does not contain unit$", Load_Msg_Sloc);
("File{ does not contain unit$", Load_Msg_Sloc);
end if; end if;
Write_Dependency_Chain; Write_Dependency_Chain;
...@@ -604,11 +664,10 @@ package body Lib.Load is ...@@ -604,11 +664,10 @@ package body Lib.Load is
if Corr_Body /= No_Unit if Corr_Body /= No_Unit
and then Spec_Is_Irrelevant (Unum, Corr_Body) and then Spec_Is_Irrelevant (Unum, Corr_Body)
then then
Error_Msg_Name_1 := Unit_File_Name (Corr_Body); Error_Msg_File_1 := Unit_File_Name (Corr_Body);
Error_Msg Error_Msg
("cannot compile subprogram in file {!", ("cannot compile subprogram in file {!", Load_Msg_Sloc);
Load_Msg_Sloc); Error_Msg_File_1 := Unit_File_Name (Unum);
Error_Msg_Name_1 := Unit_File_Name (Unum);
Error_Msg Error_Msg
("\incorrect spec in file { must be removed first!", ("\incorrect spec in file { must be removed first!",
Load_Msg_Sloc); Load_Msg_Sloc);
...@@ -655,12 +714,12 @@ package body Lib.Load is ...@@ -655,12 +714,12 @@ package body Lib.Load is
Check_Restricted_Unit (Load_Name, Error_Node); Check_Restricted_Unit (Load_Name, Error_Node);
Error_Msg_Name_1 := Uname_Actual; Error_Msg_Unit_1 := Uname_Actual;
Error_Msg Error_Msg
("% is not a predefined library unit", Load_Msg_Sloc); ("$$ is not a predefined library unit", Load_Msg_Sloc);
else else
Error_Msg_Name_1 := Fname; Error_Msg_File_1 := Fname;
Error_Msg ("file{ not found", Load_Msg_Sloc); Error_Msg ("file{ not found", Load_Msg_Sloc);
end if; end if;
......
gcc/ada/lib-load.ads
...@@ -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-2007, 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- --
...@@ -153,6 +153,15 @@ package Lib.Load is ...@@ -153,6 +153,15 @@ package Lib.Load is
-- limited-with clause, or some unit in the context of X. It is used to -- limited-with clause, or some unit in the context of X. It is used to
-- avoid the check on circular dependency (Ada 2005, AI-50217) -- avoid the check on circular dependency (Ada 2005, AI-50217)
procedure Change_Main_Unit_To_Spec;
-- This procedure is called if the main unit file contains a No_Body pragma
-- and no other tokens. The effect is, if possible, to change the main unit
-- from the body it references now, to the corresponding spec. This has the
-- effect of ignoring the body, which is what we want. If it is impossible
-- to successfully make the change, then the call has no effect, and the
-- file is unchanged (this will lead to an error complaining about the
-- inappropriate No_Body spec).
function Create_Dummy_Package_Unit function Create_Dummy_Package_Unit
(With_Node : Node_Id; (With_Node : Node_Id;
Spec_Name : Unit_Name_Type) return Unit_Number_Type; Spec_Name : Unit_Name_Type) return Unit_Number_Type;
......
gcc/ada/par-ch10.adb
...@@ -869,22 +869,17 @@ package body Ch10 is ...@@ -869,22 +869,17 @@ package body Ch10 is
if Token = Tok_Type then if Token = Tok_Type then
-- WITH TYPE is an GNAT specific extension -- WITH TYPE is an obsolete GNAT specific extension
if not Extensions_Allowed then Error_Msg_SP
Error_Msg_SP ("`WITH TYPE` is a 'G'N'A'T extension"); ("`WITH TYPE` is an obsolete 'G'N'A'T extension");
Error_Msg_SP ("\unit must be compiled with -gnatX switch"); Error_Msg_SP ("\use Ada 2005 `LIMITED WITH` clause instead");
end if;
Scan; -- past TYPE Scan; -- past TYPE
With_Node := New_Node (N_With_Type_Clause, Token_Ptr);
Append (With_Node, Item_List);
Set_Name (With_Node, P_Qualified_Simple_Name);
T_Is; T_Is;
if Token = Tok_Tagged then if Token = Tok_Tagged then
Set_Tagged_Present (With_Node);
Scan; Scan;
elsif Token = Tok_Access then elsif Token = Tok_Access then
......
gcc/ada/sinfo.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2007, 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- --
...@@ -727,14 +727,6 @@ package body Sinfo is ...@@ -727,14 +727,6 @@ package body Sinfo is
return Node4 (N); return Node4 (N);
end Delay_Alternative; end Delay_Alternative;
function Delay_Finalize_Attach
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Object_Declaration);
return Flag14 (N);
end Delay_Finalize_Attach;
function Delay_Statement function Delay_Statement
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
...@@ -1101,11 +1093,12 @@ package body Sinfo is ...@@ -1101,11 +1093,12 @@ package body Sinfo is
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Block_Statement
or else NT (N).Nkind = N_Goto_Statement or else NT (N).Nkind = N_Goto_Statement
or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Label
or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Object_Declaration
or else NT (N).Nkind = N_Subtype_Declaration); or else NT (N).Nkind = N_Subtype_Declaration);
return Flag7 (N); return Flag8 (N);
end Exception_Junk; end Exception_Junk;
function Exception_Label function Exception_Label
...@@ -1360,6 +1353,22 @@ package body Sinfo is ...@@ -1360,6 +1353,22 @@ package body Sinfo is
return Flag12 (N); return Flag12 (N);
end Has_Dynamic_Range_Check; end Has_Dynamic_Range_Check;
function Has_Init_Expression
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Object_Declaration);
return Flag14 (N);
end Has_Init_Expression;
function Has_Local_Raise
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exception_Handler);
return Flag8 (N);
end Has_Local_Raise;
function Has_No_Elaboration_Code function Has_No_Elaboration_Code
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
...@@ -1629,6 +1638,14 @@ package body Sinfo is ...@@ -1629,6 +1638,14 @@ package body Sinfo is
return Flag7 (N); return Flag7 (N);
end Is_Protected_Subprogram_Body; end Is_Protected_Subprogram_Body;
function Is_Static_Coextension
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Allocator);
return Flag14 (N);
end Is_Static_Coextension;
function Is_Static_Expression function Is_Static_Expression
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
...@@ -1900,8 +1917,7 @@ package body Sinfo is ...@@ -1900,8 +1917,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Subprogram_Renaming_Declaration or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
or else NT (N).Nkind = N_Subunit or else NT (N).Nkind = N_Subunit
or else NT (N).Nkind = N_Variant_Part or else NT (N).Nkind = N_Variant_Part
or else NT (N).Nkind = N_With_Clause or else NT (N).Nkind = N_With_Clause);
or else NT (N).Nkind = N_With_Type_Clause);
return Node2 (N); return Node2 (N);
end Name; end Name;
...@@ -2348,6 +2364,14 @@ package body Sinfo is ...@@ -2348,6 +2364,14 @@ package body Sinfo is
return Flag13 (N); return Flag13 (N);
end Redundant_Use; end Redundant_Use;
function Renaming_Exception
(N : Node_Id) return Node_Id is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exception_Declaration);
return Node2 (N);
end Renaming_Exception;
function Result_Definition function Result_Definition
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
...@@ -2576,8 +2600,7 @@ package body Sinfo is ...@@ -2576,8 +2600,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Formal_Private_Type_Definition
or else NT (N).Nkind = N_Incomplete_Type_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration
or else NT (N).Nkind = N_Private_Type_Declaration or else NT (N).Nkind = N_Private_Type_Declaration
or else NT (N).Nkind = N_Record_Definition or else NT (N).Nkind = N_Record_Definition);
or else NT (N).Nkind = N_With_Type_Clause);
return Flag15 (N); return Flag15 (N);
end Tagged_Present; end Tagged_Present;
...@@ -3412,14 +3435,6 @@ package body Sinfo is ...@@ -3412,14 +3435,6 @@ package body Sinfo is
Set_Node4_With_Parent (N, Val); Set_Node4_With_Parent (N, Val);
end Set_Delay_Alternative; end Set_Delay_Alternative;
procedure Set_Delay_Finalize_Attach
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Object_Declaration);
Set_Flag14 (N, Val);
end Set_Delay_Finalize_Attach;
procedure Set_Delay_Statement procedure Set_Delay_Statement
(N : Node_Id; Val : Node_Id) is (N : Node_Id; Val : Node_Id) is
begin begin
...@@ -3777,11 +3792,12 @@ package body Sinfo is ...@@ -3777,11 +3792,12 @@ package body Sinfo is
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Block_Statement
or else NT (N).Nkind = N_Goto_Statement or else NT (N).Nkind = N_Goto_Statement
or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Label
or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Object_Declaration
or else NT (N).Nkind = N_Subtype_Declaration); or else NT (N).Nkind = N_Subtype_Declaration);
Set_Flag7 (N, Val); Set_Flag8 (N, Val);
end Set_Exception_Junk; end Set_Exception_Junk;
procedure Set_Exception_Label procedure Set_Exception_Label
...@@ -4036,6 +4052,22 @@ package body Sinfo is ...@@ -4036,6 +4052,22 @@ package body Sinfo is
Set_Flag12 (N, Val); Set_Flag12 (N, Val);
end Set_Has_Dynamic_Range_Check; end Set_Has_Dynamic_Range_Check;
procedure Set_Has_Init_Expression
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Object_Declaration);
Set_Flag14 (N, Val);
end Set_Has_Init_Expression;
procedure Set_Has_Local_Raise
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exception_Handler);
Set_Flag8 (N, Val);
end Set_Has_Local_Raise;
procedure Set_Has_No_Elaboration_Code procedure Set_Has_No_Elaboration_Code
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
...@@ -4305,6 +4337,14 @@ package body Sinfo is ...@@ -4305,6 +4337,14 @@ package body Sinfo is
Set_Flag7 (N, Val); Set_Flag7 (N, Val);
end Set_Is_Protected_Subprogram_Body; end Set_Is_Protected_Subprogram_Body;
procedure Set_Is_Static_Coextension
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Allocator);
Set_Flag14 (N, Val);
end Set_Is_Static_Coextension;
procedure Set_Is_Static_Expression procedure Set_Is_Static_Expression
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
...@@ -4576,8 +4616,7 @@ package body Sinfo is ...@@ -4576,8 +4616,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Subprogram_Renaming_Declaration or else NT (N).Nkind = N_Subprogram_Renaming_Declaration
or else NT (N).Nkind = N_Subunit or else NT (N).Nkind = N_Subunit
or else NT (N).Nkind = N_Variant_Part or else NT (N).Nkind = N_Variant_Part
or else NT (N).Nkind = N_With_Clause or else NT (N).Nkind = N_With_Clause);
or else NT (N).Nkind = N_With_Type_Clause);
Set_Node2_With_Parent (N, Val); Set_Node2_With_Parent (N, Val);
end Set_Name; end Set_Name;
...@@ -5024,6 +5063,14 @@ package body Sinfo is ...@@ -5024,6 +5063,14 @@ package body Sinfo is
Set_Flag13 (N, Val); Set_Flag13 (N, Val);
end Set_Redundant_Use; end Set_Redundant_Use;
procedure Set_Renaming_Exception
(N : Node_Id; Val : Node_Id) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Exception_Declaration);
Set_Node2 (N, Val);
end Set_Renaming_Exception;
procedure Set_Result_Definition procedure Set_Result_Definition
(N : Node_Id; Val : Node_Id) is (N : Node_Id; Val : Node_Id) is
begin begin
...@@ -5252,8 +5299,7 @@ package body Sinfo is ...@@ -5252,8 +5299,7 @@ package body Sinfo is
or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Formal_Private_Type_Definition
or else NT (N).Nkind = N_Incomplete_Type_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration
or else NT (N).Nkind = N_Private_Type_Declaration or else NT (N).Nkind = N_Private_Type_Declaration
or else NT (N).Nkind = N_Record_Definition or else NT (N).Nkind = N_Record_Definition);
or else NT (N).Nkind = N_With_Type_Clause);
Set_Flag15 (N, Val); Set_Flag15 (N, Val);
end Set_Tagged_Present; end Set_Tagged_Present;
......
gcc/ada/sinfo.ads
...@@ -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-2007, 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- --
...@@ -48,6 +48,7 @@ ...@@ -48,6 +48,7 @@
-- WARNING: Several files are automatically generated from this package. -- WARNING: Several files are automatically generated from this package.
-- See below for details. -- See below for details.
with Namet; use Namet;
with Types; use Types; with Types; use Types;
with Uintp; use Uintp; with Uintp; use Uintp;
with Urealp; use Urealp; with Urealp; use Urealp;
...@@ -462,10 +463,6 @@ package Sinfo is ...@@ -462,10 +463,6 @@ package Sinfo is
-- already been analyzed, both for efficiency and functional correctness -- already been analyzed, both for efficiency and functional correctness
-- reasons. -- reasons.
-- Coextensions (Elist4-Sem)
-- Present in allocators nodes. Points to list of allocators for the
-- access discriminants of the allocated object,
-- Comes_From_Source (Flag2) -- Comes_From_Source (Flag2)
-- This flag is on for any nodes built by the scanner or parser from the -- This flag is on for any nodes built by the scanner or parser from the
-- source program, and off for any nodes built by the analyzer or -- source program, and off for any nodes built by the analyzer or
...@@ -485,7 +482,9 @@ package Sinfo is ...@@ -485,7 +482,9 @@ package Sinfo is
-- points to a list of raise nodes, which are calls to a routine to raise -- points to a list of raise nodes, which are calls to a routine to raise
-- an exception. These are raise nodes which can be optimized into gotos -- an exception. These are raise nodes which can be optimized into gotos
-- if the handler turns out to meet the conditions which permit this -- if the handler turns out to meet the conditions which permit this
-- transformation. -- transformation. Note that this does NOT include instances of the
-- N_Raise_xxx_Error nodes since the transformation of these nodes is
-- handled by the back end (using the N_Push/N_Pop mechanism).
-- Has_Dynamic_Length_Check (Flag10-Sem) -- Has_Dynamic_Length_Check (Flag10-Sem)
-- This flag is present on all nodes. It is set to indicate that one of -- This flag is present on all nodes. It is set to indicate that one of
...@@ -499,6 +498,13 @@ package Sinfo is ...@@ -499,6 +498,13 @@ package Sinfo is
-- has been inserted at the flagged node. This is used to avoid the -- has been inserted at the flagged node. This is used to avoid the
-- generation of duplicate checks. -- generation of duplicate checks.
-- Has_Local_Raise (Flag8-Sem)
-- Present in exception handler nodes. Set if the handler can be entered
-- via a local raise that gets transformed to a goto statement. This will
-- always be set if Local_Raise_Statements is non-empty, but can also be
-- set as a result of generation of N_Raise_xxx nodes, or flags set in
-- nodes requiring generation of back end checks.
------------------------------------ ------------------------------------
-- Description of Semantic Fields -- -- Description of Semantic Fields --
------------------------------------ ------------------------------------
...@@ -660,6 +666,10 @@ package Sinfo is ...@@ -660,6 +666,10 @@ package Sinfo is
-- attribute definition clause is given, rather than testing this at the -- attribute definition clause is given, rather than testing this at the
-- freeze point. -- freeze point.
-- Coextensions (Elist4-Sem)
-- Present in allocators nodes. Points to list of allocators for the
-- access discriminants of the allocated object.
-- Comes_From_Extended_Return_Statement (Flag18-Sem) -- Comes_From_Extended_Return_Statement (Flag18-Sem)
-- Present in N_Return_Statement nodes. True if this node was -- Present in N_Return_Statement nodes. True if this node was
-- constructed as part of the expansion of an -- constructed as part of the expansion of an
...@@ -767,14 +777,6 @@ package Sinfo is ...@@ -767,14 +777,6 @@ package Sinfo is
-- for the default expression). Default_Expression is used for -- for the default expression). Default_Expression is used for
-- conformance checking. -- conformance checking.
-- Delay_Finalize_Attach (Flag14-Sem)
-- This flag is present in an N_Object_Declaration node. If it is set,
-- then in the case of a controlled type being declared and initialized,
-- the normal code for attaching the result to the appropriate local
-- finalization list is suppressed. This is used for functions that
-- return controlled types without using the secondary stack, where it is
-- the caller who must do the attachment.
-- Discr_Check_Funcs_Built (Flag11-Sem) -- Discr_Check_Funcs_Built (Flag11-Sem)
-- This flag is present in N_Full_Type_Declaration nodes. It is set when -- This flag is present in N_Full_Type_Declaration nodes. It is set when
-- discriminant checking functions are constructed. The purpose is to -- discriminant checking functions are constructed. The purpose is to
...@@ -950,7 +952,7 @@ package Sinfo is ...@@ -950,7 +952,7 @@ package Sinfo is
-- points to an essentially arbitrary choice from the possible set of -- points to an essentially arbitrary choice from the possible set of
-- types. -- types.
-- Exception_Junk (Flag7-Sem) -- Exception_Junk (Flag8-Sem)
-- This flag is set in a various nodes appearing in a statement sequence -- This flag is set in a various nodes appearing in a statement sequence
-- to indicate that the corresponding node is an artifact of the -- to indicate that the corresponding node is an artifact of the
-- generated code for exception handling, and should be ignored when -- generated code for exception handling, and should be ignored when
...@@ -1211,6 +1213,10 @@ package Sinfo is ...@@ -1211,6 +1213,10 @@ package Sinfo is
-- handler to make sure that the associated protected object is unlocked -- handler to make sure that the associated protected object is unlocked
-- when the subprogram completes. -- when the subprogram completes.
-- Is_Static_Coextension (Flag14-Sem)
-- Present in N_Allocator nodes. Set if the allocator is a coextension
-- of an object allocated on the stack rather than the heap.
-- Is_Static_Expression (Flag6-Sem) -- Is_Static_Expression (Flag6-Sem)
-- Indicates that an expression is a static expression (RM 4.9). See spec -- Indicates that an expression is a static expression (RM 4.9). See spec
-- of package Sem_Eval for full details on the use of this flag. -- of package Sem_Eval for full details on the use of this flag.
...@@ -1482,6 +1488,14 @@ package Sinfo is ...@@ -1482,6 +1488,14 @@ package Sinfo is
-- to indicate that a use is redundant (and therefore need not be undone -- to indicate that a use is redundant (and therefore need not be undone
-- on scope exit). -- on scope exit).
-- Renaming_Exception (Node2-Sem)
-- Present in N_Exception_Declaration node. Used to point back to the
-- exception renaming for an exception declared within a subprogram.
-- What happens is that an exception declared in a subprogram is moved
-- to the library level with a unique name, and the original exception
-- becomes a renaming. This link from the library level exception to the
-- renaming declaration allows registering of the proper exception name.
-- Return_Statement_Entity (Node5-Sem) -- Return_Statement_Entity (Node5-Sem)
-- Present in N_Return_Statement and N_Extended_Return_Statement. -- Present in N_Return_Statement and N_Extended_Return_Statement.
-- Points to an E_Return_Statement representing the return statement. -- Points to an E_Return_Statement representing the return statement.
...@@ -1967,7 +1981,7 @@ package Sinfo is ...@@ -1967,7 +1981,7 @@ package Sinfo is
-- Null_Exclusion_Present (Flag11) -- Null_Exclusion_Present (Flag11)
-- Subtype_Indication (Node5) -- Subtype_Indication (Node5)
-- Generic_Parent_Type (Node4-Sem) (set for an actual derived type). -- Generic_Parent_Type (Node4-Sem) (set for an actual derived type).
-- Exception_Junk (Flag7-Sem) -- Exception_Junk (Flag8-Sem)
------------------------------- -------------------------------
-- 3.2.2 Subtype Indication -- -- 3.2.2 Subtype Indication --
...@@ -2055,6 +2069,13 @@ package Sinfo is ...@@ -2055,6 +2069,13 @@ package Sinfo is
-- Prev_Ids flags to preserve the original source form as described -- Prev_Ids flags to preserve the original source form as described
-- in the section on "Handling of Defining Identifier Lists". -- in the section on "Handling of Defining Identifier Lists".
-- The flag Has_Init_Expression is set if an initializing expression
-- is present. Normally it is set if and only if Expression contains
-- a non-empty value, but there is an exception to this. When the
-- initializing expression is an aggregate which requires explicit
-- assignments, the Expression field gets set to Empty, but this flag
-- is still set, so we don't forget we had an initializing expression.
-- Note: if a range check is required for the initialization -- Note: if a range check is required for the initialization
-- expression then the Do_Range_Check flag is set in the Expression, -- expression then the Do_Range_Check flag is set in the Expression,
-- with the check being done against the type given by the object -- with the check being done against the type given by the object
...@@ -2091,9 +2112,9 @@ package Sinfo is ...@@ -2091,9 +2112,9 @@ package Sinfo is
-- Prev_Ids (Flag6) (set to False if no previous identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list)
-- No_Initialization (Flag13-Sem) -- No_Initialization (Flag13-Sem)
-- Assignment_OK (Flag15-Sem) -- Assignment_OK (Flag15-Sem)
-- Exception_Junk (Flag7-Sem) -- Exception_Junk (Flag8-Sem)
-- Delay_Finalize_Attach (Flag14-Sem)
-- Is_Subprogram_Descriptor (Flag16-Sem) -- Is_Subprogram_Descriptor (Flag16-Sem)
-- Has_Init_Expression (Flag14)
------------------------------------- -------------------------------------
-- 3.3.1 Defining Identifier List -- -- 3.3.1 Defining Identifier List --
...@@ -3643,6 +3664,7 @@ package Sinfo is ...@@ -3643,6 +3664,7 @@ package Sinfo is
-- Procedure_To_Call (Node2-Sem) -- Procedure_To_Call (Node2-Sem)
-- Coextensions (Elist4-Sem) -- Coextensions (Elist4-Sem)
-- No_Initialization (Flag13-Sem) -- No_Initialization (Flag13-Sem)
-- Is_Static_Coextension (Flag14-Sem)
-- Do_Storage_Check (Flag17-Sem) -- Do_Storage_Check (Flag17-Sem)
-- Is_Coextension (Flag18-Sem) -- Is_Coextension (Flag18-Sem)
-- plus fields for expression -- plus fields for expression
...@@ -3718,7 +3740,7 @@ package Sinfo is ...@@ -3718,7 +3740,7 @@ package Sinfo is
-- N_Label -- N_Label
-- Sloc points to << -- Sloc points to <<
-- Identifier (Node1) direct name of statement identifier -- Identifier (Node1) direct name of statement identifier
-- Exception_Junk (Flag7-Sem) -- Exception_Junk (Flag8-Sem)
------------------------------- -------------------------------
-- 5.1 Statement Identifier -- -- 5.1 Statement Identifier --
...@@ -3921,9 +3943,12 @@ package Sinfo is ...@@ -3921,9 +3943,12 @@ package Sinfo is
-- True. Blocks constructed by the expander usually have no identifier, -- True. Blocks constructed by the expander usually have no identifier,
-- and no corresponding entity. -- and no corresponding entity.
-- Note well: the block statement created for an extended return -- Note: the block statement created for an extended return statement
-- statement has an entity, and this entity is an E_Return_Statement, -- has an entity, and this entity is an E_Return_Statement, rather than
-- rather than the usual E_Block. -- the usual E_Block.
-- Note: Exception_Junk is set for the wrapping blocks created during
-- local raise optimization (Exp_Ch11.Expand_Local_Exception_Handlers).
-- N_Block_Statement -- N_Block_Statement
-- Sloc points to DECLARE or BEGIN -- Sloc points to DECLARE or BEGIN
...@@ -3935,6 +3960,7 @@ package Sinfo is ...@@ -3935,6 +3960,7 @@ package Sinfo is
-- Has_Created_Identifier (Flag15) -- Has_Created_Identifier (Flag15)
-- Is_Task_Allocation_Block (Flag6) -- Is_Task_Allocation_Block (Flag6)
-- Is_Asynchronous_Call_Block (Flag7) -- Is_Asynchronous_Call_Block (Flag7)
-- Exception_Junk (Flag8-Sem)
------------------------- -------------------------
-- 5.7 Exit Statement -- -- 5.7 Exit Statement --
...@@ -3960,7 +3986,7 @@ package Sinfo is ...@@ -3960,7 +3986,7 @@ package Sinfo is
-- N_Goto_Statement -- N_Goto_Statement
-- Sloc points to GOTO -- Sloc points to GOTO
-- Name (Node2) -- Name (Node2)
-- Exception_Junk (Flag7-Sem) -- Exception_Junk (Flag8-Sem)
--------------------------------- ---------------------------------
-- 6.1 Subprogram Declaration -- -- 6.1 Subprogram Declaration --
...@@ -5374,14 +5400,8 @@ package Sinfo is ...@@ -5374,14 +5400,8 @@ package Sinfo is
-- This is a GNAT extension, used to implement mutually recursive -- This is a GNAT extension, used to implement mutually recursive
-- types declared in different packages. -- types declared in different packages.
-- Note: this is now obsolete. The functionality of this construct
-- WITH_TYPE_CLAUSE ::= -- is now implemented by the Ada 2005 Limited_with_Clause.
-- with type type_NAME is access | with type type_NAME is tagged
-- N_With_Type_Clause
-- Sloc points to first token of type name
-- Name (Node2)
-- Tagged_Present (Flag15)
--------------------- ---------------------
-- 10.2 Body stub -- -- 10.2 Body stub --
...@@ -5475,6 +5495,7 @@ package Sinfo is ...@@ -5475,6 +5495,7 @@ package Sinfo is
-- Sloc points to EXCEPTION -- Sloc points to EXCEPTION
-- Defining_Identifier (Node1) -- Defining_Identifier (Node1)
-- Expression (Node3-Sem) -- Expression (Node3-Sem)
-- Renaming_Exception (Node2-Sem)
-- More_Ids (Flag5) (set to False if no more identifiers in list) -- More_Ids (Flag5) (set to False if no more identifiers in list)
-- Prev_Ids (Flag6) (set to False if no previous identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list)
...@@ -5565,6 +5586,7 @@ package Sinfo is ...@@ -5565,6 +5586,7 @@ package Sinfo is
-- Zero_Cost_Handling (Flag5-Sem) -- Zero_Cost_Handling (Flag5-Sem)
-- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present) -- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present)
-- Local_Raise_Not_OK (Flag7-Sem) -- Local_Raise_Not_OK (Flag7-Sem)
-- Has_Local_Raise (Flag8-Sem)
------------------------------------------ ------------------------------------------
-- 11.2 Choice parameter specification -- -- 11.2 Choice parameter specification --
...@@ -7093,13 +7115,13 @@ package Sinfo is ...@@ -7093,13 +7115,13 @@ package Sinfo is
N_Formal_Abstract_Subprogram_Declaration, N_Formal_Abstract_Subprogram_Declaration,
N_Formal_Concrete_Subprogram_Declaration, N_Formal_Concrete_Subprogram_Declaration,
-- N_Push_xxx_Label -- N_Push_xxx_Label, N_Push_Pop_xxx_Label
N_Push_Constraint_Error_Label, N_Push_Constraint_Error_Label,
N_Push_Program_Error_Label, N_Push_Program_Error_Label,
N_Push_Storage_Error_Label, N_Push_Storage_Error_Label,
-- N_Pop_xxx_Label -- N_Pop_xxx_Label, N_Push_Pop_xxx_Label
N_Pop_Constraint_Error_Label, N_Pop_Constraint_Error_Label,
N_Pop_Program_Error_Label, N_Pop_Program_Error_Label,
...@@ -7168,7 +7190,6 @@ package Sinfo is ...@@ -7168,7 +7190,6 @@ package Sinfo is
N_Variant, N_Variant,
N_Variant_Part, N_Variant_Part,
N_With_Clause, N_With_Clause,
N_With_Type_Clause,
N_Unused_At_End); N_Unused_At_End);
for Node_Kind'Size use 8; for Node_Kind'Size use 8;
...@@ -7296,6 +7317,10 @@ package Sinfo is ...@@ -7296,6 +7317,10 @@ package Sinfo is
N_Pop_Constraint_Error_Label .. N_Pop_Constraint_Error_Label ..
N_Pop_Storage_Error_Label; N_Pop_Storage_Error_Label;
subtype N_Push_Pop_xxx_Label is Node_Kind range
N_Push_Constraint_Error_Label ..
N_Pop_Storage_Error_Label;
subtype N_Raise_xxx_Error is Node_Kind range subtype N_Raise_xxx_Error is Node_Kind range
N_Raise_Constraint_Error .. N_Raise_Constraint_Error ..
N_Raise_Storage_Error; N_Raise_Storage_Error;
...@@ -7561,9 +7586,6 @@ package Sinfo is ...@@ -7561,9 +7586,6 @@ package Sinfo is
function Delay_Alternative function Delay_Alternative
(N : Node_Id) return Node_Id; -- Node4 (N : Node_Id) return Node_Id; -- Node4
function Delay_Finalize_Attach
(N : Node_Id) return Boolean; -- Flag14
function Delay_Statement function Delay_Statement
(N : Node_Id) return Node_Id; -- Node2 (N : Node_Id) return Node_Id; -- Node2
...@@ -7685,7 +7707,7 @@ package Sinfo is ...@@ -7685,7 +7707,7 @@ package Sinfo is
(N : Node_Id) return List_Id; -- List5 (N : Node_Id) return List_Id; -- List5
function Exception_Junk function Exception_Junk
(N : Node_Id) return Boolean; -- Flag7 (N : Node_Id) return Boolean; -- Flag8
function Exception_Label function Exception_Label
(N : Node_Id) return Node_Id; -- Node5 (N : Node_Id) return Node_Id; -- Node5
...@@ -7765,6 +7787,12 @@ package Sinfo is ...@@ -7765,6 +7787,12 @@ package Sinfo is
function Has_Dynamic_Range_Check function Has_Dynamic_Range_Check
(N : Node_Id) return Boolean; -- Flag12 (N : Node_Id) return Boolean; -- Flag12
function Has_Init_Expression
(N : Node_Id) return Boolean; -- Flag14
function Has_Local_Raise
(N : Node_Id) return Boolean; -- Flag8
function Has_No_Elaboration_Code function Has_No_Elaboration_Code
(N : Node_Id) return Boolean; -- Flag17 (N : Node_Id) return Boolean; -- Flag17
...@@ -7855,6 +7883,9 @@ package Sinfo is ...@@ -7855,6 +7883,9 @@ package Sinfo is
function Is_Protected_Subprogram_Body function Is_Protected_Subprogram_Body
(N : Node_Id) return Boolean; -- Flag7 (N : Node_Id) return Boolean; -- Flag7
function Is_Static_Coextension
(N : Node_Id) return Boolean; -- Flag14
function Is_Static_Expression function Is_Static_Expression
(N : Node_Id) return Boolean; -- Flag6 (N : Node_Id) return Boolean; -- Flag6
...@@ -8071,6 +8102,9 @@ package Sinfo is ...@@ -8071,6 +8102,9 @@ package Sinfo is
function Redundant_Use function Redundant_Use
(N : Node_Id) return Boolean; -- Flag13 (N : Node_Id) return Boolean; -- Flag13
function Renaming_Exception
(N : Node_Id) return Node_Id; -- Node2
function Result_Definition function Result_Definition
(N : Node_Id) return Node_Id; -- Node4 (N : Node_Id) return Node_Id; -- Node4
...@@ -8410,9 +8444,6 @@ package Sinfo is ...@@ -8410,9 +8444,6 @@ package Sinfo is
procedure Set_Delay_Alternative procedure Set_Delay_Alternative
(N : Node_Id; Val : Node_Id); -- Node4 (N : Node_Id; Val : Node_Id); -- Node4
procedure Set_Delay_Finalize_Attach
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Delay_Statement procedure Set_Delay_Statement
(N : Node_Id; Val : Node_Id); -- Node2 (N : Node_Id; Val : Node_Id); -- Node2
...@@ -8531,7 +8562,7 @@ package Sinfo is ...@@ -8531,7 +8562,7 @@ package Sinfo is
(N : Node_Id; Val : List_Id); -- List5 (N : Node_Id; Val : List_Id); -- List5
procedure Set_Exception_Junk procedure Set_Exception_Junk
(N : Node_Id; Val : Boolean := True); -- Flag7 (N : Node_Id; Val : Boolean := True); -- Flag8
procedure Set_Exception_Label procedure Set_Exception_Label
(N : Node_Id; Val : Node_Id); -- Node5 (N : Node_Id; Val : Node_Id); -- Node5
...@@ -8611,6 +8642,12 @@ package Sinfo is ...@@ -8611,6 +8642,12 @@ package Sinfo is
procedure Set_Has_Dynamic_Range_Check procedure Set_Has_Dynamic_Range_Check
(N : Node_Id; Val : Boolean := True); -- Flag12 (N : Node_Id; Val : Boolean := True); -- Flag12
procedure Set_Has_Init_Expression
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Has_Local_Raise
(N : Node_Id; Val : Boolean := True); -- Flag8
procedure Set_Has_No_Elaboration_Code procedure Set_Has_No_Elaboration_Code
(N : Node_Id; Val : Boolean := True); -- Flag17 (N : Node_Id; Val : Boolean := True); -- Flag17
...@@ -8701,6 +8738,9 @@ package Sinfo is ...@@ -8701,6 +8738,9 @@ package Sinfo is
procedure Set_Is_Protected_Subprogram_Body procedure Set_Is_Protected_Subprogram_Body
(N : Node_Id; Val : Boolean := True); -- Flag7 (N : Node_Id; Val : Boolean := True); -- Flag7
procedure Set_Is_Static_Coextension
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Is_Static_Expression procedure Set_Is_Static_Expression
(N : Node_Id; Val : Boolean := True); -- Flag6 (N : Node_Id; Val : Boolean := True); -- Flag6
...@@ -8917,6 +8957,9 @@ package Sinfo is ...@@ -8917,6 +8957,9 @@ package Sinfo is
procedure Set_Redundant_Use procedure Set_Redundant_Use
(N : Node_Id; Val : Boolean := True); -- Flag13 (N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Renaming_Exception
(N : Node_Id; Val : Node_Id); -- Node2
procedure Set_Result_Definition procedure Set_Result_Definition
(N : Node_Id; Val : Node_Id); -- Node4 (N : Node_Id; Val : Node_Id); -- Node4
...@@ -10142,13 +10185,6 @@ package Sinfo is ...@@ -10142,13 +10185,6 @@ package Sinfo is
4 => False, -- Library_Unit (Node4-Sem) 4 => False, -- Library_Unit (Node4-Sem)
5 => False), -- Corresponding_Spec (Node5-Sem) 5 => False), -- Corresponding_Spec (Node5-Sem)
N_With_Type_Clause =>
(1 => False, -- unused
2 => True, -- Name (Node2)
3 => False, -- unused
4 => False, -- unused
5 => False), -- unused
N_Subprogram_Body_Stub => N_Subprogram_Body_Stub =>
(1 => True, -- Specification (Node1) (1 => True, -- Specification (Node1)
2 => False, -- unused 2 => False, -- unused
...@@ -10683,7 +10719,6 @@ package Sinfo is ...@@ -10683,7 +10719,6 @@ package Sinfo is
pragma Inline (Defining_Identifier); pragma Inline (Defining_Identifier);
pragma Inline (Defining_Unit_Name); pragma Inline (Defining_Unit_Name);
pragma Inline (Delay_Alternative); pragma Inline (Delay_Alternative);
pragma Inline (Delay_Finalize_Attach);
pragma Inline (Delay_Statement); pragma Inline (Delay_Statement);
pragma Inline (Delta_Expression); pragma Inline (Delta_Expression);
pragma Inline (Digits_Expression); pragma Inline (Digits_Expression);
...@@ -10751,6 +10786,8 @@ package Sinfo is ...@@ -10751,6 +10786,8 @@ package Sinfo is
pragma Inline (Has_Created_Identifier); pragma Inline (Has_Created_Identifier);
pragma Inline (Has_Dynamic_Length_Check); pragma Inline (Has_Dynamic_Length_Check);
pragma Inline (Has_Dynamic_Range_Check); pragma Inline (Has_Dynamic_Range_Check);
pragma Inline (Has_Init_Expression);
pragma Inline (Has_Local_Raise);
pragma Inline (Has_Self_Reference); pragma Inline (Has_Self_Reference);
pragma Inline (Has_No_Elaboration_Code); pragma Inline (Has_No_Elaboration_Code);
pragma Inline (Has_Priority_Pragma); pragma Inline (Has_Priority_Pragma);
...@@ -10781,6 +10818,7 @@ package Sinfo is ...@@ -10781,6 +10818,7 @@ package Sinfo is
pragma Inline (Is_Overloaded); pragma Inline (Is_Overloaded);
pragma Inline (Is_Power_Of_2_For_Shift); pragma Inline (Is_Power_Of_2_For_Shift);
pragma Inline (Is_Protected_Subprogram_Body); pragma Inline (Is_Protected_Subprogram_Body);
pragma Inline (Is_Static_Coextension);
pragma Inline (Is_Static_Expression); pragma Inline (Is_Static_Expression);
pragma Inline (Is_Subprogram_Descriptor); pragma Inline (Is_Subprogram_Descriptor);
pragma Inline (Is_Task_Allocation_Block); pragma Inline (Is_Task_Allocation_Block);
...@@ -10853,6 +10891,7 @@ package Sinfo is ...@@ -10853,6 +10891,7 @@ package Sinfo is
pragma Inline (Reason); pragma Inline (Reason);
pragma Inline (Record_Extension_Part); pragma Inline (Record_Extension_Part);
pragma Inline (Redundant_Use); pragma Inline (Redundant_Use);
pragma Inline (Renaming_Exception);
pragma Inline (Result_Definition); pragma Inline (Result_Definition);
pragma Inline (Return_Object_Declarations); pragma Inline (Return_Object_Declarations);
pragma Inline (Return_Statement_Entity); pragma Inline (Return_Statement_Entity);
...@@ -10963,7 +11002,6 @@ package Sinfo is ...@@ -10963,7 +11002,6 @@ package Sinfo is
pragma Inline (Set_Defining_Identifier); pragma Inline (Set_Defining_Identifier);
pragma Inline (Set_Defining_Unit_Name); pragma Inline (Set_Defining_Unit_Name);
pragma Inline (Set_Delay_Alternative); pragma Inline (Set_Delay_Alternative);
pragma Inline (Set_Delay_Finalize_Attach);
pragma Inline (Set_Delay_Statement); pragma Inline (Set_Delay_Statement);
pragma Inline (Set_Delta_Expression); pragma Inline (Set_Delta_Expression);
pragma Inline (Set_Digits_Expression); pragma Inline (Set_Digits_Expression);
...@@ -11029,6 +11067,8 @@ package Sinfo is ...@@ -11029,6 +11067,8 @@ package Sinfo is
pragma Inline (Set_Handler_List_Entry); pragma Inline (Set_Handler_List_Entry);
pragma Inline (Set_Has_Created_Identifier); pragma Inline (Set_Has_Created_Identifier);
pragma Inline (Set_Has_Dynamic_Length_Check); pragma Inline (Set_Has_Dynamic_Length_Check);
pragma Inline (Set_Has_Init_Expression);
pragma Inline (Set_Has_Local_Raise);
pragma Inline (Set_Has_Dynamic_Range_Check); pragma Inline (Set_Has_Dynamic_Range_Check);
pragma Inline (Set_Has_No_Elaboration_Code); pragma Inline (Set_Has_No_Elaboration_Code);
pragma Inline (Set_Has_Priority_Pragma); pragma Inline (Set_Has_Priority_Pragma);
...@@ -11060,6 +11100,7 @@ package Sinfo is ...@@ -11060,6 +11100,7 @@ package Sinfo is
pragma Inline (Set_Is_Power_Of_2_For_Shift); pragma Inline (Set_Is_Power_Of_2_For_Shift);
pragma Inline (Set_Is_Protected_Subprogram_Body); pragma Inline (Set_Is_Protected_Subprogram_Body);
pragma Inline (Set_Has_Self_Reference); pragma Inline (Set_Has_Self_Reference);
pragma Inline (Set_Is_Static_Coextension);
pragma Inline (Set_Is_Static_Expression); pragma Inline (Set_Is_Static_Expression);
pragma Inline (Set_Is_Subprogram_Descriptor); pragma Inline (Set_Is_Subprogram_Descriptor);
pragma Inline (Set_Is_Task_Allocation_Block); pragma Inline (Set_Is_Task_Allocation_Block);
...@@ -11131,6 +11172,7 @@ package Sinfo is ...@@ -11131,6 +11172,7 @@ package Sinfo is
pragma Inline (Set_Reason); pragma Inline (Set_Reason);
pragma Inline (Set_Record_Extension_Part); pragma Inline (Set_Record_Extension_Part);
pragma Inline (Set_Redundant_Use); pragma Inline (Set_Redundant_Use);
pragma Inline (Set_Renaming_Exception);
pragma Inline (Set_Result_Definition); pragma Inline (Set_Result_Definition);
pragma Inline (Set_Return_Object_Declarations); pragma Inline (Set_Return_Object_Declarations);
pragma Inline (Set_Reverse_Present); pragma Inline (Set_Reverse_Present);
......
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