2005-03-08 Javier Miranda <miranda@adacore.com>

	    Robert Dewar  <dewar@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>
	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* atree.ads, atree.adb: Add support for Elist24 field

	* atree.h: Fix wrong definition of Field27
	Add support for Elist16 field
	Add support for Elist24 field

	* einfo.ads, einfo.adb (Abstract_Interfaces,
	Set_Abstract_Interfaces): New subprograms.
	(Abstract_Interface_Alias, Set_Abstract_Interface_Alias): New
	subprograms.
	(Access_Disp_Table, Set_Access_Disp_Table): Modified to handle a list of
	entities rather than a single node.
	(Is_Interface, Set_Is_Interface): New subprogram
	(First_Tag_Component): New syntesized attribute
	(Next_Tag_Component): New synthesized attribute
	(Write_Entity_Flags): Upgraded to write Is_Interface
	(Write_Field24_Name): Upgraded to write Abstract_Interfaces
	(Write_Field25_Name): Upgraded to write Abstract_Interface_Alias
	(Task_Body_Procedure): New subprogram to read this attribute.
	(Set_Task_Body_Procedure): New subprogram to set this attribute.
	(Has_Controlled_Component): Now applies to all entities.
	This is only a documentation change, since it always worked to apply
	this to other than composite types (yielding false), but now this is
	official.
	Update documentation on Must_Be_Byte_Aligned for new spec

	* tbuild.adb, exp_dist.adb, exp_disp.adb, exp_ch3.ads, exp_ch3.adb,
	exp_attr.adb, exp_aggr.adb, exp_ch4.adb, exp_ch5.adb: Upgrade all the
	uses of the Access_Disp_Table attribute to reference the first dispatch
	table associated with a tagged type. As
	part of the implementation of abstract interface types,
	Access_Disp_Table has been redefined to contain a list of dispatch
	tables (rather than a single dispatch table).
	Similarly, upgrade all the references to Tag_Component by the
	new attribute First_Tag_Component.
	(Find_Inherited_TSS): Moved to exp_tss.
	Clean up test in Expand_N_Object_Declaration for cases
	where we need to do a separate assignment of the initial value.
	(Expand_N_Object_Declaration): If the expression in the
	declaration of a tagged type is an aggregate, no need to generate an
	additional tag assignment.
	(Freeze_Type): Now a function that returns True if the N_Freeze_Entity
	is to be deleted.
	Bit packed array ops are only called if operands are known to be
	aligned.
	(Component_Equality): When returning an N_Raise_Program_Error statement,
	ensure that its Etype is set to Empty to avoid confusing GIGI (which
	expects that only expressions have a bona fide type).
	(Make_Tag_Ctrl_Assignment): Use Build_Actual_Subtype to correctly
	determine the amount of data to be copied.

	* par.adb (P_Interface_Type_Definition): New subprogram that parses the
	new syntax rule of Ada 2005 interfaces (for AI-251 and AI-345):
	    INTERFACE_TYPE_DEFINITION ::=
	      [limited | task | protected | synchronized] interface
	        [AND interface_list]

	* par-ch3.adb (P_Type_Declaration): Modified to give support to
	interfaces.
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Modified to give support to
	interfaces.
	(P_Interface_Type_Definition): New subprogram that parses the new
	syntax rule of Ada 2005 interfaces
	(P_Identifier_Declarations): fix two occurrences of 'RENAMES' in error
	messages by the correct RENAMES (quotes removed).

	* sem_prag.adb: Upgrade all the references to Tag_Component by the new
	attribute First_Tag_Component.

	* sinfo.ads, sinfo.adb: Remove OK_For_Stream flag, not used, not needed
	(Interface_List, Set_Interface_List): New subprograms.
	(Interface_Present, Set_Interface_Present): New subprograms.
	(Limited_Present, Set_Limited_Present): Available also in derived
	type definition nodes.
	(Protected_Present, Set_Protected_Present): Available also in
	record type definition and
	derived type definition nodes.
	(Synchronized_Present, Set_Synchronized_Present): New subprograms.
	(Task_Present, Set_Task_Present): New subprogram.
	(Task_Body_Procedure): Removed.
	(Set_Task_Body_Procedure): Removed.
	These subprogram have been removed because the attribute
	Task_Body_Procedure has been moved to the corresponding task type
	or task subtype entity to leave a field free to store the list
	of interfaces implemented by a task (for AI-345)
	Add Expression field to N_Raise_Statement node for Ada 2005 AI-361
	(Null_Exclusion_Present): Change to Flag11, to avoid conflict with
	expression flag Do_Range_Check
	(Exception_Junk): Change to Flag7 to accomodate above change
	(Box_Present, Default_Name, Specification, Set_Box_Present,
	Set_Default_Name, Set_Specification): Expand the expression
	"X in N_Formal_Subprogram_Declaration" into the corresponding
	two comparisons. Required to use the csinfo tool.

	* exp_ch11.adb (Expand_N_Raise_Statement): Deal with case where
	"with string" given.

        * sem_ch11.adb (Analyze_Raise_Statement): Handle case where string
        expression given.

	* par-ch11.adb (P_Raise_Statement): Recognize with string expression
	in 2005 mode

	* exp_ch9.adb (Build_Task_Proc_Specification): Modified to use entity
	attribute Task_Body_Procedure rather than the old semantic field that
	was available in the task_type_declaration node.

	* par-ch12.adb (P_Formal_Type_Definition): Modified to handle formal
	interface type definitions.
	(P_Formal_Derived_Type_Definition): Modified to handle the list of
	interfaces.

	* par-ch9.adb (P_Task): Modified to handle the list of interfaces in a
	task type declaration.
	(P_Protected): Modified to handle the list of interfaces in a
	protected type declaration.


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

