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

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