Skip to content

R
riscv-gcc-1
Commit f937473f by Robert Dewar Committed by Arnaud Charlet
Options

einfo.ads, einfo.adb: (First_Component_Or_Discriminant): New function 

2007-04-06  Robert Dewar  <dewar@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* einfo.ads, einfo.adb: (First_Component_Or_Discriminant): New function
	(Next_Component_Or_Discriminant): New function and procedure
	(First_Index, First_Literal, Master_Id,
	Set_First_Index, Set_First_Literal, Set_Master_Id):
	Add missing Ekind assertions.
	(Is_Access_Protected_Subprogram_Type): New predicate.
	(Has_RACW): New entity flag, set on package entities to indicate that
	the package contains the declaration of a remote accecss-to-classwide
	type.
	(E_Return_Statement): This node type has the Finalization_Chain_Entity
	attribute, in case the result type has controlled parts.
	(Requires_Overriding): Add this new flag, because "requires
	overriding" is subtly different from "is abstract" (see AI-228).
	(Is_Abstract): Split Is_Abstract flag into Is_Abstract_Subprogram and
	Is_Abstract_Type. Make sure these are called only when appropriate.
	(Has_Pragma_Unreferenced_Objects): New flag

	* exp_ch5.adb (Expand_N_Assignment_Statement): If the left-hand side is
	class-wide, the tag of the right-hand side must be an exact match, not
	an ancestor of that of the object on left-hand side.
	(Move_Activation_Chain): New procedure to create the call to
	System.Tasking.Stages.Move_Activation_Chain.
	(Expand_N_Extended_Return_Statement): Generate code to call
	System.Finalization_Implementation.Move_Final_List at the end of a
	return statement if the function's result type has controlled parts.
	Move asserts to Build_In_Place_Formal.
	(Move_Final_List): New function to create the call statement.
	(Expand_N_Assignment_Statement): In case of assignment to a class-wide
	tagged type, replace generation of call to the run-time subprogram
	CW_Membership by call to Build_CW_Membership.
	(Expand_N_Return_Statement): Replace generation of call to the run-time
	subprogram Get_Access_Level by call to Build_Get_Access_Level.
	(Expand_N_Simple_Function_Return): Replace generation of call to the
	run-time subprogram Get_Access_Level by call to Build_Get_Access_Level.

	* exp_ch6.ads, exp_ch6.adb (Expand_Call): Use new predicate
	Is_Access_Protected_Subprogram_Type, to handle both named and anonymous
	access to protected operations.
	(Add_Task_Actuals_To_Build_In_Place_Call): New procedure to add the
	master and chain actual parameters to a build-in-place function call
	involving tasks.
	(BIP_Formal_Suffix): Add new enumeration literals to complete the case
	statement.
	(Make_Build_In_Place_Call_In_Allocator,
	Make_Build_In_Place_Call_In_Anonymous_Context,
	Make_Build_In_Place_Call_In_Assignment,
	Make_Build_In_Place_Call_In_Object_Declaration): Call
	Add_Task_Actuals_To_Build_In_Place_Call with the appropriate master.
	(Expand_Inlined_Call): If the subprogram is a null procedure, or a
	stubbed procedure with a null body, replace the call with a null
	statement without using the full inlining machinery, for efficiency
	and to avoid invalid values in source file table entries.

	* exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Add support for
	renamings of calls to build-in-place functions.

	* rtsfind.adb (RTE_Record_Component_Available): New subprogram that
	provides the functionality of RTE_Available to record components.
	(RTU_Entity): The function Entity has been renamed to RTU_Entity
	to avoid undesired overloading.
	(Entity): New subprogram that returns the entity for the referened
	unit. If this unit has not been loaded, it returns Empty.
	(RE_Activation_Chain_Access, RE_Move_Activation_Chain): New entities.
	Remove no longer used entities.
	(RE_Finalizable_Ptr_Ptr, RE_Move_Final_List): New entities.
	(RE_Type_Specific_Data): New entity.
	(RE_Move_Any_Value): New entity.
	(RE_TA_A, RE_Get_Any_Type): New entities.
	(RE_Access_Level, RE_Dispatch_Table, E_Default_Prim_Op_Count,
	 RE_Prims_Ptr, RE_RC_Offset, RE_Remotely_Callable,
	 RE_DT_Typeinfo_Ptr_Size, RE_Cstring_Ptr, RE_DT_Expanded_Name): Added.
	(Entity): New subprogram that returns the entity for the referened
	unit. If this unit has not been loaded, it returns Empty.
	(RTE): Addition of a new formal that extends the search to the scopes
	of the record types found in the chain of the package.

	* sem_ch6.ads, sem_ch6.adb (Check_Overriding_Indicator): Print
	"abstract subprograms must be visible" message, whether or not the type
	is an interface; that is, remove the special case for interface types.
	(Analyze_Function_Return): Remove error message "return of task objects
	is not yet implemented" because this is now implemented.
	(Create_Extra_Formals): Add the extra master and activation chain
	formals in case the result type has tasks.
	Remove error message "return of limited controlled objects is not yet
	implemented".
	(Create_Extra_Formals): Add the extra caller's finalization list formal
	in case the result type has controlled parts.
	(Process_Formals): In case of access formal types there is no need
	to continue with the analysis of the formals if we already notified
	errors.
	(Check_Overriding_Indicator): Add code to check overriding of predefined
	operators.
	(Create_Extra_Formals): Prevent creation of useless Extra_Constrained
	flags for formals that do not require them,.
	(Enter_Overloaded_Entity): Do not give -gnatwh warning message unless
	hidden entity is use visible or directly visible.
	(Analyze_Abstract_Subprogram_Declaration,Analyze_Subprogram_Body,
	Analyze_Subprogram_Declaration,Analyze_Subprogram_Specification,
	Check_Conventions,Check_Delayed_Subprogram,Make_Inequality_Operator,
	New_Overloaded_Entity): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.

	* s-finimp.ads, s-finimp.adb (Move_Final_List): New procedure to move
	a return statement's finalization list to the caller's list, used for
	build-in-place functions with result type with controlled parts.
	Remove no longer used entities.

	* s-taskin.ads (Activation_Chain): Remove pragma Volatile. It is no
	longer needed, because the full type is now limited, and therefore a
	pass-by-reference type.
	(Foreign_Task_Level): New constant.

	* s-tassta.ads, s-tassta.adb (Move_Activation_Chain): New procedure to
	move tasks from the activation chain belonging to a return statement to
	the one passed in by the caller, and update the master to the one
	passed in by the caller.
	(Vulnerable_Complete_Master, Check_Unactivated_Tasks): Check the master
	of unactivated tasks, so we don't kill the ones that are being returned
	by a build-in-place function.
	(Create_Task): Ignore AI-280 for foreign threads.