1 files changed, 185 insertions, 157 deletions

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 1d027d05176..b3517bf18ba 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1512,11 +1512,12 @@ package body Exp_Ch3 is
                   Make_Selected_Component (Loc,
                     Prefix =>  New_Copy_Tree (Lhs),
                     Selector_Name =>
-                      New_Reference_To (Tag_Component (Typ), Loc)),
+                      New_Reference_To (First_Tag_Component (Typ), Loc)),
 
                 Expression =>
                   Unchecked_Convert_To (RTE (RE_Tag),
-                    New_Reference_To (Access_Disp_Table (Typ), Loc))));
+                    New_Reference_To
+                      (Node (First_Elmt (Access_Disp_Table (Typ))), Loc))));
          end if;
 
          --  Adjust the component if controlled except if it is an
@@ -1825,10 +1826,11 @@ package body Exp_Ch3 is
                   Make_Selected_Component (Loc,
                     Prefix => Make_Identifier (Loc, Name_uInit),
                     Selector_Name =>
-                      New_Reference_To (Tag_Component (Rec_Type), Loc)),
+                      New_Reference_To (First_Tag_Component (Rec_Type), Loc)),
 
                 Expression =>
-                  New_Reference_To (Access_Disp_Table (Rec_Type), Loc));
+                  New_Reference_To
+                    (Node (First_Elmt (Access_Disp_Table (Rec_Type))), Loc));
 
             --  The tag must be inserted before the assignments to other
             --  components,  because the initial value of the component may
@@ -3497,18 +3499,20 @@ package body Exp_Ch3 is
                end;
             end if;
 
-            --  For tagged types, when an init value is given, the tag has
-            --  to be re-initialized separately in order to avoid the
-            --  propagation of a wrong tag coming from a view conversion
-            --  unless the type is class wide (in this case the tag comes
-            --  from the init value). Suppress the tag assignment when
-            --  Java_VM because JVM tags are represented implicitly
-            --  in objects. Ditto for types that are CPP_CLASS.
+            --  For tagged types, when an init value is given, the tag has to
+            --  be re-initialized separately in order to avoid the propagation
+            --  of a wrong tag coming from a view conversion unless the type
+            --  is class wide (in this case the tag comes from the init
+            --  value). Suppress the tag assignment when Java_VM because JVM
+            --  tags are represented implicitly in objects. Ditto for types
+            --  that are CPP_CLASS, and for initializations that are
+            --  aggregates, because they have to have the right tag.
 
             if Is_Tagged_Type (Typ)
               and then not Is_Class_Wide_Type (Typ)
               and then not Is_CPP_Class (Typ)
               and then not Java_VM
+              and then Nkind (Expr) /= N_Aggregate
             then
                --  The re-assignment of the tag has to be done even if
                --  the object is a constant
@@ -3517,7 +3521,7 @@ package body Exp_Ch3 is
                  Make_Selected_Component (Loc,
                     Prefix => New_Reference_To (Def_Id, Loc),
                     Selector_Name =>
-                      New_Reference_To (Tag_Component (Typ), Loc));
+                      New_Reference_To (First_Tag_Component (Typ), Loc));
 
                Set_Assignment_OK (New_Ref);
 
