2005-09-01 Hristian Kirtchev <kirtchev@adacore.com>

	    Javier Miranda  <miranda@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* a-tags.adb (IW_Membership): Give support to
	"Iface_CW_Typ in T'Class". For this purpose the functionality of this
	subprogram has been extended to look for the tag in the ancestors tag
	table.
	Update the structure of the GNAT Dispatch Table to reflect the
	additional two tables used in dispatching selects.
	Introduce appropriate array types and record components in
	Type_Specific_Data to reflect the two tables.
	(Get_Entry_Index, Set_Entry_Index): Retrieve and set the entry index in
	the TSD of a tag, indexed by position.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Retrieve and set the primitive
	operation kind in the TSD of a tag, indexed by position.

	* a-tags.ads: Introduce an enumeration type to capture different
	primitive operation kinds. Define a constant reflecting the number of
	predefined primitive operations.
	(Get_Entry_Index, Set_Entry_Index): Set and retrieve the entry index
	of an entry wrapper.
	(Get_Prim_Op_Kind, Set_Prim_Op_Kind): Set and retrieve the kind of
	callable entity of a primitive operation.

	* exp_ch3.adb (Freeze_Record_Type): Generate the declarations of the
	primitive operations used in dispatching selects for limited
	interfaces, limited tagged, task and protected types what implement a
	limited interface.
	(Freeze_Type): Generate the bodies of the primitive operations used in
	dispatching selects for limited tagged, task and protected types that
	implement a limited interface. Generate statements to populate the two
	auxiliary tables used for dispatching in select statements.
	(Freeze_Record_Type): Add call to initialize the dispatch table entries
	associated with predefined interface primitive operations.
	(Build_Dcheck_Function): Change Set_Subtype_Mark to
	Set_Result_Definition.
	(Build_Variant_Record_Equality): Change Subtype_Mark to
	Result_Definition.
	(Freeze_Enumeration_Type): Change Subtype_Mark to Result_Definition.
	(Predef_Spec_Or_Body): Change Subtype_Mark to Result_Definition.
	(Build_Assignment): Simplify the code that adds the run-time-check.
	(Expand_N_Object_Declaration): Code cleanup.

	* exp_ch7.adb (Make_Clean): Select the appropriate type for locking
	entries when there is a protected type that implements a limited
	interface.

	* exp_ch9.adb: Add package Select_Expansion_Utilities that contains
	common routines used in expansion of dispatching selects.
	(Add_Private_Declarations): Select the appropriate protection type when
	there is a protected type that implements a limited interface.
	(Build_Parameter_Block): Generate a wrapped parameter block.
	(Build_Protected_Subprogram_Body): Select the appropriate type for
	locking entries when there is a protected type that implements a
	limited interface.
	(Build_Wrapper_Spec): Set the flag and wrapped entity for procedures
	classified as entry wrappers.
	(Expand_N_Asynchronous_Select): Add support for expansion of dispatching
	asynchronous selects.
	(Expand_N_Conditional_Entry_Call): Add support for expansion of
	dispatching conditional selects.
	(Expand_N_Protected_Type_Declaration): Select the appropriate type for
	protection when there is a protected type that implements limited
	interfaces.
	(Expand_N_Timed_Entry_Call): Add support for expansion of dispatching
	timed selects.
	(Extract_Dispatching_Call): Extract the entity of the name of a
	dispatching call, the object parameter, actual parameters and
	corresponding formals.
	(Make_Initialize_Protection): Correct logic of protection initialization
	when there is a protected type that implements a limited interface.
	(Parameter_Block_Pack): Populate a wrapped parameter block with the
	values of actual parameters.
	(Parameter_Block_Unpack): Retrieve the values from a wrapped parameter
	block and assign them to the original actual parameters.

	* exp_ch9.ads (Subprogram_Protection_Mode): New type.
	(Build_Protected_Sub_Specification): Change the type and name of the
	last formal to account for the increased variety of protection modes.

	* einfo.ads, einfo.adb (Was_Hidden): New attribute. Present in all
	entities. Used to save the value of the Is_Hidden attribute when the
	limited-view is installed.
	(Is_Primitive_Wrapper, Set_Is_Primitive_Wrapper): Retrieve and change
	the attribute of procedures classified as entry wrappers.
	(Wrapped_Entity, Set_Wrapped_Entity): Retrieve and change the wrapped
	entity of a primitive wrapper.
	(Write_Entity_Flags): Output the name and value of the
	Is_Primitive_Wrapper attribute.
	(Write_Field27_Name): Output the name and entity of the field Wrapped_
	Entity.
	(Underlying_Type): If we have an incomplete entity that comes from
	the limited view then we return the Underlying_Type of its non-limited
	view if it is already available.
	(Abstract_Interface_Alias): Flag applies to all subrogram kinds,
	including operators.
	(Write_Field26_Name): Add entry for Overridden_Operation
	(Overridden_Operation): New attribute of functions and procedures.

	* exp_disp.ads, exp_disp.adb (Default_Prim_Op_Position): Return a
	predefined position in the dispatch table for the primitive operations
	used in dispatching selects.
	(Init_Predefined_Interface_Primitives): Remove the hardcoded number of
	predefined primitive operations and replace it with
	Default_Prim_Op_Count.
	(Make_Disp_Asynchronous_Select_Spec, Make_Disp_Conditional_Select_Spec,
	Make_Disp_Get_Prim_Op_Kind_Spec, Make_Disp_Timed_Select_Spec): Update
	the names of the generated primitive operations used in dispatching
	selects.
	(Init_Predefined_Interface_Primitives): No need to inherit primitives in
	case of abstract interface types. They will be inherit by the objects
	implementing the interface.
	(Make_DT): There is no need to inherit the dispatch table of the
	ancestor interface for the elaboration of abstract interface types.
	The dispatch table will be inherited by the object implementing the
	interface.
	(Copy_Secondary_DTs): Add documentation.
	(Validate_Position): Improve this static check in case of
	aliased subprograms because aliased subprograms must have
	the same position.
	(Init_Predefined_Interface_Primitives): New subprogram that initializes
	the entries associated with predefined primitives of all the secondary
	dispatch tables.
	(Build_Anonymous_Access_Type): Removed.
	(Expand_Interface_Actuals): With the previous cleanup there is no need
	to build an anonymous access type. This allows further cleanup in the
	code generated by the expander.
	(Expand_Interface_Conversion): If the actual is an access type then
	build an internal function to handle the displacement. If the actual
	is null this function returns null because no displacement is
	required; otherwise performs a type conversion that will be
	expanded in the code that returns the value of the displaced actual.
	(Expand_Interface_Actuals): Avoid the generation of unnecessary type
	conversions that have no effect in the generated code because no
	displacement is required. Code cleanup; use local variables to
	avoid repeated calls to the subprogram directly_designated_type().

	* exp_util.ads, exp_util.adb (Is_Predefined_Dispatching_Operation):
	Classify the primitive operations used in dispatching selects as
	predefined.
	(Implements_Limited_Interface): Determine whether some type either
	directly implements a limited interface or extends a type that
	implements a limited interface.
	(Build_Task_Image_Function): Change Subtype_Mark to Result_Definition.
	(Expand_Subtype_From_Expr): Do not build actual subtype if the
	expression is limited.
	(Find_Interface_Tag): Add code to handle class-wide types and
	entities from the limited-view.

	* rtsfind.ads: Add entries in RE_Id and RE_Unit_Table for
	Get_Entry_Index, Get_Prim_Op_Kind, POK_Function, POK_Procedure,
	POK_Protected_Entry, POK_Protected_Function, POK_Protected_Procedure,
	POK_Task_Entry, POK_Task_Procedure, Prim_Op_Kind, Set_Entry_Index,
	Set_Prim_Op_Kind.

	* sem_ch9.adb (Analyze_Triggering_Alternative): Check for legal type
	of procedure name or prefix that appears as a trigger in a triggering
	alternative.

	* uintp.ads: Introduce constants Uint_11 and Uint_13.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103850 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 97 insertions, 29 deletions

diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads
index 10900d04103..469ea79caf8 100644
--- a/gcc/ada/exp_disp.ads
+++ b/gcc/ada/exp_disp.ads
@@ -30,14 +30,26 @@
 with Types; use Types;
 package Exp_Disp is
 
+   --  Number of predefined primitive operations added by the Expander
+   --  for a tagged type. If more predefined primitive operations are
+   --  added, the following items must be changed:
+
+   --    Ada.Tags.Defailt_Prim_Op_Count    - indirect use
+   --    Exp_Disp.Default_Prim_Op_Position - indirect use
+   --    Exp_Disp.Set_All_DT_Position      - direct   use
+
+   Default_Prim_Op_Count : constant Int := 14;
+
    type DT_Access_Action is
       (CW_Membership,
        IW_Membership,
        DT_Entry_Size,
        DT_Prologue_Size,
        Get_Access_Level,
+       Get_Entry_Index,
        Get_External_Tag,
        Get_Prim_Op_Address,
+       Get_Prim_Op_Kind,
        Get_RC_Offset,
        Get_Remotely_Callable,
        Inherit_DT,
@@ -45,15 +57,42 @@ package Exp_Disp is
        Register_Interface_Tag,
        Register_Tag,
        Set_Access_Level,
+       Set_Entry_Index,
        Set_Expanded_Name,
        Set_External_Tag,
        Set_Prim_Op_Address,
+       Set_Prim_Op_Kind,
        Set_RC_Offset,
        Set_Remotely_Callable,
        Set_TSD,
        TSD_Entry_Size,
        TSD_Prologue_Size);
 
