-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2019, 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- --
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Einfo; use Einfo;
with Elists; use Elists;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
-with Exp_Disp; use Exp_Disp;
with Exp_Sel; use Exp_Sel;
with Exp_Smem; use Exp_Smem;
with Exp_Tss; use Exp_Tss;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
+with Sem_Ch5; use Sem_Ch5;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Ch9; use Sem_Ch9;
with Sem_Ch11; use Sem_Ch11;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
+with Sem_Prag; use Sem_Prag;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
(N : Node_Id;
Pid : Node_Id) return Node_Id;
-- This routine constructs the unprotected version of a protected
- -- subprogram body, which is contains all of the code in the original,
+ -- subprogram body, which contains all of the code in the original,
-- unexpanded body. This is the version of the protected subprogram that is
-- called from all protected operations on the same object, including the
-- protected version of the same subprogram.
-- a null trailing statement with the given Loc (which is the sloc of
-- the accept, delay, or entry call statement). There might not be any
-- generated code for the accept, delay, or entry call itself (the effect
- -- of these statements is part of the general processsing done for the
+ -- of these statements is part of the general processing done for the
-- enclosing selective accept, timed entry call, or asynchronous select),
-- and the null statement is there to carry the sloc of that statement to
-- the back-end for trace-based coverage analysis purposes.
-- ...
-- <actualN> := P.<formalN>;
+ procedure Reset_Scopes_To (Bod : Node_Id; E : Entity_Id);
+ -- Reset the scope of declarations and blocks at the top level of Bod to
+ -- be E. Bod is either a block or a subprogram body. Used after expanding
+ -- various kinds of entry bodies into their corresponding constructs. This
+ -- is needed during unnesting to determine whether a body generated for an
+ -- entry or an accept alternative includes uplevel references.
+
function Trivial_Accept_OK return Boolean;
-- If there is no DO-END block for an accept, or if the DO-END block has
-- only null statements, then it is possible to do the Rendezvous with much
Make_Implicit_Exception_Handler (Loc,
Exception_Choices => New_List (Ohandle),
- Statements => New_List (
+ Statements => New_List (
Make_Procedure_Call_Statement (Sloc (Stats),
Name => New_Occurrence_Of (
RTE (RE_Exceptional_Complete_Rendezvous), Sloc (Stats)),
function Build_Private_Protected_Declaration
(N : Node_Id) return Entity_Id
is
+ procedure Analyze_Pragmas (From : Node_Id);
+ -- Analyze all pragmas which follow arbitrary node From
+
+ procedure Move_Pragmas (From : Node_Id; To : Node_Id);
+ -- Find all suitable source pragmas at the top of subprogram body From's
+ -- declarations and insert them after arbitrary node To.
+ --
+ -- Very similar to Move_Pragmas in sem_ch6 ???
+
+ ---------------------
+ -- Analyze_Pragmas --
+ ---------------------
+
+ procedure Analyze_Pragmas (From : Node_Id) is
+ Decl : Node_Id;
+
+ begin
+ Decl := Next (From);
+ while Present (Decl) loop
+ if Nkind (Decl) = N_Pragma then
+ Analyze_Pragma (Decl);
+
+ -- No candidate pragmas are available for analysis
+
+ else
+ exit;
+ end if;
+
+ Next (Decl);
+ end loop;
+ end Analyze_Pragmas;
+
+ ------------------
+ -- Move_Pragmas --
+ ------------------
+
+ procedure Move_Pragmas (From : Node_Id; To : Node_Id) is
+ Decl : Node_Id;
+ Insert_Nod : Node_Id;
+ Next_Decl : Node_Id;
+
+ begin
+ pragma Assert (Nkind (From) = N_Subprogram_Body);
+
+ -- The pragmas are moved in an order-preserving fashion
+
+ Insert_Nod := To;
+
+ -- Inspect the declarations of the subprogram body and relocate all
+ -- candidate pragmas.
+
+ Decl := First (Declarations (From));
+ while Present (Decl) loop
+
+ -- Preserve the following declaration for iteration purposes, due
+ -- to possible relocation of a pragma.
+
+ Next_Decl := Next (Decl);
+
+ -- We add an exception here for Unreferenced pragmas since the
+ -- internally generated spec gets analyzed within
+ -- Build_Private_Protected_Declaration and will lead to spurious
+ -- warnings due to the way references are checked.
+
+ if Nkind (Decl) = N_Pragma
+ and then Pragma_Name_Unmapped (Decl) /= Name_Unreferenced
+ then
+ Remove (Decl);
+ Insert_After (Insert_Nod, Decl);
+ Insert_Nod := Decl;
+
+ -- Skip internally generated code
+
+ elsif not Comes_From_Source (Decl) then
+ null;
+
+ -- No candidate pragmas are available for relocation
+
+ else
+ exit;
+ end if;
+
+ Decl := Next_Decl;
+ end loop;
+ end Move_Pragmas;
+
+ -- Local variables
+
+ Body_Id : constant Entity_Id := Defining_Entity (N);
Loc : constant Source_Ptr := Sloc (N);
- Body_Id : constant Entity_Id := Defining_Entity (N);
Decl : Node_Id;
- Plist : List_Id;
Formal : Entity_Id;
- New_Spec : Node_Id;
+ Formals : List_Id;
+ Spec : Node_Id;
Spec_Id : Entity_Id;
+ -- Start of processing for Build_Private_Protected_Declaration
+
begin
Formal := First_Formal (Body_Id);
-- expansion is enabled.
if Present (Formal) or else Expander_Active then
- Plist := Copy_Parameter_List (Body_Id);
+ Formals := Copy_Parameter_List (Body_Id);
else
- Plist := No_List;
+ Formals := No_List;
end if;
+ Spec_Id :=
+ Make_Defining_Identifier (Sloc (Body_Id),
+ Chars => Chars (Body_Id));
+
+ -- Indicate that the entity comes from source, to ensure that cross-
+ -- reference information is properly generated. The body itself is
+ -- rewritten during expansion, and the body entity will not appear in
+ -- calls to the operation.
+
+ Set_Comes_From_Source (Spec_Id, True);
+
if Nkind (Specification (N)) = N_Procedure_Specification then
- New_Spec :=
+ Spec :=
Make_Procedure_Specification (Loc,
- Defining_Unit_Name =>
- Make_Defining_Identifier (Sloc (Body_Id),
- Chars => Chars (Body_Id)),
- Parameter_Specifications =>
- Plist);
+ Defining_Unit_Name => Spec_Id,
+ Parameter_Specifications => Formals);
else
- New_Spec :=
+ Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Make_Defining_Identifier (Sloc (Body_Id),
- Chars => Chars (Body_Id)),
- Parameter_Specifications => Plist,
+ Defining_Unit_Name => Spec_Id,
+ Parameter_Specifications => Formals,
Result_Definition =>
New_Occurrence_Of (Etype (Body_Id), Loc));
end if;
- Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
+ Decl := Make_Subprogram_Declaration (Loc, Specification => Spec);
+ Set_Corresponding_Body (Decl, Body_Id);
+ Set_Corresponding_Spec (N, Spec_Id);
+
Insert_Before (N, Decl);
- Spec_Id := Defining_Unit_Name (New_Spec);
- -- Indicate that the entity comes from source, to ensure that cross-
- -- reference information is properly generated. The body itself is
- -- rewritten during expansion, and the body entity will not appear in
- -- calls to the operation.
+ -- Associate all aspects and pragmas of the body with the spec. This
+ -- ensures that these annotations apply to the initial declaration of
+ -- the subprogram body.
+
+ Move_Aspects (From => N, To => Decl);
+ Move_Pragmas (From => N, To => Decl);
- Set_Comes_From_Source (Spec_Id, True);
Analyze (Decl);
+
+ -- The analysis of the spec may generate pragmas which require manual
+ -- analysis. Since the generation of the spec and the relocation of the
+ -- annotations is driven by the expansion of the stand-alone body, the
+ -- pragmas will not be analyzed in a timely manner. Do this now.
+
+ Analyze_Pragmas (Decl);
+
+ Set_Convention (Spec_Id, Convention_Protected);
Set_Has_Completion (Spec_Id);
- Set_Convention (Spec_Id, Convention_Protected);
+
return Spec_Id;
end Build_Private_Protected_Declaration;
Bod_Stmts : List_Id;
Complete : Node_Id;
Ohandle : Node_Id;
+ Proc_Body : Node_Id;
EH_Loc : Source_Ptr;
-- Used for the exception handler, inserted at end of the body
Declarations => Decls,
Handled_Statement_Sequence => Handled_Statement_Sequence (N)));
+ -- Analyze now and reset scopes for declarations so that Scope fields
+ -- currently denoting the entry will now denote the block scope, and
+ -- the block's scope will be set to the new procedure entity.
+
+ Analyze_Statements (Bod_Stmts);
+
+ Set_Scope (Entity (Identifier (First (Bod_Stmts))), Bod_Id);
+
+ Reset_Scopes_To
+ (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts))));
+
case Corresponding_Runtime_Package (Pid) is
when System_Tasking_Protected_Objects_Entries =>
Append_To (Bod_Stmts,
raise Program_Error;
end case;
- -- When exceptions can not be propagated, we never need to call
+ -- When exceptions cannot be propagated, we never need to call
-- Exception_Complete_Entry_Body.
if No_Exception_Handlers_Set then
-- Create body of entry procedure. The renaming declarations are
-- placed ahead of the block that contains the actual entry body.
- return
+ Proc_Body :=
Make_Subprogram_Body (Loc,
Specification => Bod_Spec,
Declarations => Bod_Decls,
Make_Implicit_Exception_Handler (EH_Loc,
Exception_Choices => New_List (Ohandle),
- Statements => New_List (
+ Statements => New_List (
Make_Procedure_Call_Statement (EH_Loc,
Name => Complete,
Parameter_Associations => New_List (
Name =>
New_Occurrence_Of
(RTE (RE_Get_GNAT_Exception), Loc)))))))));
+
+ Reset_Scopes_To (Proc_Body, Protected_Body_Subprogram (Ent));
+ return Proc_Body;
end if;
end Build_Protected_Entry;
if Unprotected then
Set_Protected_Formal (Formal, Defining_Identifier (New_Param));
+ Set_Ekind (Defining_Identifier (New_Param), Ekind (Formal));
end if;
Append (New_Param, New_Plist);
(Restriction_Active (No_Implicit_Heap_Allocations)
or else Restriction_Active (No_Implicit_Task_Allocations))
and then not Restriction_Active (No_Secondary_Stack)
- and then Has_Rep_Item
+ and then Has_Rep_Pragma
(T, Name_Secondary_Stack_Size, Check_Parents => False);
end Create_Secondary_Stack_For_Task;
-- this safe. This is a common (if dubious) idiom.
elsif S = Scope (Prot)
- and then Ekind_In (S, E_Package, E_Generic_Package)
+ and then Is_Package_Or_Generic_Package (S)
and then Nkind (Parent (E)) = N_Object_Declaration
and then Nkind (Parent (Parent (E))) = N_Package_Body
then
Declarations => Declarations (N),
Handled_Statement_Sequence => Build_Accept_Body (N));
+ -- Reset the Scope of local entities associated with the accept
+ -- statement (that currently reference the entry scope) to the
+ -- block scope, to avoid having references to the locals treated
+ -- as up-level references.
+
+ Reset_Scopes_To (Block, Blkent);
+
-- For the analysis of the generated declarations, the parent node
-- must be properly set.
end if;
Analyze (N);
+
+ Reset_Scopes_To (N, Entity (Identifier (N)));
end Expand_N_Conditional_Entry_Call;
---------------------------------------
Proc : Entity_Id;
begin
- -- Try to use System.Relative_Delays.Delay_For only if available. This
- -- is the implementation used on restricted platforms when Ada.Calendar
- -- is not available.
+ -- Try to use Ada.Calendar.Delays.Delay_For if available.
- if RTE_Available (RO_RD_Delay_For) then
- Proc := RTE (RO_RD_Delay_For);
+ if RTE_Available (RO_CA_Delay_For) then
+ Proc := RTE (RO_CA_Delay_For);
- -- Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error
- -- message if not available.
+ -- Otherwise, use System.Relative_Delays.Delay_For and emit an error
+ -- message if not available. This is the implementation used on
+ -- restricted platforms when Ada.Calendar is not available.
else
- Proc := RTE (RO_CA_Delay_For);
+ Proc := RTE (RO_RD_Delay_For);
end if;
Rewrite (N,
when N_Implicit_Label_Declaration =>
null;
- when N_Itype_Reference =>
- Insert_After (Current_Node, New_Copy (Op_Body));
+ when N_Call_Marker
+ | N_Itype_Reference
+ =>
+ New_Op_Body := New_Copy (Op_Body);
+ Insert_After (Current_Node, New_Op_Body);
+ Current_Node := New_Op_Body;
when N_Freeze_Entity =>
New_Op_Body := New_Copy (Op_Body);
Current_Node : Node_Id := N;
E_Count : Int;
Entries_Aggr : Node_Id;
+ Rec_Decl : Node_Id;
+ Rec_Id : Entity_Id;
procedure Check_Inlining (Subp : Entity_Id);
-- If the original operation has a pragma Inline, propagate the flag
-- For a protected operation that is an interrupt handler, add the
-- freeze action that will register it as such.
+ procedure Replace_Access_Definition (Comp : Node_Id);
+ -- If a private component of the type is an access to itself, this
+ -- is not a reference to the current instance, but an access type out
+ -- of which one might construct a list. If such a component exists, we
+ -- create an incomplete type for the equivalent record type, and
+ -- a named access type for it, that replaces the access definition
+ -- of the original component. This is similar to what is done for
+ -- records in Check_Anonymous_Access_Components, but simpler, because
+ -- the corresponding record type has no previous declaration.
+ -- This needs to be done only once, even if there are several such
+ -- access components. The following entity stores the constructed
+ -- access type.
+
+ Acc_T : Entity_Id := Empty;
+
--------------------
-- Check_Inlining --
--------------------
Set_Is_Inlined (Protected_Body_Subprogram (Subp));
Set_Is_Inlined (Subp, False);
end if;
+
+ if Has_Pragma_No_Inline (Subp) then
+ Set_Has_Pragma_No_Inline (Protected_Body_Subprogram (Subp));
+ end if;
end Check_Inlining;
---------------------------
Append_Freeze_Action (Prot_Proc, RTS_Call);
end Register_Handler;
+ -------------------------------
+ -- Replace_Access_Definition --
+ -------------------------------
+
+ procedure Replace_Access_Definition (Comp : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (Comp);
+ Inc_T : Node_Id;
+ Inc_D : Node_Id;
+ Acc_Def : Node_Id;
+ Acc_D : Node_Id;
+
+ begin
+ if No (Acc_T) then
+ Inc_T := Make_Defining_Identifier (Loc, Chars (Rec_Id));
+ Inc_D := Make_Incomplete_Type_Declaration (Loc, Inc_T);
+ Acc_T := Make_Temporary (Loc, 'S');
+ Acc_Def :=
+ Make_Access_To_Object_Definition (Loc,
+ Subtype_Indication => New_Occurrence_Of (Inc_T, Loc));
+ Acc_D :=
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Acc_T,
+ Type_Definition => Acc_Def);
+
+ Insert_Before (Rec_Decl, Inc_D);
+ Analyze (Inc_D);
+
+ Insert_Before (Rec_Decl, Acc_D);
+ Analyze (Acc_D);
+ end if;
+
+ Set_Access_Definition (Comp, Empty);
+ Set_Subtype_Indication (Comp, New_Occurrence_Of (Acc_T, Loc));
+ end Replace_Access_Definition;
+
-- Local variables
Body_Arr : Node_Id;
Obj_Def : Node_Id;
Object_Comp : Node_Id;
Priv : Node_Id;
- Rec_Decl : Node_Id;
Sub : Node_Id;
-- Start of processing for Expand_N_Protected_Type_Declaration
return;
else
Rec_Decl := Build_Corresponding_Record (N, Prot_Typ, Loc);
+ Rec_Id := Defining_Identifier (Rec_Decl);
end if;
Cdecls := Component_Items (Component_List (Type_Definition (Rec_Decl)));
Access_Definition =>
New_Copy_Tree
(Access_Definition (Old_Comp), Discr_Map));
+
+ -- A self-reference in the private part becomes a
+ -- self-reference to the corresponding record.
+
+ if Entity (Subtype_Mark (Access_Definition (New_Comp)))
+ = Prot_Typ
+ then
+ Replace_Access_Definition (New_Comp);
+ end if;
end if;
New_Priv :=
Statements => New_List (
Make_Implicit_If_Statement (N,
- Condition => Cond,
+ Condition => Cond,
Then_Statements => New_List (
Make_Select_Call (
New_Occurrence_Of (RTE (RE_Simple_Mode), Loc)),
Eloc : constant Source_Ptr := Sloc (Ename);
Eent : constant Entity_Id := Entity (Ename);
Index : constant Node_Id := Entry_Index (Acc_Stm);
+
+ Call : Node_Id;
+ Expr : Node_Id;
Null_Body : Node_Id;
- Proc_Body : Node_Id;
PB_Ent : Entity_Id;
- Expr : Node_Id;
- Call : Node_Id;
+ Proc_Body : Node_Id;
+
+ -- Start of processing for Add_Accept
begin
if No (Ann) then
Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent)),
New_Occurrence_Of (RTE (RE_Null_Task_Entry), Eloc)));
else
- Expr :=
- Entry_Index_Expression
- (Eloc, Eent, Index, Scope (Eent));
+ Expr := Entry_Index_Expression (Eloc, Eent, Index, Scope (Eent));
end if;
if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then
Handled_Statement_Sequence =>
Build_Accept_Body (Accept_Statement (Alt)));
+ Reset_Scopes_To (Proc_Body, PB_Ent);
+
-- During the analysis of the body of the accept statement, any
-- zero cost exception handler records were collected in the
-- Accept_Handler_Records field of the N_Accept_Alternative node.
Set_Analyzed (Task_Size);
else
- Task_Size := Relocate_Node (Expr_N);
+ Task_Size := New_Copy_Tree (Expr_N);
end if;
end;
if Create_Secondary_Stack_For_Task (TaskId) then
declare
- Ritem : Node_Id;
- Size_Expr : Node_Id;
+ Size_Expr : constant Node_Id :=
+ Expression (First (
+ Pragma_Argument_Associations (
+ Get_Rep_Pragma (TaskId,
+ Name_Secondary_Stack_Size))));
- begin
- -- First extract the secondary stack size from the task type's
- -- representation aspect.
+ Stack_Size : Node_Id;
- Ritem :=
- Get_Rep_Item
- (TaskId, Name_Secondary_Stack_Size, Check_Parents => False);
+ begin
+ -- The secondary stack is defined inside the corresponding
+ -- record. Therefore if the size of the stack is set by means
+ -- of a discriminant, we must reference the discriminant of the
+ -- corresponding record type.
- -- Get Secondary_Stack_Size expression. Can be a pragma or aspect.
+ if Nkind (Size_Expr) in N_Has_Entity
+ and then Present (Discriminal_Link (Entity (Size_Expr)))
+ then
+ Stack_Size :=
+ New_Occurrence_Of
+ (CR_Discriminant (Discriminal_Link (Entity (Size_Expr))),
+ Loc);
+ Set_Parent (Stack_Size, Parent (Size_Expr));
+ Set_Etype (Stack_Size, Etype (Size_Expr));
+ Set_Analyzed (Stack_Size);
- if Nkind (Ritem) = N_Pragma then
- Size_Expr :=
- Expression
- (First (Pragma_Argument_Associations (Ritem)));
else
- Size_Expr := Expression (Ritem);
+ Stack_Size := New_Copy_Tree (Size_Expr);
end if;
- pragma Assert (Compile_Time_Known_Value (Size_Expr));
-
-- Create the secondary stack for the task
Decl_SS :=
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
- Make_Integer_Literal (Loc,
- Expr_Value (Size_Expr)))))));
+ Convert_To (RTE (RE_Size_Type),
+ Stack_Size))))));
Append_To (Cdecls, Decl_SS);
end;
Expression =>
Convert_To (RTE (RE_Size_Type),
- Relocate_Node (
+ New_Copy_Tree (
Expression (First (
Pragma_Argument_Associations (
Get_Rep_Pragma (TaskId, Name_Storage_Size))))))));
end if;
-- Add the _Secondary_Stack_Size component if a Secondary_Stack_Size
- -- rep item is present.
+ -- pragma is present.
- if Has_Rep_Item
+ if Has_Rep_Pragma
(TaskId, Name_Secondary_Stack_Size, Check_Parents => False)
then
Append_To (Cdecls,
Expression =>
Convert_To (RTE (RE_Time_Span),
- Relocate_Node (
+ New_Copy_Tree (
Expression (First (
Pragma_Argument_Associations (
Get_Relative_Deadline_Pragma (Taskdef))))))));
Object_Definition => New_Occurrence_Of (Standard_Integer, Loc),
Expression => D_Disc));
- -- Do the assignment at this stage only because the evaluation of the
- -- expression must not occur before (see ACVC C97302A).
-
- Append_To (Stmts,
- Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (D, Loc),
- Expression => D_Conv));
-
-- Parameter block processing
-- Manually create the parameter block for dispatching calls. In the
if Is_Disp_Select then
+ -- Compute the delay at this stage because the evaluation of its
+ -- expression must not occur earlier (see ACVC C97302A).
+
+ Append_To (Stmts,
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (D, Loc),
+ Expression => D_Conv));
+
-- Tagged kind processing, generate:
-- K : Ada.Tags.Tagged_Kind :=
-- Ada.Tags.Get_Tagged_Kind (Ada.Tags.Tag <object>));
Next (Stmt);
end loop;
- -- Do the assignment at this stage only because the evaluation
- -- of the expression must not occur before (see ACVC C97302A).
+ -- Compute the delay at this stage because the evaluation of
+ -- its expression must not occur earlier (see ACVC C97302A).
Insert_Before (Stmt,
Make_Assignment_Statement (Loc,
Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
Analyze (N);
+
+ -- Some items in Decls used to be in the N_Block in E_Call that is
+ -- constructed in Expand_Entry_Call, and are now in the new Block
+ -- into which N has been rewritten. Adjust their scopes to reflect that.
+
+ if Nkind (E_Call) = N_Block_Statement then
+ Obj := First_Entity (Entity (Identifier (E_Call)));
+ while Present (Obj) loop
+ Set_Scope (Obj, Entity (Identifier (N)));
+ Next_Entity (Obj);
+ end loop;
+ end if;
+
+ Reset_Scopes_To (N, Entity (Identifier (N)));
end Expand_N_Timed_Entry_Call;
----------------------------------------
Insert_Node := Decl;
end Add;
- --------------------------
- -- Replace_Discriminant --
- --------------------------
+ -------------------
+ -- Replace_Bound --
+ -------------------
function Replace_Bound (Bound : Node_Id) return Node_Id is
begin
Selector_Name => Make_Identifier (Loc, Chars (D))));
Add (Decl);
+ -- Set debug info needed on this renaming declaration even
+ -- though it does not come from source, so that the debugger
+ -- will get the right information for these generated names.
+
+ Set_Debug_Info_Needed (Discriminal (D));
+
Next_Discriminant (D);
end loop;
end;
Set_Ekind (Decl_Id, E_Variable);
end if;
- Set_Prival (Comp_Id, Decl_Id);
- Set_Prival_Link (Decl_Id, Comp_Id);
- Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id));
+ Set_Prival (Comp_Id, Decl_Id);
+ Set_Prival_Link (Decl_Id, Comp_Id);
+ Set_Is_Aliased (Decl_Id, Is_Aliased (Comp_Id));
+ Set_Is_Independent (Decl_Id, Is_Independent (Comp_Id));
-- Generate:
-- comp_name : comp_typ renames _object.comp_name;
end if;
-- Secondary_Stack_Size parameter. Set RE_Unspecified_Size unless there
- -- is a Secondary_Stack_Size rep item, in which case take the value from
- -- the rep item. If the restriction No_Secondary_Stack is active then a
+ -- is a Secondary_Stack_Size pragma, in which case take the value from
+ -- the pragma. If the restriction No_Secondary_Stack is active then a
-- size of 0 is passed regardless to prevent the allocation of the
-- unused stack.
if Restriction_Active (No_Secondary_Stack) then
Append_To (Args, Make_Integer_Literal (Loc, 0));
- elsif Has_Rep_Item
+ elsif Has_Rep_Pragma
(Ttyp, Name_Secondary_Stack_Size, Check_Parents => False)
then
Append_To (Args,
end if;
end Parameter_Block_Unpack;
+ ---------------------
+ -- Reset_Scopes_To --
+ ---------------------
+
+ procedure Reset_Scopes_To (Bod : Node_Id; E : Entity_Id) is
+ function Reset_Scope (N : Node_Id) return Traverse_Result;
+ -- Temporaries may have been declared during expansion of the procedure
+ -- created for an entry body or an accept alternative. Indicate that
+ -- their scope is the new body, to ensure proper generation of uplevel
+ -- references where needed during unnesting.
+
+ procedure Reset_Scopes is new Traverse_Proc (Reset_Scope);
+
+ -----------------
+ -- Reset_Scope --
+ -----------------
+
+ function Reset_Scope (N : Node_Id) return Traverse_Result is
+ Decl : Node_Id;
+
+ begin
+ -- If this is a block statement with an Identifier, it forms a scope,
+ -- so we want to reset its scope but not look inside.
+
+ if N /= Bod
+ and then Nkind (N) = N_Block_Statement
+ and then Present (Identifier (N))
+ then
+ Set_Scope (Entity (Identifier (N)), E);
+ return Skip;
+
+ -- Ditto for a package declaration or a full type declaration, etc.
+
+ elsif (Nkind (N) = N_Package_Declaration
+ and then N /= Specification (N))
+ or else Nkind (N) in N_Declaration
+ or else Nkind (N) in N_Renaming_Declaration
+ then
+ Set_Scope (Defining_Entity (N), E);
+ return Skip;
+
+ elsif N = Bod then
+
+ -- Scan declarations in new body. Declarations in the statement
+ -- part will be handled during later traversal.
+
+ Decl := First (Declarations (N));
+ while Present (Decl) loop
+ Reset_Scopes (Decl);
+ Next (Decl);
+ end loop;
+
+ elsif Nkind (N) = N_Freeze_Entity then
+
+ -- Scan the actions associated with a freeze node, which may
+ -- actually be declarations with entities that need to have
+ -- their scopes reset.
+
+ Decl := First (Actions (N));
+ while Present (Decl) loop
+ Reset_Scopes (Decl);
+ Next (Decl);
+ end loop;
+
+ elsif N /= Bod and then Nkind (N) in N_Proper_Body then
+
+ -- A subprogram without a separate declaration may be encountered,
+ -- and we need to reset the subprogram's entity's scope.
+
+ if Nkind (N) = N_Subprogram_Body then
+ Set_Scope (Defining_Entity (Specification (N)), E);
+ end if;
+
+ return Skip;
+ end if;
+
+ return OK;
+ end Reset_Scope;
+
+ -- Start of processing for Reset_Scopes_To
+
+ begin
+ Reset_Scopes (Bod);
+ end Reset_Scopes_To;
+
----------------------
-- Set_Discriminals --
----------------------
projects / thirdparty / gcc.git / blobdiff