-- ...
-- <actualN> := P.<formalN>;
+ procedure Reset_Scopes_To (Proc_Body : Node_Id; E : Entity_Id);
+ -- Reset the scope of declarations and blocks at the top level of
+ -- Proc_Body to be E. Used after expanding entry bodies into their
+ -- corresponding procedures.
+
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
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
-- 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,
Name =>
New_Occurrence_Of
(RTE (RE_Get_GNAT_Exception), Loc)))))))));
+
+ Reset_Scopes_To (Proc_Body, Bod_Id);
+ return Proc_Body;
end if;
end Build_Protected_Entry;
Expr : Node_Id;
Call : Node_Id;
+ -- Start of processing for Add_Accept
+
begin
if No (Ann) then
Ann := Node (Last_Elmt (Accept_Address (Eent)));
Make_Defining_Identifier (Eloc,
New_External_Name (Chars (Ename), 'A', Num_Accept));
- -- Link the acceptor to the original receiving entry
+ -- Link the acceptor to the original receiving entry.
Set_Ekind (PB_Ent, E_Procedure);
Set_Receiving_Entry (PB_Ent, Eent);
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.
end if;
end Parameter_Block_Unpack;
+ ---------------------
+ -- Reset_Scopes_To --
+ ---------------------
+
+ procedure Reset_Scopes_To (Proc_Body : 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 alternative. Indicate that their scope is the new
+ -- body, to prevent generation of spurious uplevel references
+ -- for these entities.
+
+ 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 Nkind (N) = N_Block_Statement and then Present (Identifier (N))
+ then
+ Set_Scope (Entity (Identifier (N)), E);
+ return Skip;
+
+ elsif Nkind (N) = N_Package_Declaration then
+ Set_Scope (Defining_Entity (N), E);
+ return Skip;
+
+ elsif N = Proc_Body then
+
+ -- Scan declarations
+
+ Decl := First (Declarations (N));
+ while Present (Decl) loop
+ Reset_Scopes (Decl);
+ Next (Decl);
+ end loop;
+
+ elsif N /= Proc_Body and then Nkind (N) in N_Proper_Body then
+ return Skip;
+ elsif Nkind (N) = N_Defining_Identifier then
+ Set_Scope (N, E);
+ end if;
+
+ return OK;
+ end Reset_Scope;
+
+ begin
+ Reset_Scopes (Proc_Body);
+ end Reset_Scopes_To;
+
----------------------
-- Set_Discriminals --
----------------------
end loop;
end;
+ -- Binary operator cases. These can apply
+ -- to arrays for which we may need bounds.
+
+ elsif Nkind (N) in N_Binary_Op then
+ Note_Uplevel_Bound (Left_Opnd (N), Ref);
+ Note_Uplevel_Bound (Right_Opnd (N), Ref);
+
+ -- Unary operator case
+
+ elsif Nkind (N) in N_Unary_Op then
+ Note_Uplevel_Bound (Right_Opnd (N), Ref);
+
+ -- Explicit dereference case
+
+ elsif Nkind (N) = N_Explicit_Dereference then
+ Note_Uplevel_Bound (Prefix (N), Ref);
+
-- Conversion case
elsif Nkind (N) = N_Type_Conversion then
procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is
L : constant Nat := Get_Level (Subp, E);
+ -- Subprograms declared in tasks and protected types cannot
+ -- be eliminated because calls to them may be in other units,
+ -- so they must be treated as reachable.
+
begin
Subps.Append
((Ent => E,
Bod => Bod,
Lev => L,
- Reachable => False,
+ Reachable => In_Synchronized_Unit (E),
Uplevel_Ref => L,
Declares_AREC => False,
Uents => No_Elist,
-- no relevant code generation.
when N_Component_Association =>
- if No (Etype (Expression (N))) then
+ if No (Expression (N))
+ or else No (Etype (Expression (N)))
+ then
return Skip;
end if;
end;
end if;
+ -- For EQ/NE comparisons, we need the type of the operands
+ -- in order to do the comparison, which means we need the
+ -- bounds.
+
+ when N_Op_Eq | N_Op_Ne =>
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Left_Opnd (N)), Empty, DT);
+ Check_Static_Type (Etype (Right_Opnd (N)), Empty, DT);
+ end;
+
+ -- Likewise we need the sizes to compute how much to move in
+ -- an assignment.
+
+ when N_Assignment_Statement =>
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Name (N)), Empty, DT);
+ Check_Static_Type (Etype (Expression (N)), Empty, DT);
+ end;
+
-- Record a subprogram. We record a subprogram body that acts
-- as a spec. Otherwise we record a subprogram declaration,
-- providing that it has a corresponding body we can get hold
return Skip;
end if;
+ -- Pragmas and component declarations can be ignored.
+
+ when N_Pragma | N_Component_Declaration =>
+ return Skip;
+
-- Otherwise record an uplevel reference in a local
-- identifier.
-- references to global declarations.
and then
- (Ekind_In (Ent, E_Constant, E_Variable)
+ (Ekind_In
+ (Ent, E_Constant, E_Variable, E_Loop_Parameter)
-- Formals are interesting, but not if being used as
-- mere names of parameters for name notation calls.
-- mark as requiring activation records.
exit when No (S);
- Subps.Table (Subp_Index (S)).Declares_AREC := True;
+
+ declare
+ SUBI : Subp_Entry renames Subps.Table (Subp_Index (S));
+ begin
+ SUBI.Declares_AREC := True;
+
+ -- If this entity was marked reachable because it is
+ -- in a task or protected type, there may not appear
+ -- to be any calls to it, which would normally
+ -- adjust the levels of the parent subprograms.
+ -- So we need to be sure that the uplevel reference
+ -- of that entity takes into account possible calls.
+
+ if In_Synchronized_Unit (SUBF.Ent)
+ and then SUBT.Lev < SUBI.Uplevel_Ref
+ then
+ SUBI.Uplevel_Ref := SUBT.Lev;
+ end if;
+ end;
+
exit when S = URJ.Callee;
end loop;
Decl : Node_Id;
begin
- -- Subprograms declared in tasks and protected types are
- -- reachable and cannot be eliminated.
-
- if In_Synchronized_Unit (STJ.Ent) then
- STJ.Reachable := True;
- end if;
-
-- Subprogram is reachable, copy and reset index
if STJ.Reachable then
-- right after the declaration of ARECnP.
-- For all other entities, we insert
-- the assignment immediately after the
- -- declaration of the entity.
+ -- declaration of the entity or after
+ -- the freeze node if present.
-- Note: we don't need to mark the entity
-- as being aliased, because the address
if Is_Formal (Ent) then
Ins := Decl_ARECnP;
+
+ elsif Has_Delayed_Freeze (Ent) then
+ Ins := Freeze_Node (Ent);
+
else
Ins := Dec;
end if;
New_Occurrence_Of (Ent, Loc),
Attribute_Name => Attr));
- Insert_After (Ins, Asn);
+ -- If we have a loop parameter, we have
+ -- to insert before the first statement
+ -- of the loop. Ins points to the
+ -- N_Loop_Parametrer_Specification.
+
+ if Ekind (Ent) = E_Loop_Parameter then
+ Ins := First (Statements
+ (Parent (Parent (Ins))));
+ Insert_Before (Ins, Asn);
+
+ else
+ Insert_After (Ins, Asn);
+ end if;
-- Analyze the assignment statement. We do
-- not need to establish the relevant scope
projects / gcc.git / commitdiff