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, 87 insertions, 9 deletions

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 643ed8a31e3..ebef01d303b 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -31,8 +31,6 @@ with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Aggr; use Exp_Aggr;
 with Exp_Ch7;  use Exp_Ch7;
-with Exp_Ch11; use Exp_Ch11;
-with Exp_Tss;  use Exp_Tss;
 with Hostparm; use Hostparm;
 with Inline;   use Inline;
 with Itypes;   use Itypes;
@@ -49,7 +47,6 @@ with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Type; use Sem_Type;
 with Sem_Util; use Sem_Util;
-with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -685,7 +682,7 @@ package body Exp_Util is
       Spec := Make_Function_Specification (Loc,
         Defining_Unit_Name =>
           Make_Defining_Identifier (Loc, New_Internal_Name ('F')),
-        Subtype_Mark => New_Occurrence_Of (Standard_String, Loc));
+        Result_Definition => New_Occurrence_Of (Standard_String, Loc));
 
       --  Calls to 'Image use the secondary stack, which must be cleaned
       --  up after the task name is built.
@@ -1278,6 +1275,13 @@ package body Exp_Util is
       then
          null;
 
+      --  Nothing to be done if the type of the expression is limited, because
+      --  in this case the expression cannot be copied, and its use can only
+      --  be by reference and there is no need for the actual subtype.
+
+      elsif Is_Limited_Type (Exp_Typ) then
+         null;
+
       else
          Remove_Side_Effects (Exp);
          Rewrite (Subtype_Indic,
@@ -1409,7 +1413,7 @@ package body Exp_Util is
            and then Present (Abstract_Interfaces (Typ))
            and then not (Is_Empty_Elmt_List (Abstract_Interfaces (Typ)))
          then
-            --  Skip the tag associated with the primary table.
+            --  Skip the tag associated with the primary table
 
             pragma Assert (Etype (First_Tag_Component (Typ)) = RTE (RE_Tag));
             AI_Tag := Next_Tag_Component (First_Tag_Component (Typ));
@@ -1449,12 +1453,21 @@ package body Exp_Util is
 
       --  Handle task and protected types implementing interfaces
 
-      if Ekind (Typ) = E_Protected_Type
-        or else Ekind (Typ) = E_Task_Type
-      then
+      if Is_Concurrent_Type (Typ) then
          Typ := Corresponding_Record_Type (Typ);
       end if;
 
+      if Is_Class_Wide_Type (Typ) then
+         Typ := Etype (Typ);
+      end if;
+
+      --  Handle entities from the limited view
+
+      if Ekind (Typ) = E_Incomplete_Type then
+         pragma Assert (Present (Non_Limited_View (Typ)));
+         Typ := Non_Limited_View (Typ);
+      end if;
+
       Find_Tag (Typ);
       pragma Assert (Found);
       return AI_Tag;
@@ -1729,6 +1742,68 @@ package body Exp_Util is
       return Count;
    end Homonym_Number;
 
+   ----------------------------------
+   -- Implements_Limited_Interface --
+   ----------------------------------
+
+   function Implements_Limited_Interface (Typ : Entity_Id) return Boolean is
+      function Contains_Limited_Interface
+        (Ifaces : Elist_Id) return Boolean;
+      --  Given a list of interfaces, determine whether one of them is limited
+
+      --------------------------------
+      -- Contains_Limited_Interface --
+      --------------------------------
+
+      function Contains_Limited_Interface
+        (Ifaces : Elist_Id) return Boolean
+      is
+         Iface_Elmt : Elmt_Id;
+
+      begin
+         if not Present (Ifaces) then
+            return False;
+         end if;
+
+         Iface_Elmt := First_Elmt (Ifaces);
+
+         while Present (Iface_Elmt) loop
+            if Is_Limited_Record (Node (Iface_Elmt)) then
+               return True;
+            end if;
+
+            Iface_Elmt := Next_Elmt (Iface_Elmt);
+         end loop;
+
+         return False;
+      end Contains_Limited_Interface;
+
+   --  Start of processing for Implements_Limited_Interface
+
+   begin
+      --  Typ is a derived type and may implement a limited interface
+      --  through its parent subtype. Check the parent subtype as well
+      --  as any interfaces explicitly implemented at this level.
+
+      if Ekind (Typ) = E_Record_Type
+        and then Present (Parent_Subtype (Typ))
+      then
+         return Contains_Limited_Interface (Abstract_Interfaces (Typ))
+           or else Implements_Limited_Interface (Parent_Subtype (Typ));
+
+      --  Typ is an abstract type derived from some interface
+
+      elsif Is_Abstract (Typ) then
+         return Is_Interface (Etype (Typ))
+           and then Is_Limited_Record (Etype (Typ));
+
+      --  Typ may directly implement some interface
+
+      else
+         return Contains_Limited_Interface (Abstract_Interfaces (Typ));
+      end if;
+   end Implements_Limited_Interface;
+
    ------------------------------
    -- In_Unconditional_Context --
    ------------------------------
@@ -2515,6 +2590,10 @@ package body Exp_Util is
            or else Chars (E) = Name_uAssign
            or else TSS_Name  = TSS_Deep_Adjust
            or else TSS_Name  = TSS_Deep_Finalize
+           or else Chars (E) = Name_uDisp_Asynchronous_Select
+           or else Chars (E) = Name_uDisp_Conditional_Select
+           or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
+           or else Chars (E) = Name_uDisp_Timed_Select
          then
             return True;
          end if;
@@ -2919,7 +2998,6 @@ package body Exp_Util is
    procedure Kill_Dead_Code (N : Node_Id) is
    begin
       if Present (N) then
-         Remove_Handler_Entries (N);
          Remove_Warning_Messages (N);
 
          --  Recurse into block statements and bodies to process declarations