From-SVN: r123558
parent 9dac0a42
Showing with 287 additions and 179 deletions
gcc/ada/exp_ch6.ads
......@@ -40,21 +40,83 @@ package Exp_Ch6 is
-- This procedure contains common processing for Expand_N_Function_Call,
-- Expand_N_Procedure_Statement, and Expand_N_Entry_Call.
procedure Freeze_Subprogram (N : Node_Id);
-- generate the appropriate expansions related to Subprogram freeze
-- nodes (e. g. the filling of the corresponding Dispatch Table for
-- Primitive Operations)
-- The following type defines the various forms of allocation used for the
-- results of build-in-place function calls.
type BIP_Allocation_Form is
(Unspecified,
Caller_Allocation,
Secondary_Stack,
Global_Heap,
User_Storage_Pool);
type BIP_Formal_Kind is
-- Ada 2005 (AI-318-02): This type defines the kinds of implicit extra
-- formals created for build-in-place functions. The order of the above
-- enumeration literals matches the order in which the formals are
-- declared. See Sem_Ch6.Create_Extra_Formals.
(BIP_Alloc_Form,
-- Present if result subtype is unconstrained. Indicates whether the
-- return object is allocated by the caller or callee, and if the
-- callee, whether to use the secondary stack or the heap. See
-- Create_Extra_Formals.
BIP_Final_List,
-- Present if result type has controlled parts. Pointer to caller's
-- finalization list.
BIP_Master,
-- Present if result type contains tasks. Master associated with
-- calling context.
BIP_Activation_Chain,
-- Present if result type contains tasks. Caller's activation chain.
BIP_Object_Access);
-- Present for all build-in-place functions. Address at which to place
-- the return object, or null if BIP_Alloc_Form indicates
-- allocated by callee.
-- ??? We also need to be able to pass in some way to access a
-- user-defined storage pool at some point. And perhaps a constrained
-- flag.
function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String;
-- Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names
-- for build-in-place formal parameters of the given kind.
function Build_In_Place_Formal
(Func : Entity_Id;
Kind : BIP_Formal_Kind) return Entity_Id;
-- Ada 2005 (AI-318-02): Locates and returns the entity for the implicit
-- build-in-place formal parameter of the given kind associated with the
-- function Func, and returns its Entity_Id. It is a bug if not found; the
-- caller should ensure this is called only when the extra formal exists.
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if E denotes a function or an
-- access-to-function type whose result must be built in place; otherwise
-- returns False. Currently this is restricted to the subset of functions
-- whose result subtype is a constrained inherently limited type.
-- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic
-- function, or access-to-function type whose result must be built in
-- place; otherwise returns False. For Ada 2005, this is currently
-- restricted to the set of functions whose result subtype is an inherently
-- limited type. In Ada 95, this must be False for inherently limited
-- result types (but currently returns False for all Ada 95 functions).
-- Eventually we plan to support build-in-place for nonlimited types.
-- Build-in-place is usually more efficient for large things, and less
-- efficient for small things. However, we never use build-in-place if the
-- convention is other than Ada, because that would disturb mixed-language
-- programs. Note that for the non-inherently-limited cases, we must make
-- the same decision for Ada 95 and 2005, so that mixed-dialect programs
-- will work.
function Is_Build_In_Place_Function_Call (N : Node_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if N denotes a call to a function
-- that requires handling as a build-in-place call or is a qualified
-- expression applied to such a call; otherwise returns False.
procedure Freeze_Subprogram (N : Node_Id);
-- generate the appropriate expansions related to Subprogram freeze
-- nodes (e. g. the filling of the corresponding Dispatch Table for
-- Primitive Operations)
function Is_Build_In_Place_Function_Return (N : Node_Id) return Boolean;
-- Ada 2005 (AI-318-02): Returns True if N is an N_Return_Statement or
-- N_Extended_Return_Statement and it applies to a build-in-place function
-- or generic function.
procedure Make_Build_In_Place_Call_In_Allocator
(Allocator : Node_Id;
......@@ -84,7 +146,7 @@ package Exp_Ch6 is
Function_Call : Node_Id);
-- Ada 2005 (AI-318-02): Handle a call to a build-in-place function that
-- occurs as the right-hand side of an assignment statement by passing
-- access to the left-hand sid as an additional parameter of the function
-- access to the left-hand side as an additional parameter of the function
-- call. Assign must denote a N_Assignment_Statement. Function_Call must
-- denote either an N_Function_Call node for which Is_Build_In_Place_Call
-- is True, or an N_Qualified_Expression node applied to such a function
......
gcc/ada/exp_ch8.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2004 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- --
......@@ -26,10 +26,12 @@
with Atree; use Atree;
with Einfo; use Einfo;
with Exp_Ch6; use Exp_Ch6;
with Exp_Dbug; use Exp_Dbug;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8;
with Sinfo; use Sinfo;
......@@ -268,6 +270,19 @@ package body Exp_Ch8 is
end if;
end if;
-- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
-- place function, then a temporary return object needs to be created
-- and access to it must be passed to the function. Currently we limit
-- such functions to those with inherently limited result subtypes, but
-- eventually we plan to expand the functions that are treated as
-- build-in-place to include other composite result types.
if Ada_Version >= Ada_05
and then Is_Build_In_Place_Function_Call (Nam)
then
Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
end if;
-- Create renaming entry for debug information
Decl := Debug_Renaming_Declaration (N);
......
gcc/ada/s-finimp.adb
......@@ -168,7 +168,7 @@ package body System.Finalization_Implementation is
Nb_Link : Short_Short_Integer)
is
begin
-- Simple case: attachement to a one way list
-- Simple case: attachment to a one way list
if Nb_Link = 1 then
Obj.Next := L;
......@@ -176,7 +176,7 @@ package body System.Finalization_Implementation is
-- Dynamically allocated objects: they are attached to a doubly linked
-- list, so that an element can be finalized at any moment by means of
-- an unchecked deallocation. Attachement is protected against
-- an unchecked deallocation. Attachment is protected against
-- multi-threaded access.
elsif Nb_Link = 2 then
......@@ -203,7 +203,7 @@ package body System.Finalization_Implementation is
raise;
end Locked_Processing;
-- Attachement of arrays to the final list (used only for objects
-- Attachment of arrays to the final list (used only for objects
-- returned by function). Obj, in this case is the last element,
-- but all other elements are already threaded after it. We just
-- attach the rest of the final list at the end of the array list.
......@@ -231,32 +231,6 @@ package body System.Finalization_Implementation is
end Attach_To_Final_List;
---------------------
-- Deep_Tag_Adjust --
---------------------
procedure Deep_Tag_Adjust
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer)
is
V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
Controller : constant RC_Ptr := Get_Deep_Controller (A);
begin
if Controller /= null then
Adjust (Controller.all);
Attach_To_Final_List (L, Controller.all, B);
end if;
-- Is controlled
if V.all in Finalizable then
Adjust (V.all);
Attach_To_Final_List (L, Finalizable (V.all), 1);
end if;
end Deep_Tag_Adjust;
---------------------
-- Deep_Tag_Attach --
----------------------
......@@ -280,74 +254,6 @@ package body System.Finalization_Implementation is
end if;
end Deep_Tag_Attach;
-----------------------
-- Deep_Tag_Finalize --
-----------------------
procedure Deep_Tag_Finalize
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Boolean)
is
pragma Warnings (Off, L);
V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
Controller : constant RC_Ptr := Get_Deep_Controller (A);
begin
if Controller /= null then
if B then
Finalize_One (Controller.all);
else
Finalize (Controller.all);
end if;
end if;
-- Is controlled
if V.all in Finalizable then
if B then
Finalize_One (V.all);
else
Finalize (V.all);
end if;
end if;
end Deep_Tag_Finalize;
-------------------------
-- Deep_Tag_Initialize --
-------------------------
procedure Deep_Tag_Initialize
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer)
is
V : constant SFR.Finalizable_Ptr := To_Finalizable_Ptr (A);
Controller : constant RC_Ptr := Get_Deep_Controller (A);
begin
-- This procedure should not be called if the object has no
-- controlled components
if Controller = null then
raise Program_Error;
-- Has controlled components
else
Initialize (Controller.all);
Attach_To_Final_List (L, Controller.all, B);
end if;
-- Is controlled
if V.all in Finalizable then
Initialize (V.all);
Attach_To_Final_List (Controller.F, Finalizable (Controller.all), 1);
end if;
end Deep_Tag_Initialize;
-----------------------------
-- Detach_From_Final_List --
-----------------------------
......@@ -441,7 +347,7 @@ package body System.Finalization_Implementation is
-- programs using controlled types heavily.
if System.Restrictions.Abort_Allowed then
X := To_Ptr (System.Soft_Links.Get_Current_Excep.all).Id;
X := To_Ptr (SSL.Get_Current_Excep.all).Id;
end if;
while P /= null loop
......@@ -554,6 +460,34 @@ package body System.Finalization_Implementation is
Object.My_Address := Object'Address;
end Initialize;
---------------------
-- Move_Final_List --
---------------------
procedure Move_Final_List
(From : in out SFR.Finalizable_Ptr;
To : Finalizable_Ptr_Ptr)
is
begin
-- This is currently called at the end of the return statement, and the
-- caller does NOT defer aborts. We need to defer aborts to prevent
-- mangling the finalization lists.
SSL.Abort_Defer.all;
-- Put the return statement's finalization list onto the caller's one,
-- thus transferring responsibility for finalization of the return
-- object to the caller.
Attach_To_Final_List (To.all, From.all, Nb_Link => 3);
-- Empty the return statement's finalization list, so that when the
-- cleanup code executes, there will be nothing to finalize.
From := null;
SSL.Abort_Undefer.all;
end Move_Final_List;
-------------------------
-- Raise_From_Finalize --
-------------------------
......
gcc/ada/s-finimp.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006 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- --
......@@ -51,15 +51,15 @@ package System.Finalization_Implementation is
Collection_Finalization_Started : constant SFR.Finalizable_Ptr :=
To_Finalizable_Ptr (SSE.To_Address (1));
-- This is used to implement the rule in RM-4.8(10.2/2) that requires an
-- This is used to implement the rule in RM 4.8(10.2/2) that requires an
-- allocator to raise Program_Error if the collection finalization has
-- already started. See also Ada.Finalization.List_Controller. Finalize on
-- List_Controller first sets the list to Collection_Finalization_Started,
-- to indicate that finalization has started. An allocator will call
-- Attach_To_Final_List, which checks for the special value and raises
-- Program_Error if appropriate. The value of
-- Collection_Finalization_Started must be different from 'Access of any
-- finalizable object, and different from null. See AI-280.
-- Program_Error if appropriate. The Collection_Finalization_Started value
-- must be different from 'Access of any finalizable object, and different
-- from null. See AI-280.
Global_Final_List : SFR.Finalizable_Ptr;
-- This list stores the controlled objects defined in library-level
......@@ -72,60 +72,52 @@ package System.Finalization_Implementation is
(L : in out SFR.Finalizable_Ptr;
Obj : in out SFR.Finalizable;
Nb_Link : Short_Short_Integer);
-- Attach finalizable object Obj to the linked list L. Nb_Link controls
-- the number of link of the linked_list, and can be either 0 for no
-- attachement, 1 for simple linked lists or 2 for doubly linked lists
-- or even 3 for a simple attachement of a whole array of elements.
-- Attachement to a simply linked list is not protected against
-- concurrent access and should only be used in contexts where it
-- doesn't matter, such as for objects allocated on the stack. In the
-- case of an attachment on a doubly linked list, L must not be null
-- and Obj will be inserted AFTER the first element and the attachment
-- is protected against concurrent call. Typically used to attach to
-- a dynamically allocated object to a List_Controller (whose first
-- element is always a dummy element)
-- Attach finalizable object Obj to the linked list L. Nb_Link controls the
-- number of link of the linked_list, and is one of: 0 for no attachment, 1
-- for simple linked lists or 2 for doubly linked lists or even 3 for a
-- simple attachment of a whole array of elements. Attachment to a simply
-- linked list is not protected against concurrent access and should only
-- be used in contexts where it doesn't matter, such as for objects
-- allocated on the stack. In the case of an attachment on a doubly linked
-- list, L must not be null and Obj will be inserted AFTER the first
-- element and the attachment is protected against concurrent call.
-- Typically used to attach to a dynamically allocated object to a
-- List_Controller (whose first element is always a dummy element)
type Finalizable_Ptr_Ptr is access all SFR.Finalizable_Ptr;
-- A pointer to a finalization list. This is used as the type of the extra
-- implicit formal which are passed to build-in-place functions that return
-- controlled types (see Sem_Ch6). That extra formal is then passed on to
-- Move_Final_List (below).
procedure Move_Final_List
(From : in out SFR.Finalizable_Ptr;
To : Finalizable_Ptr_Ptr);
-- Move all objects on From list to To list. This is used to implement
-- build-in-place function returns. The return object is initially placed
-- on a finalization list local to the return statement, in case the
-- return statement is left prematurely (due to raising an exception,
-- being aborted, or a goto or exit statement). Once the return statement
-- has completed successfully, Move_Final_List is called to move the
-- return object to the caller's finalization list.
procedure Finalize_List (L : SFR.Finalizable_Ptr);
-- Call Finalize on each element of the list L;
procedure Finalize_One (Obj : in out SFR.Finalizable);
-- Call Finalize on Obj and remove its final list.
-- Call Finalize on Obj and remove its final list
---------------------
-- Deep Procedures --
---------------------
procedure Deep_Tag_Initialize
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer);
-- Generic initialize for tagged objects with controlled components.
-- A is the address of the object, L the finalization list when it needs
-- to be attached and B the attachement level (see Attach_To_Final_List).
procedure Deep_Tag_Adjust
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer);
-- Generic adjust for tagged objects with controlled components.
-- A is the address of the object, L the finalization list when it needs
-- to be attached and B the attachement level (see Attach_To_Final_List).
procedure Deep_Tag_Finalize
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Boolean);
-- Generic finalize for tagged objects with controlled components.
-- A is the address of the object, L the finalization list when it needs
-- to be attached and B the attachement level (see Attach_To_Final_List).
procedure Deep_Tag_Attach
(L : in out SFR.Finalizable_Ptr;
A : System.Address;
B : Short_Short_Integer);
-- Generic attachement for tagged objects with controlled components.
-- Generic attachment for tagged objects with controlled components.
-- A is the address of the object, L the finalization list when it needs
-- to be attached and B the attachement level (see Attach_To_Final_List).
-- to be attached and B the attachment level (see Attach_To_Final_List).
-----------------------------
-- Record Controller Types --
......@@ -141,11 +133,11 @@ package System.Finalization_Implementation is
end record;
procedure Initialize (Object : in out Limited_Record_Controller);
-- Does nothing.
-- Does nothing currently.
procedure Finalize (Object : in out Limited_Record_Controller);
-- Finalize the controlled components of the enclosing record by
-- following the list starting at Object.F.
-- Finalize the controlled components of the enclosing record by following
-- the list starting at Object.F.
type Record_Controller is
new Limited_Record_Controller with record
......@@ -156,13 +148,13 @@ package System.Finalization_Implementation is
-- Initialize the field My_Address to the Object'Address
procedure Adjust (Object : in out Record_Controller);
-- Adjust the components and their finalization pointers by subtracting
-- by the offset of the target and the source addresses of the assignment.
-- Adjust the components and their finalization pointers by subtracting by
-- the offset of the target and the source addresses of the assignment.
-- Inherit Finalize from Limited_Record_Controller
procedure Detach_From_Final_List (Obj : in out SFR.Finalizable);
-- Remove the specified object from its Final list, which must be a
-- doubly linked list.
-- Remove the specified object from its Final list, which must be a doubly
-- linked list.
end System.Finalization_Implementation;
gcc/ada/s-taskin.ads
......@@ -364,10 +364,12 @@ package System.Tasking is
------------------------------------
type Activation_Chain is limited private;
-- Comment required ???
-- Linked list of to-be-activated tasks, linked through
-- Activation_Link. The order of tasks on the list is irrelevant, because
-- the priority rules will ensure that they actually start activating in
-- priority order.
type Activation_Chain_Access is access all Activation_Chain;
-- Comment required ???
type Task_Procedure_Access is access procedure (Arg : System.Address);
......@@ -651,11 +653,14 @@ package System.Tasking is
-- Normally, a task starts out with internal master nesting level one
-- larger than external master nesting level. It is incremented to one by
-- Enter_Master, which is called in the task body only if the compiler
-- thinks the task may have dependent tasks. It is set to for the
-- thinks the task may have dependent tasks. It is set to 1 for the
-- environment task, the level 2 is reserved for server tasks of the
-- run-time system (the so called "independent tasks"), and the level 3 is
-- for the library level tasks.
-- for the library level tasks. Foreign threads which are detected by
-- the run-time have a level of 0, allowing these tasks to be easily
-- distinguished if needed.
Foreign_Task_Level : constant Master_Level := 0;
Environment_Task_Level : constant Master_Level := 1;
Independent_Task_Level : constant Master_Level := 2;
Library_Task_Level : constant Master_Level := 3;
......@@ -1062,14 +1067,14 @@ package System.Tasking is
private
Null_Task : constant Task_Id := null;
type Activation_Chain is record
type Activation_Chain is limited record
T_ID : Task_Id;
end record;
pragma Volatile (Activation_Chain);
-- Activation_chain is an in-out parameter of initialization procedures
-- and it must be passed by reference because the init proc may terminate
-- Activation_Chain is an in-out parameter of initialization procedures and
-- it must be passed by reference because the init proc may terminate
-- abnormally after creating task components, and these must be properly
-- registered for removal (Expunge_Unactivated_Tasks).
-- registered for removal (Expunge_Unactivated_Tasks). The "limited" forces
-- Activation_Chain to be a by-reference type; see RM-6.2(4).
end System.Tasking;
gcc/ada/s-tassta.adb
......@@ -149,6 +149,9 @@ package body System.Tasking.Stages is
-- trigger an automatic stack alignment suitable for GCC's assumptions if
-- need be.
-- "Vulnerable_..." in the procedure names below means they must be called
-- with abort deferred.
procedure Vulnerable_Complete_Task (Self_ID : Task_Id);
-- Complete the calling task. This procedure must be called with
-- abort deferred. It should only be called by Complete_Task and
......@@ -520,9 +523,11 @@ package body System.Tasking.Stages is
begin
-- If Master is greater than the current master, it means that Master
-- has already awaited its dependent tasks. This raises Program_Error,
-- by 4.8(10.3/2). See AI-280.
-- by 4.8(10.3/2). See AI-280. Ignore this check for foreign threads.
if Master > Self_ID.Master_Within then
if Self_ID.Master_of_Task /= Foreign_Task_Level
and then Master > Self_ID.Master_Within
then
raise Program_Error with
"create task after awaiting termination";
end if;
......@@ -877,6 +882,53 @@ package body System.Tasking.Stages is
end if;
end Free_Task;
---------------------------
-- Move_Activation_Chain --
---------------------------
procedure Move_Activation_Chain
(From, To : Activation_Chain_Access;
New_Master : Master_ID)
is
Self_ID : constant Task_Id := STPO.Self;
C : Task_Id;
begin
pragma Debug
(Debug.Trace (Self_ID, "Move_Activation_Chain", 'C'));
-- Nothing to do if From is empty, and we can check that without
-- deferring aborts.
C := From.all.T_ID;
if C = null then
return;
end if;
Initialization.Defer_Abort (Self_ID);
-- Loop through the From chain, changing their Master_of_Task
-- fields, and to find the end of the chain.
loop
C.Master_of_Task := New_Master;
exit when C.Common.Activation_Link = null;
C := C.Common.Activation_Link;
end loop;
-- Hook From in at the start of To
C.Common.Activation_Link := To.all.T_ID;
To.all.T_ID := From.all.T_ID;
-- Set From to empty
From.all.T_ID := null;
Initialization.Undefer_Abort (Self_ID);
end Move_Activation_Chain;
------------------
-- Task_Wrapper --
------------------
......@@ -1407,7 +1459,7 @@ package body System.Tasking.Stages is
C := All_Tasks_List;
while C /= null loop
if C.Common.Activator = Self_ID then
if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
return False;
end if;
......@@ -1449,13 +1501,24 @@ package body System.Tasking.Stages is
-- zero for new tasks, and the task should not exit the
-- sleep-loops that use this count until the count reaches zero.
-- While we're counting, if we run across any unactivated tasks that
-- belong to this master, we summarily terminate them as required by
-- RM-9.2(6).
Lock_RTS;
Write_Lock (Self_ID);
C := All_Tasks_List;
while C /= null loop
if C.Common.Activator = Self_ID then
-- Terminate unactivated (never-to-be activated) tasks
if C.Common.Activator = Self_ID and then C.Master_of_Task = CM then
pragma Assert (C.Common.State = Unactivated);
-- Usually, C.Common.Activator = Self_ID implies C.Master_of_Task
-- = CM. The only case where C is pending activation by this
-- task, but the master of C is not CM is in Ada 2005, when C is
-- part of a return object of a build-in-place function.
Write_Lock (C);
C.Common.Activator := null;
......@@ -1465,6 +1528,8 @@ package body System.Tasking.Stages is
Unlock (C);
end if;
-- Count it if dependent on this master
if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
Write_Lock (C);
......@@ -1733,9 +1798,9 @@ package body System.Tasking.Stages is
-- Complete the calling task
-- This procedure must be called with abort deferred. (That's why the
-- name has "Vulnerable" in it.) It should only be called by Complete_Task
-- and Finalize_Global_Tasks (for the environment task).
-- This procedure must be called with abort deferred. It should only be
-- called by Complete_Task and Finalize_Global_Tasks (for the environment
-- task).
-- The effect is similar to that of Complete_Master. Differences include
-- the closing of entries here, and computation of the number of active
......
gcc/ada/s-tassta.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -143,6 +143,8 @@ package System.Tasking.Stages is
-- it is not needed if priority-based scheduling is supported, since all
-- the activated tasks synchronize on the activators lock before they
-- start activating and so they should start activating in priority order.
-- ??? Actually, the body of this package DOES reverse the chain, so I
-- don't understand the above comment.
procedure Complete_Activation;
-- Compiler interface only. Do not call from within the RTS.
......@@ -255,6 +257,22 @@ package System.Tasking.Stages is
-- if T has terminated. Do nothing in the other case. It is called from
-- Unchecked_Deallocation, for objects that are or contain tasks.
procedure Move_Activation_Chain
(From, To : Activation_Chain_Access;
New_Master : Master_ID);
-- Compiler interface only. Do not call from within the RTS.
-- Move all tasks on From list to To list, and change their Master_of_Task
-- to be New_Master. This is used to implement build-in-place function
-- returns. Tasks that are part of the return object are initially placed
-- on an activation chain local to the return statement, and their master
-- is the return statement, in case the return statement is left
-- prematurely (due to raising an exception, being aborted, or a goto or
-- exit statement). Once the return statement has completed successfully,
-- Move_Activation_Chain is called to move them to the caller's activation
-- chain, and change their master to the one passed in by the caller. If
-- that doesn't happen, they will never be activated, and will become
-- terminated on leaving the return statement.
function Terminated (T : Task_Id) return Boolean;
-- This is called by the compiler to implement the 'Terminated attribute.
-- Though is not required to be so by the ARM, we choose to synchronize
......
gcc/ada/sem_ch6.ads
......@@ -27,6 +27,12 @@
with Types; use Types;
package Sem_Ch6 is
type Conformance_Type is
(Type_Conformant, Mode_Conformant, Subtype_Conformant, Fully_Conformant);
-- Conformance type used in conformance checks between specs and bodies,
-- and for overriding. The literals match the RM definitions of the
-- corresponding terms.
procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Extended_Return_Statement (N : Node_Id);
procedure Analyze_Function_Call (N : Node_Id);
......@@ -39,7 +45,8 @@ package Sem_Ch6 is
function Analyze_Subprogram_Specification (N : Node_Id) return Entity_Id;
-- Analyze subprogram specification in both subprogram declarations
-- and body declarations. Returns the defining entity for the spec.
-- and body declarations. Returns the defining entity for the
-- specification N.
procedure Cannot_Inline (Msg : String; N : Node_Id; Subp : Entity_Id);
-- This procedure is called if the node N, an instance of a call to
......@@ -55,9 +62,9 @@ package Sem_Ch6 is
-- their respective counterparts.
procedure Check_Delayed_Subprogram (Designator : Entity_Id);
-- Designator can be a E_Subrpgram_Type, E_Procedure or E_Function. If a
-- Designator can be a E_Subprogram_Type, E_Procedure or E_Function. If a
-- type in its profile depends on a private type without a full
-- declaration, indicate that the subprogram is delayed.
-- declaration, indicate that the subprogram or type is delayed.
procedure Check_Discriminant_Conformance
(N : Node_Id;
......@@ -112,6 +119,16 @@ package Sem_Ch6 is
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not.
function Conforming_Types
(T1 : Entity_Id;
T2 : Entity_Id;
Ctype : Conformance_Type;
Get_Inst : Boolean := False) return Boolean;
-- Check that the types of two formal parameters are conforming. In most
-- cases this is just a name comparison, but within an instance it involves
-- generic actual types, and in the presence of anonymous access types
-- it must examine the designated types.
procedure Create_Extra_Formals (E : Entity_Id);
-- For each parameter of a subprogram or entry that requires an additional
-- formal (such as for access parameters and indefinite discriminated
......
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