-- does not contain the above constructs, the routine returns an empty
-- list.
- procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id);
- -- N is a construct that contains a handled sequence of statements, Fin_Id
- -- is the entity of a finalizer. Create an At_End handler that covers the
- -- statements of N and calls Fin_Id. If the handled statement sequence has
- -- an exception handler, the statements will be wrapped in a block to avoid
- -- unwanted interaction with the new At_End handler.
-
procedure Build_Record_Deep_Procs (Typ : Entity_Id);
-- Build the deep Initialize/Adjust/Finalize for a record Typ with
-- Has_Controlled_Component set and store them using the TSS mechanism.
Append_To (Decls, Fin_Spec);
- -- When the finalizer acts solely as a cleanup routine, the body
- -- is inserted right after the spec.
+ -- Manually freeze the spec. This is somewhat of a hack because a
+ -- subprogram is frozen when its body is seen and the freeze node
+ -- appears right before the body. However, in this case, the spec
+ -- must be frozen earlier since the At_End handler must be able to
+ -- call it.
+ --
+ -- declare
+ -- procedure Fin_Id; -- Spec
+ -- [Fin_Id] -- Freeze node
+ -- begin
+ -- ...
+ -- at end
+ -- Fin_Id; -- At_End handler
+ -- end;
- if Acts_As_Clean and not Has_Ctrl_Objs then
- Insert_After (Fin_Spec, Fin_Body);
+ Ensure_Freeze_Node (Fin_Id);
+ Insert_After (Fin_Spec, Freeze_Node (Fin_Id));
+ Mutate_Ekind (Fin_Id, E_Procedure);
+ Freeze_Extra_Formals (Fin_Id);
+ Set_Is_Frozen (Fin_Id);
- -- In other cases the body is inserted after the last statement
+ pragma Assert (Present (Stmts));
- else
- -- Manually freeze the spec. This is somewhat of a hack because
- -- a subprogram is frozen when its body is seen and the freeze
- -- node appears right before the body. However, in this case,
- -- the spec must be frozen earlier since the At_End handler
- -- must be able to call it.
- --
- -- declare
- -- procedure Fin_Id; -- Spec
- -- [Fin_Id] -- Freeze node
- -- begin
- -- ...
- -- at end
- -- Fin_Id; -- At_End handler
- -- end;
-
- Ensure_Freeze_Node (Fin_Id);
- Insert_After (Fin_Spec, Freeze_Node (Fin_Id));
- Mutate_Ekind (Fin_Id, E_Procedure);
- Freeze_Extra_Formals (Fin_Id);
- Set_Is_Frozen (Fin_Id);
-
- Append_To (Stmts, Fin_Body);
- end if;
+ Append_To (Stmts, Fin_Body);
end if;
Analyze (Fin_Spec, Suppress => All_Checks);
Spec_Id := Defining_Identifier (Spec_Id);
end if;
- -- Accept statement, block, entry body, package body, protected body,
- -- subprogram body or task body.
+ -- Block, entry body, package body, subprogram body or task body
else
Decls := Declarations (N);
end if;
end Build_Finalizer;
- --------------------------
- -- Build_Finalizer_Call --
- --------------------------
-
- procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id) is
- begin
- -- Do not perform this expansion in SPARK mode because we do not create
- -- finalizers in the first place.
-
- if GNATprove_Mode then
- return;
- end if;
-
- -- If the construct to be cleaned up is a protected subprogram body, the
- -- finalizer call needs to be associated with the block that wraps the
- -- unprotected version of the subprogram. The following illustrates this
- -- scenario:
-
- -- procedure Prot_SubpP is
- -- procedure finalizer is
- -- begin
- -- Service_Entries (Prot_Obj);
- -- Abort_Undefer;
- -- end finalizer;
-
- -- begin
- -- . . .
- -- begin
- -- Prot_SubpN (Prot_Obj);
- -- at end
- -- finalizer;
- -- end;
- -- end Prot_SubpP;
-
- declare
- Loc : constant Source_Ptr := Sloc (N);
-
- Is_Protected_Subp_Body : constant Boolean :=
- Nkind (N) = N_Subprogram_Body
- and then Is_Protected_Subprogram_Body (N);
- -- True if N is the protected version of a subprogram that belongs to
- -- a protected type.
-
- HSS : constant Node_Id :=
- (if Is_Protected_Subp_Body
- then Handled_Statement_Sequence
- (Last (Statements (Handled_Statement_Sequence (N))))
- else Handled_Statement_Sequence (N));
-
- -- We attach the At_End_Proc to the HSS if this is an accept
- -- statement or extended return statement. Also in the case of
- -- a protected subprogram, because if Service_Entries raises an
- -- exception, we do not lock the PO, so we also do not want to
- -- unlock it.
-
- Use_HSS : constant Boolean :=
- Nkind (N) in N_Accept_Statement | N_Extended_Return_Statement
- or else Is_Protected_Subp_Body;
-
- At_End_Proc_Bearer : constant Node_Id := (if Use_HSS then HSS else N);
- begin
- pragma Assert (No (At_End_Proc (At_End_Proc_Bearer)));
- Set_At_End_Proc (At_End_Proc_Bearer, New_Occurrence_Of (Fin_Id, Loc));
- -- Attach reference to finalizer to tree, for LLVM use
- Set_Parent (At_End_Proc (At_End_Proc_Bearer), At_End_Proc_Bearer);
- Analyze (At_End_Proc (At_End_Proc_Bearer));
- Expand_At_End_Handler (At_End_Proc_Bearer, Empty);
- end;
- end Build_Finalizer_Call;
-
---------------------
-- Build_Late_Proc --
---------------------
Fin_Id => Fin_Id);
if Present (Fin_Id) then
- Build_Finalizer_Call (N, Fin_Id);
+ pragma Assert (No (At_End_Proc (N)));
+ Set_At_End_Proc (N, New_Occurrence_Of (Fin_Id, Sloc (N)));
+ -- Attach reference to finalizer to tree for LLVM
+ Set_Parent (At_End_Proc (N), N);
+ Analyze (At_End_Proc (N));
+ Expand_At_End_Handler (N, Empty);
end if;
end;
end Expand_Cleanup_Actions;
-------------------------------
procedure Add_Shared_Var_Lock_Procs (N : Node_Id) is
+ Aft : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (N);
Obj : constant Entity_Id := Entity (Expression (First_Actual (N)));
- Vnm : String_Id;
- Vid : Entity_Id;
- Vde : Node_Id;
- Aft : constant List_Id := New_List;
In_Transient : constant Boolean := Scope_Is_Transient;
+ -- Whether we are already in a transient scope
- function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id;
- -- Return a procedure call statement for lock proc RTE
-
- --------------------------------
- -- Build_Shared_Var_Lock_Call --
- --------------------------------
+ function Current_Scope return Int renames Scope_Stack.Last;
+ -- Return the index of the current scope
- function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id is
- begin
- return
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE), Loc),
- Parameter_Associations =>
- New_List (New_Occurrence_Of (Vid, Loc)));
- end Build_Shared_Var_Lock_Call;
+ Vid : Entity_Id;
+ Vnm : String_Id;
-- Start of processing for Add_Shared_Var_Lock_Procs
-- If the lock/read/write/unlock actions for this object have already
-- been emitted in the current scope, no need to perform them anew.
- if In_Transient
- and then Contains (Scope_Stack.Table (Scope_Stack.Last)
- .Locked_Shared_Objects,
- Obj)
- then
- return;
+ if In_Transient then
+ if Contains (Scope_Stack.Table (Current_Scope).Locked_Shared_Objects,
+ Obj)
+ then
+ return;
+ end if;
+
+ else
+ Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
Build_Full_Name (Obj, Vnm);
- -- Declare a constant string to hold the name of the shared object.
- -- Note that this must occur outside of the transient scope, as the
- -- scope's finalizer needs to have access to this object. Also, it
- -- appears that GIGI does not support elaborating string literal
- -- subtypes in transient scopes.
+ -- Declare a constant string to hold the name of the shared object
Vid := Make_Temporary (Loc, 'N', Obj);
- Vde :=
+ Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Vid,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
- Expression => Make_String_Literal (Loc, Vnm));
-
- -- Already in a transient scope. Make sure that we insert Vde outside
- -- that scope.
-
- if In_Transient then
- Insert_Before_And_Analyze (Node_To_Be_Wrapped, Vde);
-
- -- Not in a transient scope yet: insert Vde as an action on N prior to
- -- establishing one.
-
- else
- Insert_Action (N, Vde);
- Establish_Transient_Scope (N, Manage_Sec_Stack => False);
- end if;
+ Expression => Make_String_Literal (Loc, Vnm)));
-- Mark object as locked in the current (transient) scope
Append_New_Elmt
- (Obj,
- To => Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects);
+ (Obj, Scope_Stack.Table (Current_Scope).Locked_Shared_Objects);
-- First insert the Lock call before
- Insert_Action (N, Build_Shared_Var_Lock_Call (RE_Shared_Var_Lock));
+ Insert_Action (N,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Shared_Var_Lock), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Vid, Loc))));
-- Now, right after the Lock, insert a call to read the object
-- Finally insert the Unlock call
- Append_To (Aft, Build_Shared_Var_Lock_Call (RE_Shared_Var_Unlock));
+ Append_To (Aft,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Shared_Var_Unlock), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Vid, Loc))));
-- Store cleanup actions in transient scope
projects / thirdparty / gcc.git / commitdiff