@@ -3527,7 +3531,10 @@ package body Exp_Ch3 is
                    Expression =>
                      Unchecked_Convert_To (RTE (RE_Tag),
                        New_Reference_To
-                         (Access_Disp_Table (Base_Type (Typ)), Loc))));
+                         (Node
+                           (First_Elmt
+                             (Access_Disp_Table (Base_Type (Typ)))),
+                          Loc))));
 
             --  For discrete types, set the Is_Known_Valid flag if the
             --  initializing value is known to be valid.
@@ -3553,8 +3560,8 @@ package body Exp_Ch3 is
                end if;
 
                --  For access types set the Is_Known_Non_Null flag if the
-               --  initializing value is known to be non-null. We can also
-               --  set Can_Never_Be_Null if this is a constant.
+               --  initializing value is known to be non-null. We can also set
+               --  Can_Never_Be_Null if this is a constant.
 
                if Known_Non_Null (Expr) then
                   Set_Is_Known_Non_Null (Def_Id);
@@ -3575,21 +3582,33 @@ package body Exp_Ch3 is
             end if;
          end if;
 
-         if Is_Possibly_Unaligned_Slice (Expr) then
+         --  Cases where the back end cannot handle the initialization
+         --  directly. In such cases, we expand an assignment that will
+         --  be appropriately handled by Expand_N_Assignment_Statement.
 
-            --  Make a separate assignment that will be expanded into a
-            --  loop, to bypass back-end problems with misaligned arrays.
+         --  The exclusion of the unconstrained case is wrong, but for
+         --  now it is too much trouble ???
 
+         if (Is_Possibly_Unaligned_Slice (Expr)
+               or else (Is_Possibly_Unaligned_Object (Expr)
+                          and then not Represented_As_Scalar (Etype (Expr))))
+
+            --  The exclusion of the unconstrained case is wrong, but for
+            --  now it is too much trouble ???
+
+           and then not (Is_Array_Type (Etype (Expr))
+                           and then not Is_Constrained (Etype (Expr)))
+         then
             declare
                Stat : constant Node_Id :=
                        Make_Assignment_Statement (Loc,
-                         Name => New_Reference_To (Def_Id, Loc),
+                         Name       => New_Reference_To (Def_Id, Loc),
                          Expression => Relocate_Node (Expr));
-
             begin
                Set_Expression (N, Empty);
                Set_No_Initialization (N);
                Set_Assignment_OK (Name (Stat));
+               Set_No_Ctrl_Actions (Stat);
                Insert_After (N, Stat);
                Analyze (Stat);
             end;
@@ -3612,10 +3631,10 @@ package body Exp_Ch3 is
    -- Expand_N_Subtype_Indication --
    ---------------------------------
 
-   --  Add a check on the range of the subtype. The static case is
-   --  partially duplicated by Process_Range_Expr_In_Decl in Sem_Ch3,
-   --  but we still need to check here for the static case in order to
-   --  avoid generating extraneous expanded code.
+   --  Add a check on the range of the subtype. The static case is partially
+   --  duplicated by Process_Range_Expr_In_Decl in Sem_Ch3, but we still need
+   --  to check here for the static case in order to avoid generating
+   --  extraneous expanded code.
 
    procedure Expand_N_Subtype_Indication (N : Node_Id) is
       Ran : constant Node_Id   := Range_Expression (Constraint (N));
@@ -3634,18 +3653,17 @@ package body Exp_Ch3 is
    -- Expand_N_Variant_Part --
    ---------------------------
 
