with Exp_Ch9; use Exp_Ch9;
with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
+with Exp_Dist; use Exp_Dist;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
+with Lib; use Lib;
with Hostparm; use Hostparm;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
-with Targparm; use Targparm;
with Sinfo; use Sinfo;
with Sem; use Sem;
with Sem_Ch3; use Sem_Ch3;
and then Controlled_Type (Corresponding_Record_Type (T)));
end Controlled_Type;
+ ---------------------------
+ -- CW_Or_Controlled_Type --
+ ---------------------------
+
+ function CW_Or_Controlled_Type (T : Entity_Id) return Boolean is
+ begin
+ return Is_Class_Wide_Type (T) or else Controlled_Type (T);
+ end CW_Or_Controlled_Type;
+
--------------------------
-- Controller_Component --
--------------------------
Atyp := Etype (Arg);
end if;
- if Is_Abstract (Proc) and then Is_Tagged_Type (Ftyp) then
+ if Is_Abstract_Subprogram (Proc) and then Is_Tagged_Type (Ftyp) then
return Unchecked_Convert_To (Class_Wide_Type (Ftyp), Arg);
elsif Ftyp /= Atyp
Loc : constant Source_Ptr := Sloc (N);
Wrap_Node : Node_Id;
- Sec_Stk : constant Boolean :=
- Sec_Stack and not Functions_Return_By_DSP_On_Target;
- -- We never need a secondary stack if functions return by DSP
-
begin
-- Do not create a transient scope if we are already inside one
for S in reverse Scope_Stack.First .. Scope_Stack.Last loop
-
if Scope_Stack.Table (S).Is_Transient then
- if Sec_Stk then
+ if Sec_Stack then
Set_Uses_Sec_Stack (Scope_Stack.Table (S).Entity);
end if;
New_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));
Set_Scope_Is_Transient;
- if Sec_Stk then
+ if Sec_Stack then
Set_Uses_Sec_Stack (Current_Scope);
Check_Restriction (No_Secondary_Stack, N);
end if;
-- Expand_N_Package_Body --
---------------------------
- -- Add call to Activate_Tasks if body is an activator (actual
- -- processing is in chapter 9).
+ -- Add call to Activate_Tasks if body is an activator (actual processing
+ -- is in chapter 9).
-- Generate subprogram descriptor for elaboration routine
- -- ENcode entity names in package body
+ -- Encode entity names in package body
procedure Expand_N_Package_Body (N : Node_Id) is
Ent : constant Entity_Id := Corresponding_Spec (N);
-- whether a body will eventually appear.
procedure Expand_N_Package_Declaration (N : Node_Id) is
+ Spec : constant Node_Id := Specification (N);
+ Decls : List_Id;
+
+ No_Body : Boolean;
+ -- True in the case of a package declaration that is a compilation unit
+ -- and for which no associated body will be compiled in
+ -- this compilation.
begin
- if Nkind (Parent (N)) = N_Compilation_Unit
- and then not Body_Required (Parent (N))
+
+ No_Body := False;
+
+ -- Case of a package declaration other than a compilation unit
+
+ if Nkind (Parent (N)) /= N_Compilation_Unit then
+ null;
+
+ -- Case of a compilation unit that does not require a body
+
+ elsif not Body_Required (Parent (N))
and then not Unit_Requires_Body (Defining_Entity (N))
- and then Present (Activation_Chain_Entity (N))
then
+ No_Body := True;
+
+ -- Special case of generating calling stubs for a remote call interface
+ -- package: even though the package declaration requires one, the
+ -- body won't be processed in this compilation (so any stubs for RACWs
+ -- declared in the package must be generated here, along with the
+ -- spec).
+
+ elsif Parent (N) = Cunit (Main_Unit)
+ and then Is_Remote_Call_Interface (Defining_Entity (N))
+ and then Distribution_Stub_Mode = Generate_Caller_Stub_Body
+ then
+ No_Body := True;
+ end if;
+
+ -- For a package declaration that implies no associated body, generate
+ -- task activation call and RACW supporting bodies now (since we won't
+ -- have a specific separate compilation unit for that).
+
+ if No_Body then
+
New_Scope (Defining_Entity (N));
- Build_Task_Activation_Call (N);
+
+ if Has_RACW (Defining_Entity (N)) then
+
+ -- Generate RACW subprogram bodies
+
+ Decls := Private_Declarations (Spec);
+
+ if No (Decls) then
+ Decls := Visible_Declarations (Spec);
+ end if;
+
+ if No (Decls) then
+ Decls := New_List;
+ Set_Visible_Declarations (Spec, Decls);
+ end if;
+
+ Append_RACW_Bodies (Decls, Defining_Entity (N));
+ Analyze_List (Decls);
+ end if;
+
+ if Present (Activation_Chain_Entity (N)) then
+
+ -- Generate task activation call as last step of elaboration
+
+ Build_Task_Activation_Call (N);
+ end if;
+
Pop_Scope;
end if;
Selector_Name => Make_Identifier (Loc, Name_F));
-- Case of a dynamically allocated object. The final list is the
- -- corresponding list controller (The next entity in the scope of
- -- the access type with the right type). If the type comes from a
- -- With_Type clause, no controller was created, and we use the
- -- global chain instead.
+ -- corresponding list controller (the next entity in the scope of the
+ -- access type with the right type). If the type comes from a With_Type
+ -- clause, no controller was created, we use the global chain instead.
- elsif Is_Access_Type (E) then
+ -- An anonymous access type either has a list created for it when the
+ -- allocator is a for an access parameter or an access discriminant,
+ -- or else it uses the list of the enclosing dynamic scope, when the
+ -- context is a declaration or an assignment.
+
+ elsif Is_Access_Type (E)
+ and then Ekind (E) /= E_Anonymous_Access_Type
+ then
if not From_With_Type (E) then
return
Make_Selected_Component (Loc,
if Prim = Finalize_Case or else Prim = Adjust_Case then
Handler := New_List (
- Make_Exception_Handler (Loc,
+ Make_Implicit_Exception_Handler (Loc,
Exception_Choices => New_List (Make_Others_Choice (Loc)),
Statements => New_List (
Make_Raise_Program_Error (Loc,
Set_Uses_Sec_Stack (Current_Scope, False);
if not Requires_Transient_Scope (Etype (S)) then
- if not Functions_Return_By_DSP_On_Target then
- Set_Uses_Sec_Stack (S, True);
- Check_Restriction (No_Secondary_Stack, Action);
- end if;
+ Set_Uses_Sec_Stack (S, True);
+ Check_Restriction (No_Secondary_Stack, Action);
end if;
exit;
elsif K = E_Procedure
or else K = E_Block
then
- if not Functions_Return_By_DSP_On_Target then
- Set_Uses_Sec_Stack (S, True);
- Check_Restriction (No_Secondary_Stack, Action);
- end if;
-
+ Set_Uses_Sec_Stack (S, True);
+ Check_Restriction (No_Secondary_Stack, Action);
Set_Uses_Sec_Stack (Current_Scope, False);
exit;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
function Controlled_Type (T : Entity_Id) return Boolean;
-- True if T potentially needs finalization actions
+ function CW_Or_Controlled_Type (T : Entity_Id) return Boolean;
+ -- True if T is either a potentially controlled type or a class-wide type.
+ -- Note that in normal mode, class-wide types are potentially controlled so
+ -- this function is different from Controlled_Type only under restrictions
+ -- No_Finalization.
+
function Find_Final_List
(E : Entity_Id;
Ref : Node_Id := Empty) return Node_Id;
- -- E is an entity representing a controlled object, a controlled type
- -- or a scope. If Ref is not empty, it is a reference to a controlled
- -- record, the closest Final list is in the controller component of
- -- the record containing Ref otherwise this function returns a
- -- reference to the final list attached to the closest dynamic scope
- -- (that can be E itself) creating this final list if necessary.
+ -- E is an entity representing a controlled object, a controlled type or a
+ -- scope. If Ref is not empty, it is a reference to a controlled record,
+ -- the closest Final list is in the controller component of the record
+ -- containing Ref otherwise this function returns a reference to the final
+ -- list attached to the closest dynamic scope (that can be E itself)
+ -- creating this final list if necessary.
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
-- E is a type entity. Give the same resul as Has_Controlled_Component
(Obj_Ref : Node_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return Node_Id;
- -- Attach the referenced object to the referenced Final Chain
- -- 'Flist_Ref' With_Attach is an expression of type Short_Short_Integer
- -- which can be either '0' to signify no attachment, '1' for
- -- attachement to a simply linked list or '2' for attachement to a
- -- doubly linked list.
+ -- Attach the referenced object to the referenced Final Chain 'Flist_Ref'
+ -- With_Attach is an expression of type Short_Short_Integer which can be
+ -- either '0' to signify no attachment, '1' for attachement to a simply
+ -- linked list or '2' for attachement to a doubly linked list.
function Make_Init_Call
(Ref : Node_Id;
Typ : Entity_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return List_Id;
- -- Ref is an expression (with no-side effect and is not required to
- -- have been previously analyzed) that references the object to be
- -- initialized. Typ is the expected type of Ref, which is a controlled
- -- type (Is_Controlled) or a type with controlled components
- -- (Has_Controlled). With_Attach is an integer expression representing
- -- the level of attachment, see Attach_To_Final_List's Nb_Link param
- -- documentation in s-finimp.ads.
+ -- Ref is an expression (with no-side effect and is not required to have
+ -- been previously analyzed) that references the object to be initialized.
+ -- Typ is the expected type of Ref, which is either a controlled type
+ -- (Is_Controlled) or a type with controlled components (Has_Controlled).
+ -- With_Attach is an integer expression which is the attchment level,
+ -- see System.Finalization_Implementation.Attach_To_Final_List for the
+ -- documentation of Nb_Link.
--
- -- This function will generate the appropriate calls to make
- -- sure that the objects referenced by Ref are initialized. The
- -- generate code is quite different depending on the fact the type
- -- IS_Controlled or HAS_Controlled but this is not the problem of the
- -- caller, the details are in the body.
+ -- This function will generate the appropriate calls to make sure that the
+ -- objects referenced by Ref are initialized. The generated code is quite
+ -- different for an IS_Controlled type or a HAS_Controlled type, but this
+ -- is not the problem for the caller, the details are in the body.
function Make_Adjust_Call
(Ref : Node_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id;
Allocator : Boolean := False) return List_Id;
- -- Ref is an expression (with no-side effect and is not required to
- -- have been previously analyzed) that references the object to be
- -- adjusted. Typ is the expected type of Ref, which is a controlled
- -- type (Is_Controlled) or a type with controlled components
- -- (Has_Controlled). With_Attach is an integer expression representing
- -- the level of attachment, see Attach_To_Final_List's Nb_Link param
- -- documentation in s-finimp.ads. Note: if Typ is Finalize_Storage_Only
- -- and the object is at library level, then With_Attach will be ignored,
- -- and a zero link level will be passed to Attach_To_Final_List.
+ -- Ref is an expression (with no-side effect and is not required to have
+ -- been previously analyzed) that references the object to be adjusted. Typ
+ -- is the expected type of Ref, which is a controlled type (Is_Controlled)
+ -- or a type with controlled components (Has_Controlled). With_Attach is an
+ -- integer expression giving the attachment level (see documentation of
+ -- Attach_To_Final_List.Nb_Link param documentation in s-finimp.ads.
+ -- Note: if Typ is Finalize_Storage_Only and the object is at library
+ -- level, then With_Attach will be ignored, and a zero link level will be
+ -- passed to Attach_To_Final_List.
--
- -- This function will generate the appropriate calls to make
- -- sure that the objects referenced by Ref are adjusted. The generated
- -- code is quite different depending on the fact the type IS_Controlled
- -- or HAS_Controlled but this is not the problem of the caller, the
- -- details are in the body. The objects must be attached when the adjust
- -- takes place after an initialization expression but not when it takes
- -- place after a regular assignment.
+ -- This function will generate the appropriate calls to make sure that the
+ -- objects referenced by Ref are adjusted. The generated code is quite
+ -- different depending on the fact the type IS_Controlled or HAS_Controlled
+ -- but this is not the problem of the caller, the details are in the body.
+ -- The objects must be attached when the adjust takes place after an
+ -- initialization expression but not when it takes place after a regular
+ -- assignment.
--
-- If Allocator is True, we are adjusting a newly-created object. The
-- existing chaining pointers should not be left unchanged, because they
(Ref : Node_Id;
Typ : Entity_Id;
With_Detach : Node_Id) return List_Id;
- -- Ref is an expression (with no-side effect and is not required
- -- to have been previously analyzed) that references the object to
- -- be Finalized. Typ is the expected type of Ref, which is a
- -- controlled type (Is_Controlled) or a type with controlled
- -- components (Has_Controlled). With_Detach is a boolean expression
- -- indicating whether to detach the controlled object from whatever
- -- finalization list it is currently attached to.
+ -- Ref is an expression (with no-side effect and is not required to have
+ -- been previously analyzed) that references the object to be Finalized.
+ -- Typ is the expected type of Ref, which is a controlled type
+ -- (Is_Controlled) or a type with controlled components (Has_Controlled).
+ -- With_Detach is a boolean expression indicating whether to detach the
+ -- controlled object from whatever finalization list it is currently
+ -- attached to.
--
- -- This function will generate the appropriate calls to make
- -- sure that the objects referenced by Ref are finalized. The generated
- -- code is quite different depending on the fact the type IS_Controlled
- -- or HAS_Controlled but this is not the problem of the caller, the
- -- details are in the body. The objects must be detached when finalizing
- -- an unchecked deallocated object but not when finalizing the target of
- -- an assignment, it is not necessary either on scope exit.
+ -- This function will generate the appropriate calls to make sure that the
+ -- objects referenced by Ref are finalized. The generated code is quite
+ -- different depending on the fact the type IS_Controlled or HAS_Controlled
+ -- but this is not the problem of the caller, the details are in the body.
+ -- The objects must be detached when finalizing an unchecked deallocated
+ -- object but not when finalizing the target of an assignment, it is not
+ -- necessary either on scope exit.
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- Expand a call to a function returning a controlled value. That is to
(N : Node_Id;
Obj : Node_Id;
Typ : Entity_Id) return List_Id;
- -- Generate loops to finalize any tasks or simple protected objects
- -- that are subcomponents of an array.
+ -- Generate loops to finalize any tasks or simple protected objects that
+ -- are subcomponents of an array.
function Cleanup_Protected_Object
(N : Node_Id;
-- Check whether composite type contains a simple protected component
function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
- -- Check whether argument is a protected type without entries.
- -- Protected types with entries are controlled, and their cleanup
- -- is handled by the standard finalization machinery. For simple
- -- protected types we generate inline code to release their locks.
+ -- Check whether argument is a protected type without entries. Protected
+ -- types with entries are controlled, and their cleanup is handled by the
+ -- standard finalization machinery. For simple protected types we generate
+ -- inline code to release their locks.
--------------------------------
-- Transient Scope Management --
-- return the node to be wrapped if the current scope is transient
procedure Store_Before_Actions_In_Scope (L : List_Id);
- -- Append the list L of actions to the end of the before-actions store
- -- in the top of the scope stack
+ -- Append the list L of actions to the end of the before-actions store in
+ -- the top of the scope stack
procedure Store_After_Actions_In_Scope (L : List_Id);
- -- Append the list L of actions to the beginning of the after-actions
- -- store in the top of the scope stack
+ -- Append the list L of actions to the beginning of the after-actions store
+ -- in the top of the scope stack
procedure Wrap_Transient_Declaration (N : Node_Id);
-- N is an object declaration. Expand the finalization calls after the
projects / platform / upstream / gcc.git / commitdiff