+   procedure Expand_Dispatching_Call (Call_Node : Node_Id);
+   --  Expand the call to the operation through the dispatch table and perform
+   --  the required tag checks when appropriate. For CPP types the call is
+   --  done through the Vtable (tag checks are not relevant)
+
+   procedure Expand_Interface_Actuals    (Call_Node : Node_Id);
+   --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
+   --  interfaces to reference the interface tag of the actual object
+
+   procedure Expand_Interface_Conversion (N : Node_Id);
+   --  Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
+   --  the object to give access to the interface tag associated with the
+   --  secondary dispatch table
+
+   function Expand_Interface_Thunk
+     (N           : Node_Id;
+      Thunk_Alias : Node_Id;
+      Thunk_Id    : Entity_Id;
+      Thunk_Tag   : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
+   --  generate additional subprograms (thunks) to have a layout compatible
+   --  with the C++ ABI. The thunk modifies the value of the first actual of
+   --  the call (that is, the pointer to the object) before transferring
+   --  control to the target function.
+
    function Fill_DT_Entry
      (Loc          : Source_Ptr;
       Prim         : Entity_Id) return Node_Id;
@@ -69,6 +108,15 @@ package Exp_Disp is
    --  the secondary dispatch table of Prim's controlling type with Thunk_Id's
    --  address.
 
+   function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
+   --  Return an expression that holds True if the object can be transmitted
+   --  onto another partition according to E.4 (18)
+
+   function Init_Predefined_Interface_Primitives
+     (Typ : Entity_Id) return List_Id;
+   --  Ada 2005 (AI-251): Initialize the entries associated with predefined
+   --  primitives in all the secondary dispatch tables of Typ.
+
    procedure Make_Abstract_Interface_DT
      (AI_Tag          : Entity_Id;
       Acc_Disp_Tables : in out Elist_Id;
@@ -90,45 +138,65 @@ package Exp_Disp is
    --  Expand the declarations for the Dispatch Table (or the Vtable in
    --  the case of type whose ancestor is a CPP_Class)
 
+   function Make_Disp_Asynchronous_Select_Body
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+   --  Typ used for dispatching in asynchronous selects.
+
+   function Make_Disp_Asynchronous_Select_Spec
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+   --  of type Typ used for dispatching in asynchronous selects.
+
+   function Make_Disp_Conditional_Select_Body
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+   --  Typ used for dispatching in conditional selects.
+
+   function Make_Disp_Conditional_Select_Spec
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+   --  of type Typ used for dispatching in conditional selects.
+
+   function Make_Disp_Get_Prim_Op_Kind_Body
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+   --  Typ used for retrieving the callable entity kind during dispatching in
+   --  asynchronous selects.
+
+   function Make_Disp_Get_Prim_Op_Kind_Spec
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+   --  of the type Typ use for retrieving the callable entity kind during
+   --  dispatching in asynchronous selects.
+
+   function Make_Disp_Select_Tables
+     (Typ : Entity_Id) return List_Id;
+   --  Ada 2005 (AI-345): Populate the two auxiliary tables in the TSD of Typ
+   --  used for dispatching in asynchronous, conditional and timed selects.
+   --  Generate code to set the primitive operation kinds and entry indices
+   --  of primitive operations and primitive wrappers.
+
+   function Make_Disp_Timed_Select_Body
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
+   --  Typ used for dispatching in timed selects.
+
+   function Make_Disp_Timed_Select_Spec
+     (Typ : Entity_Id) return Node_Id;
+   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
+   --  of type Typ used for dispatching in timed selects.
+
    procedure Set_All_DT_Position (Typ : Entity_Id);
    --  Set the DT_Position field for each primitive operation. In the CPP
    --  Class case check that no pragma CPP_Virtual is missing and that the
    --  DT_Position are coherent
 
-   procedure Expand_Dispatching_Call (Call_Node : Node_Id);
-   --  Expand the call to the operation through the dispatch table and perform
-   --  the required tag checks when appropriate. For CPP types the call is
-   --  done through the Vtable (tag checks are not relevant)
-
-   procedure Expand_Interface_Actuals    (Call_Node : Node_Id);
-   --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
-   --  interfaces to reference the interface tag of the actual object
-
-   procedure Expand_Interface_Conversion (N : Node_Id);
-   --  Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
-   --  the object to give access to the interface tag associated with the
-   --  secondary dispatch table
-
-   function Expand_Interface_Thunk
-     (N           : Node_Id;
-      Thunk_Alias : Node_Id;
-      Thunk_Id    : Entity_Id;
-      Iface_Tag   : Entity_Id) return Node_Id;
-   --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
-   --  generate additional subprograms (thunks) to have a layout compatible
-   --  with the C++ ABI. The thunk modifies the value of the first actual of
-   --  the call (that is, the pointer to the object) before transferring
-   --  control to the target function.
-
    procedure Set_Default_Constructor (Typ : Entity_Id);
    --  Typ is a CPP_Class type. Create the Init procedure of that type to
    --  be the default constructor (i.e. the function returning this type,
    --  having a pragma CPP_Constructor and no parameter)
 
-   function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
-   --  Return an expression that holds True if the object can be transmitted
-   --  onto another partition according to E.4 (18)
-
    procedure Write_DT (Typ : Entity_Id);
    pragma Export (Ada, Write_DT);
    --  Debugging procedure (to be called within gdb)