-   --  If the last variant does not contain the Others choice, replace
-   --  it with an N_Others_Choice node since Gigi always wants an Others.
-   --  Note that we do not bother to call Analyze on the modified variant
-   --  part, since it's only effect would be to compute the contents of
-   --  the Others_Discrete_Choices node laboriously, and of course we
-   --  already know the list of choices that corresponds to the others
-   --  choice (it's the list we are replacing!)
+   --  If the last variant does not contain the Others choice, replace it with
+   --  an N_Others_Choice node since Gigi always wants an Others. Note that we
+   --  do not bother to call Analyze on the modified variant part, since it's
+   --  only effect would be to compute the contents of the
+   --  Others_Discrete_Choices node laboriously, and of course we already know
+   --  the list of choices that corresponds to the others choice (it's the
+   --  list we are replacing!)
 
    procedure Expand_N_Variant_Part (N : Node_Id) is
       Last_Var    : constant Node_Id := Last_Non_Pragma (Variants (N));
       Others_Node : Node_Id;
-
    begin
       if Nkind (First (Discrete_Choices (Last_Var))) /= N_Others_Choice then
          Others_Node := Make_Others_Choice (Sloc (Last_Var));
@@ -3737,9 +3755,9 @@ package body Exp_Ch3 is
          Set_Null_Present (Comp_List, False);
 
       else
-         --  The controller cannot be placed before the _Parent field
-         --  since gigi lays out field in order and _parent must be
-         --  first to preserve the polymorphism of tagged types.
+         --  The controller cannot be placed before the _Parent field since
+         --  gigi lays out field in order and _parent must be first to
+         --  preserve the polymorphism of tagged types.
 
          First_Comp := First (Component_Items (Comp_List));
 
@@ -3757,9 +3775,9 @@ package body Exp_Ch3 is
       Set_Ekind (Ent, E_Component);
       Init_Component_Location (Ent);
 
-      --  Move the _controller entity ahead in the list of internal
-      --  entities of the enclosing record so that it is selected
-      --  instead of a potentially inherited one.
+      --  Move the _controller entity ahead in the list of internal entities
+      --  of the enclosing record so that it is selected instead of a
+      --  potentially inherited one.
 
       declare
          E    : constant Entity_Id := Last_Entity (T);
@@ -3818,7 +3836,7 @@ package body Exp_Ch3 is
 
       Comp_Decl :=
         Make_Component_Declaration (Sloc_N,
-          Defining_Identifier => Tag_Component (T),
+          Defining_Identifier => First_Tag_Component (T),
           Component_Definition =>
             Make_Component_Definition (Sloc_N,
               Aliased_Present => False,
@@ -3835,8 +3853,8 @@ package body Exp_Ch3 is
       end if;
 
       --  We don't Analyze the whole expansion because the tag component has
-      --  already been analyzed previously. Here we just insure that the
-      --  tree is coherent with the semantic decoration
+      --  already been analyzed previously. Here we just insure that the tree
+      --  is coherent with the semantic decoration
 
       Find_Type (Subtype_Indication (Component_Definition (Comp_Decl)));
 
@@ -3856,10 +3874,10 @@ package body Exp_Ch3 is
    begin
       if not Is_Bit_Packed_Array (Typ) then
 
-         --  If the component contains tasks, so does the array type.
-         --  This may not be indicated in the array type because the
-         --  component may have been a private type at the point of
-         --  definition. Same if component type is controlled.
+         --  If the component contains tasks, so does the array type. This may
+         --  not be indicated in the array type because the component may have
+         --  been a private type at the point of definition. Same if component
+         --  type is controlled.
 
          Set_Has_Task (Base, Has_Task (Component_Type (Typ)));
          Set_Has_Controlled_Component (Base,
@@ -3868,9 +3886,9 @@ package body Exp_Ch3 is
 
          if No (Init_Proc (Base)) then
 
-            --  If this is an anonymous array created for a declaration
-            --  with an initial value, its init_proc will never be called.
-            --  The initial value itself may have been expanded into assign-
+            --  If this is an anonymous array created for a declaration with
+            --  an initial value, its init_proc will never be called. The
+            --  initial value itself may have been expanded into assign-
             --  ments, in which case the object declaration is carries the
             --  No_Initialization flag.
 
@@ -3911,9 +3929,9 @@ package body Exp_Ch3 is
             end if;
          end if;
 
-      --  For packed case, there is a default initialization, except
-      --  if the component type is itself a packed structure with an
-      --  initialization procedure.
+      --  For packed case, there is a default initialization, except if the
+      --  component type is itself a packed structure with an initialization
+      --  procedure.
 
       elsif Present (Init_Proc (Component_Type (Base)))
         and then No (Base_Init_Proc (Base))
@@ -3943,8 +3961,8 @@ package body Exp_Ch3 is
       pragma Warnings (Off, Func);
 
    begin
-      --  Various optimization are possible if the given representation
-      --  is contiguous.
+      --  Various optimization are possible if the given representation is
+      --  contiguous.
 
       Is_Contiguous := True;
       Ent := First_Literal (Typ);
@@ -3987,9 +4005,9 @@ package body Exp_Ch3 is
       --    typA : array (Natural range 0 .. num - 1) of ctype :=
       --             (v, v, v, v, v, ....)
 
-      --  where ctype is the corresponding integer type. If the
-      --  representation is contiguous, we only keep the first literal,
-      --  which provides the offset for Pos_To_Rep computations.
+      --  where ctype is the corresponding integer type. If the representation
+      --  is contiguous, we only keep the first literal, which provides the
+      --  offset for Pos_To_Rep computations.
 
       Arr :=
         Make_Defining_Identifier (Loc,
@@ -4044,22 +4062,22 @@ package body Exp_Ch3 is
       --  representation) raises Constraint_Error or returns a unique value
       --  of minus one. The latter case is used, e.g. in 'Valid code.
 
-      --  Note: the reason we use Enum_Rep values in the case here is to
-      --  avoid the code generator making inappropriate assumptions about
-      --  the range of the values in the case where the value is invalid.
-      --  ityp is a signed or unsigned integer type of appropriate width.
+      --  Note: the reason we use Enum_Rep values in the case here is to avoid
+      --  the code generator making inappropriate assumptions about the range
+      --  of the values in the case where the value is invalid. ityp is a
+      --  signed or unsigned integer type of appropriate width.
 
       --  Note: if exceptions are not supported, then we suppress the raise
       --  and return -1 unconditionally (this is an erroneous program in any
-      --  case and there is no obligation to raise Constraint_Error here!)
-      --  We also do this if pragma Restrictions (No_Exceptions) is active.
+      --  case and there is no obligation to raise Constraint_Error here!) We
+      --  also do this if pragma Restrictions (No_Exceptions) is active.
 
       --  Representations are signed
 
       if Enumeration_Rep (First_Literal (Typ)) < 0 then
 
          --  The underlying type is signed. Reset the Is_Unsigned_Type
-         --  explicitly, because it might have been inherited from a
+         --  explicitly, because it might have been inherited from
          --  parent type.
 
          Set_Is_Unsigned_Type (Typ, False);
@@ -4080,8 +4098,8 @@ package body Exp_Ch3 is
          end if;
       end if;
 
-      --  The body of the function is a case statement. First collect
-      --  case alternatives, or optimize the contiguous case.
+      --  The body of the function is a case statement. First collect case
+      --  alternatives, or optimize the contiguous case.
 
       Lst := New_List;
 
@@ -4303,10 +4321,10 @@ package body Exp_Ch3 is
       end loop;
 
       --  Creation of the Dispatch Table. Note that a Dispatch Table is
-      --  created for regular tagged types as well as for Ada types
-      --  deriving from a C++ Class, but not for tagged types directly
-      --  corresponding to the C++ classes. In the later case we assume
-      --  that the Vtable is created in the C++ side and we just use it.
+      --  created for regular tagged types as well as for Ada types deriving
+      --  from a C++ Class, but not for tagged types directly corresponding to
+      --  the C++ classes. In the later case we assume that the Vtable is
+      --  created in the C++ side and we just use it.
 
       if Is_Tagged_Type (Def_Id) then
          if Is_CPP_Class (Def_Id) then
@@ -4314,18 +4332,17 @@ package body Exp_Ch3 is
             Set_Default_Constructor (Def_Id);
 
          else
-            --  Usually inherited primitives are not delayed but the first
-            --  Ada extension of a CPP_Class is an exception since the
-            --  address of the inherited subprogram has to be inserted in
-            --  the new Ada Dispatch Table and this is a freezing action
-            --  (usually the inherited primitive address is inserted in the
-            --  DT by Inherit_DT)
-
-            --  Similarly, if this is an inherited operation whose parent
-            --  is not frozen yet, it is not in the DT of the parent, and
-            --  we generate an explicit freeze node for the inherited
-            --  operation, so that it is properly inserted in the DT of the
-            --  current type.
+            --  Usually inherited primitives are not delayed but the first Ada
+            --  extension of a CPP_Class is an exception since the address of
+            --  the inherited subprogram has to be inserted in the new Ada
+            --  Dispatch Table and this is a freezing action (usually the
+            --  inherited primitive address is inserted in the DT by
+            --  Inherit_DT)
+
+            --  Similarly, if this is an inherited operation whose parent is
+            --  not frozen yet, it is not in the DT of the parent, and we
+            --  generate an explicit freeze node for the inherited operation,
+            --  so that it is properly inserted in the DT of the current type.
 
             declare
                Elmt : Elmt_Id := First_Elmt (Primitive_Operations (Def_Id));
@@ -4355,11 +4372,10 @@ package body Exp_Ch3 is
                Expand_Tagged_Root (Def_Id);
             end if;
 
-            --  Unfreeze momentarily the type to add the predefined
-            --  primitives operations. The reason we unfreeze is so
-            --  that these predefined operations will indeed end up
-            --  as primitive operations (which must be before the
-            --  freeze point).
+            --  Unfreeze momentarily the type to add the predefined primitives
+            --  operations. The reason we unfreeze is so that these predefined
+            --  operations will indeed end up as primitive operations (which
+            --  must be before the freeze point).
 
             Set_Is_Frozen (Def_Id, False);
             Make_Predefined_Primitive_Specs
@@ -4369,22 +4385,22 @@ package body Exp_Ch3 is
             Set_All_DT_Position (Def_Id);
 
             --  Add the controlled component before the freezing actions
-            --  it is referenced in those actions.
+            --  referenced in those actions.
 
             if Has_New_Controlled_Component (Def_Id) then
                Expand_Record_Controller (Def_Id);
             end if;
 
-            --  Suppress creation of a dispatch table when Java_VM because
-            --  the dispatching mechanism is handled internally by the JVM.
+            --  Suppress creation of a dispatch table when Java_VM because the
+            --  dispatching mechanism is handled internally by the JVM.
 
             if not Java_VM then
                Append_Freeze_Actions (Def_Id, Make_DT (Def_Id));
             end if;
 
-            --  Make sure that the primitives Initialize, Adjust and
-            --  Finalize are Frozen before other TSS subprograms. We
-            --  don't want them Frozen inside.
+            --  Make sure that the primitives Initialize, Adjust and Finalize
+            --  are Frozen before other TSS subprograms. We don't want them
+            --  Frozen inside.
 
             if Is_Controlled (Def_Id) then
                if not Is_Limited_Type (Def_Id) then
@@ -4408,8 +4424,8 @@ package body Exp_Ch3 is
               (Def_Id, Predefined_Primitive_Freeze (Def_Id));
          end if;
 
-      --  In the non-tagged case, an equality function is provided only
-      --  for variant records (that are not unchecked unions).
+      --  In the non-tagged case, an equality function is provided only for
+      --  variant records (that are not unchecked unions).
 
       elsif Has_Discriminants (Def_Id)
         and then not Is_Limited_Type (Def_Id)
@@ -4428,10 +4444,10 @@ package body Exp_Ch3 is
       end if;
 
       --  Before building the record initialization procedure, if we are
-      --  dealing with a concurrent record value type, then we must go
-      --  through the discriminants, exchanging discriminals between the
-      --  concurrent type and the concurrent record value type. See the
-      --  section "Handling of Discriminants" in the Einfo spec for details.
+      --  dealing with a concurrent record value type, then we must go through
+      --  the discriminants, exchanging discriminals between the concurrent
+      --  type and the concurrent record value type. See the section "Handling
+      --  of Discriminants" in the Einfo spec for details.
 
       if Is_Concurrent_Record_Type (Def_Id)
         and then Has_Discriminants (Def_Id)
@@ -4472,10 +4488,9 @@ package body Exp_Ch3 is
       Adjust_Discriminants (Def_Id);
       Build_Record_Init_Proc (Type_Decl, Def_Id);
 
-      --  For tagged type, build bodies of primitive operations. Note
-      --  that we do this after building the record initialization
-      --  experiment, since the primitive operations may need the
-      --  initialization routine
+      --  For tagged type, build bodies of primitive operations. Note that we
+      --  do this after building the record initialization experiment, since
+      --  the primitive operations may need the initialization routine
 
       if Is_Tagged_Type (Def_Id) then
          Predef_List := Predefined_Primitive_Bodies (Def_Id, Renamed_Eq);
@@ -4525,15 +4540,16 @@ package body Exp_Ch3 is
    -- Freeze_Type --
    -----------------
 
-   --  Full type declarations are expanded at the point at which the type
-   --  is frozen. The formal N is the Freeze_Node for the type. Any statements
-   --  or declarations generated by the freezing (e.g. the procedure generated
+   --  Full type declarations are expanded at the point at which the type is
+   --  frozen. The formal N is the Freeze_Node for the type. Any statements or
+   --  declarations generated by the freezing (e.g. the procedure generated
    --  for initialization) are chained in the Acions field list of the freeze
    --  node using Append_Freeze_Actions.
 
-   procedure Freeze_Type (N : Node_Id) is
+   function Freeze_Type (N : Node_Id) return Boolean is
       Def_Id    : constant Entity_Id := Entity (N);
       RACW_Seen : Boolean := False;
+      Result    : Boolean := False;
 
    begin
       --  Process associated access types needing special processing
@@ -4566,13 +4582,13 @@ package body Exp_Ch3 is
          if Ekind (Def_Id) = E_Record_Type then
             Freeze_Record_Type (N);
 
-         --  The subtype may have been declared before the type was frozen.
-         --  If the type has controlled components it is necessary to create
-         --  the entity for the controller explicitly because it did not
-         --  exist at the point of the subtype declaration. Only the entity is
-         --  needed, the back-end will obtain the layout from the type.
-         --  This is only necessary if this is constrained subtype whose
-         --  component list is not shared with the base type.
+         --  The subtype may have been declared before the type was frozen. If
+         --  the type has controlled components it is necessary to create the
+         --  entity for the controller explicitly because it did not exist at
+         --  the point of the subtype declaration. Only the entity is needed,
+         --  the back-end will obtain the layout from the type. This is only
+         --  necessary if this is constrained subtype whose component list is
+         --  not shared with the base type.
 
          elsif Ekind (Def_Id) = E_Record_Subtype
            and then Has_Discriminants (Def_Id)
@@ -4596,8 +4612,20 @@ package body Exp_Ch3 is
                end if;
             end;
 
-         --  Similar process if the controller of the subtype is not
-         --  present but the parent has it. This can happen with constrained
+            if Is_Itype (Def_Id)
+              and then Is_Record_Type (Underlying_Type (Scope (Def_Id)))
+            then
+               --  The freeze node is only used to introduce the controller,
+               --  the back-end has no use for it for a discriminated
+               --   component.
+
+               Set_Freeze_Node (Def_Id, Empty);
+               Set_Has_Delayed_Freeze (Def_Id, False);
+               Result := True;
+            end if;
+
+         --  Similar process if the controller of the subtype is not present
+         --  but the parent has it. This can happen with constrained
          --  record components where the subtype is an itype.
 
          elsif Ekind (Def_Id) = E_Record_Subtype
@@ -4620,7 +4648,7 @@ package body Exp_Ch3 is
 
                Set_Freeze_Node (Def_Id, Empty);
                Set_Has_Delayed_Freeze (Def_Id, False);
-               Remove (N);
+               Result := True;
             end;
          end if;
 
@@ -4689,9 +4717,9 @@ package body Exp_Ch3 is
                   DT_Align : Node_Id;
 
                begin
-                  --  For unconstrained composite types we give a size of
-                  --  zero so that the pool knows that it needs a special
-                  --  algorithm for variable size object allocation.
+                  --  For unconstrained composite types we give a size of zero
+                  --  so that the pool knows that it needs a special algorithm
+                  --  for variable size object allocation.
 
                   if Is_Composite_Type (Desig_Type)
                     and then not Is_Constrained (Desig_Type)
@@ -4718,11 +4746,10 @@ package body Exp_Ch3 is
                     Make_Defining_Identifier (Loc,
                       Chars => New_External_Name (Chars (Def_Id), 'P'));
 
-                  --  We put the code associated with the pools in the
-                  --  entity that has the later freeze node, usually the
-                  --  acces type but it can also be the designated_type;
-                  --  because the pool code requires both those types to be
-                  --  frozen
+                  --  We put the code associated with the pools in the entity
+                  --  that has the later freeze node, usually the acces type
+                  --  but it can also be the designated_type; because the pool
+                  --  code requires both those types to be frozen
 
                   if Is_Frozen (Desig_Type)
                     and then (not Present (Freeze_Node (Desig_Type))
@@ -4784,16 +4811,16 @@ package body Exp_Ch3 is
                null;
             end if;
 
-            --  For access-to-controlled types (including class-wide types
-            --  and Taft-amendment types which potentially have controlled
-            --  components), expand the list controller object that will
-            --  store the dynamically allocated objects. Do not do this
+            --  For access-to-controlled types (including class-wide types and
+            --  Taft-amendment types which potentially have controlled
+            --  components), expand the list controller object that will store
+            --  the dynamically allocated objects. Do not do this
             --  transformation for expander-generated access types, but do it
             --  for types that are the full view of types derived from other
             --  private types. Also suppress the list controller in the case
             --  of a designated type with convention Java, since this is used
-            --  when binding to Java API specs, where there's no equivalent
-            --  of a finalization list and we don't want to pull in the
+            --  when binding to Java API specs, where there's no equivalent of
+            --  a finalization list and we don't want to pull in the
             --  finalization support if not needed.
 
             if not Comes_From_Source (Def_Id)
@@ -4864,20 +4891,21 @@ package body Exp_Ch3 is
         and then Freeze_Node (Full_View (Def_Id)) = N
       then
          Set_Entity (N, Full_View (Def_Id));
-         Freeze_Type (N);
+         Result := Freeze_Type (N);
          Set_Entity (N, Def_Id);
 
-      --  All other types require no expander action. There are such
-      --  cases (e.g. task types and protected types). In such cases,
-      --  the freeze nodes are there for use by Gigi.
+      --  All other types require no expander action. There are such cases
+      --  (e.g. task types and protected types). In such cases, the freeze
+      --  nodes are there for use by Gigi.
 
       end if;
 
       Freeze_Stream_Operations (N, Def_Id);
+      return Result;
 
    exception
       when RE_Not_Available =>
-         return;
+         return False;
    end Freeze_Type;
 
    -------------------------
@@ -4902,10 +4930,10 @@ package body Exp_Ch3 is
       --  These are the values computed by the procedure Check_Subtype_Bounds
 
       procedure Check_Subtype_Bounds;
-      --  This procedure examines the subtype T, and its ancestor subtypes
-      --  and derived types to determine the best known information about
-      --  the bounds of the subtype. After the call Lo_Bound is set either
-      --  to No_Uint if no information can be determined, or to a value which
+      --  This procedure examines the subtype T, and its ancestor subtypes and
+      --  derived types to determine the best known information about the
+      --  bounds of the subtype. After the call Lo_Bound is set either to
+      --  No_Uint if no information can be determined, or to a value which
       --  represents a known low bound, i.e. a valid value of the subtype can
       --  not be less than this value. Hi_Bound is similarly set to a known
       --  high bound (valid value cannot be greater than this).
@@ -4969,16 +4997,16 @@ package body Exp_Ch3 is
    begin
       --  For a private type, we should always have an underlying type
       --  (because this was already checked in Needs_Simple_Initialization).
-      --  What we do is to get the value for the underlying type and then
-      --  do an Unchecked_Convert to the private type.
+      --  What we do is to get the value for the underlying type and then do
+      --  an Unchecked_Convert to the private type.
 
       if Is_Private_Type (T) then
          Val := Get_Simple_Init_Val (Underlying_Type (T), Loc, Size);
 
-         --  A special case, if the underlying value is null, then qualify
-         --  it with the underlying type, so that the null is properly typed
-         --  Similarly, if it is an aggregate it must be qualified, because
-         --  an unchecked conversion does not provide a context for it.
+         --  A special case, if the underlying value is null, then qualify it
+         --  with the underlying type, so that the null is properly typed
+         --  Similarly, if it is an aggregate it must be qualified, because an
+         --  unchecked conversion does not provide a context for it.
 
          if Nkind (Val) = N_Null
            or else Nkind (Val) = N_Aggregate
@@ -5007,9 +5035,9 @@ package body Exp_Ch3 is
       elsif Is_Scalar_Type (T) then
          pragma Assert (Init_Or_Norm_Scalars);
 
-         --  Compute size of object. If it is given by the caller, we can
-         --  use it directly, otherwise we use Esize (T) as an estimate. As
-         --  far as we know this covers all cases correctly.
+         --  Compute size of object. If it is given by the caller, we can use
+         --  it directly, otherwise we use Esize (T) as an estimate. As far as
+         --  we know this covers all cases correctly.
 
          if Size = No_Uint or else Size <= Uint_0 then
             Size_To_Use := UI_Max (Uint_1, Esize (T));
@@ -5074,9 +5102,9 @@ package body Exp_Ch3 is
 
                begin
                   --  Normally we like to use the most negative number. The
-                  --  one exception is when this number is in the known subtype
-                  --  range and the largest positive number is not in the known
-                  --  subtype range.
+                  --  one exception is when this number is in the known
+                  --  subtype range and the largest positive number is not in
+                  --  the known subtype range.
 
                   --  For this exceptional case, use largest positive value
 
@@ -5491,29 +5519,29 @@ package body Exp_Ch3 is
    begin
       Renamed_Eq := Empty;
 
-      --  Spec of _Alignment
+      --  Spec of _Size
 
       Append_To (Res, Predef_Spec_Or_Body (Loc,
         Tag_Typ => Tag_Typ,
-        Name    => Name_uAlignment,
+        Name    => Name_uSize,
         Profile => New_List (
           Make_Parameter_Specification (Loc,
             Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
             Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
 
-        Ret_Type => Standard_Integer));
+        Ret_Type => Standard_Long_Long_Integer));
 
-      --  Spec of _Size
+      --  Spec of _Alignment
 
       Append_To (Res, Predef_Spec_Or_Body (Loc,
         Tag_Typ => Tag_Typ,
-        Name    => Name_uSize,
+        Name    => Name_uAlignment,
         Profile => New_List (
           Make_Parameter_Specification (Loc,
             Defining_Identifier => Make_Defining_Identifier (Loc, Name_X),
             Parameter_Type      => New_Reference_To (Tag_Typ, Loc))),
 
-        Ret_Type => Standard_Long_Long_Integer));
+        Ret_Type => Standard_Integer));
 
       --  Specs for dispatching stream attributes. We skip these for limited
       --  types, since there is no question of dispatching in the limited case.