OSDN Git Service

Daily bump.
[pf3gnuchains/gcc-fork.git] / gcc / ada / exp_disp.adb
index 10c0d79..12cfbdc 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -75,6 +75,12 @@ package body Exp_Disp is
    --  Ada 2005 (AI-251): Returns the fixed position in the dispatch table
    --  of the default primitive operations.
 
+   function Find_Specific_Type (CW : Entity_Id) return Entity_Id;
+   --  Find specific type of a class-wide type, and handle the case of an
+   --  incomplete type coming either from a limited_with clause or from an
+   --  incomplete type declaration. Shouldn't this be in Sem_Util? It seems
+   --  like a general purpose semantic routine ???
+
    function Has_DT (Typ : Entity_Id) return Boolean;
    pragma Inline (Has_DT);
    --  Returns true if we generate a dispatch table for tagged type Typ
@@ -178,11 +184,7 @@ package body Exp_Disp is
          CW_Typ := Class_Wide_Type (Ctrl_Typ);
       end if;
 
-      Typ := Root_Type (CW_Typ);
-
-      if Ekind (Typ) = E_Incomplete_Type then
-         Typ := Non_Limited_View (Typ);
-      end if;
+      Typ := Find_Specific_Type (CW_Typ);
 
       if not Is_Limited_Type (Typ) then
          Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
@@ -579,32 +581,29 @@ package body Exp_Disp is
       if Chars (E) = Name_uSize then
          return Uint_1;
 
-      elsif Chars (E) = Name_uAlignment then
-         return Uint_2;
-
       elsif TSS_Name = TSS_Stream_Read then
-         return Uint_3;
+         return Uint_2;
 
       elsif TSS_Name = TSS_Stream_Write then
-         return Uint_4;
+         return Uint_3;
 
       elsif TSS_Name = TSS_Stream_Input then
-         return Uint_5;
+         return Uint_4;
 
       elsif TSS_Name = TSS_Stream_Output then
-         return Uint_6;
+         return Uint_5;
 
       elsif Chars (E) = Name_Op_Eq then
-         return Uint_7;
+         return Uint_6;
 
       elsif Chars (E) = Name_uAssign then
-         return Uint_8;
+         return Uint_7;
 
       elsif TSS_Name = TSS_Deep_Adjust then
-         return Uint_9;
+         return Uint_8;
 
       elsif TSS_Name = TSS_Deep_Finalize then
-         return Uint_10;
+         return Uint_9;
 
       --  In VM targets unconditionally allow obtaining the position associated
       --  with predefined interface primitives since in these platforms any
@@ -612,22 +611,22 @@ package body Exp_Disp is
 
       elsif Ada_Version >= Ada_2005 or else not Tagged_Type_Expansion then
          if Chars (E) = Name_uDisp_Asynchronous_Select then
-            return Uint_11;
+            return Uint_10;
 
          elsif Chars (E) = Name_uDisp_Conditional_Select then
-            return Uint_12;
+            return Uint_11;
 
          elsif Chars (E) = Name_uDisp_Get_Prim_Op_Kind then
-            return Uint_13;
+            return Uint_12;
 
          elsif Chars (E) = Name_uDisp_Get_Task_Id then
-            return Uint_14;
+            return Uint_13;
 
          elsif Chars (E) = Name_uDisp_Requeue then
-            return Uint_15;
+            return Uint_14;
 
          elsif Chars (E) = Name_uDisp_Timed_Select then
-            return Uint_16;
+            return Uint_15;
          end if;
       end if;
 
@@ -695,13 +694,14 @@ package body Exp_Disp is
       end if;
 
       --  Expand_Dispatching_Call is called directly from the semantics,
-      --  so we need a check to see whether expansion is active before
-      --  proceeding. In addition, there is no need to expand the call
-      --  if we are compiling under restriction No_Dispatching_Calls;
-      --  the semantic analyzer has previously notified the violation
-      --  of this restriction.
+      --  so we only proceed if the expander is active.
+
+      if not Full_Expander_Active
+
+        --  And there is no need to expand the call if we are compiling under
+        --  restriction No_Dispatching_Calls; the semantic analyzer has
+        --  previously notified the violation of this restriction.
 
-      if not Expander_Active
         or else Restriction_Active (No_Dispatching_Calls)
       then
          return;
@@ -748,11 +748,7 @@ package body Exp_Disp is
          CW_Typ := Class_Wide_Type (Ctrl_Typ);
       end if;
 
-      Typ := Root_Type (CW_Typ);
-
-      if Ekind (Typ) = E_Incomplete_Type then
-         Typ := Non_Limited_View (Typ);
-      end if;
+      Typ := Find_Specific_Type (CW_Typ);
 
       if not Is_Limited_Type (Typ) then
          Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq);
@@ -807,6 +803,11 @@ package body Exp_Disp is
       Subp_Ptr_Typ := Create_Itype (E_Access_Subprogram_Type, Call_Node);
       Set_Etype          (Subp_Typ, Res_Typ);
       Set_Returns_By_Ref (Subp_Typ, Returns_By_Ref (Subp));
+      Set_Convention     (Subp_Typ, Convention (Subp));
+
+      --  Notify gigi that the designated type is a dispatching primitive
+
+      Set_Is_Dispatch_Table_Entity (Subp_Typ);
 
       --  Create a new list of parameters which is a copy of the old formal
       --  list including the creation of a new set of matching entities.
@@ -1846,6 +1847,7 @@ package body Exp_Disp is
 
       Thunk_Id := Make_Temporary (Loc, 'T');
       Set_Is_Thunk (Thunk_Id);
+      Set_Convention (Thunk_Id, Convention (Prim));
 
       --  Procedure case
 
@@ -1886,6 +1888,25 @@ package body Exp_Disp is
       end if;
    end Expand_Interface_Thunk;
 
+   ------------------------
+   -- Find_Specific_Type --
+   ------------------------
+
+   function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
+      Typ : Entity_Id := Root_Type (CW);
+
+   begin
+      if Ekind (Typ) = E_Incomplete_Type then
+         if From_With_Type (Typ) then
+            Typ := Non_Limited_View (Typ);
+         else
+            Typ := Full_View (Typ);
+         end if;
+      end if;
+
+      return Typ;
+   end Find_Specific_Type;
+
    --------------------------
    -- Has_CPP_Constructors --
    --------------------------
@@ -1944,7 +1965,6 @@ package body Exp_Disp is
          TSS_Name := TSS_Name_Type (Name_Buffer (Name_Len - TSS_Name'Length + 1
                                      .. Name_Len));
          if        Chars (E) = Name_uSize
-           or else Chars (E) = Name_uAlignment
            or else TSS_Name  = TSS_Stream_Read
            or else TSS_Name  = TSS_Stream_Write
            or else TSS_Name  = TSS_Stream_Input
@@ -1990,7 +2010,6 @@ package body Exp_Disp is
              (Name_Buffer (Name_Len - TSS_Name'Length + 1 .. Name_Len));
 
          if        Chars (E) = Name_uSize
-           or else Chars (E) = Name_uAlignment
            or else
              (Chars (E) = Name_Op_Eq
                 and then Etype (First_Formal (E)) = Etype (Last_Formal (E)))
@@ -2051,7 +2070,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Asynchronous_Select;
 
    --  For protected types, generate:
@@ -2116,13 +2136,13 @@ package body Exp_Disp is
       if Is_Interface (Typ) then
          return
            Make_Subprogram_Body (Loc,
-             Specification =>
-               Make_Disp_Asynchronous_Select_Spec (Typ),
-             Declarations =>
-               New_List,
+             Specification => Make_Disp_Asynchronous_Select_Spec (Typ),
+             Declarations  => New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (Make_Assignment_Statement (Loc,
+                   Name       => Make_Identifier (Loc, Name_uF),
+                   Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -2262,6 +2282,14 @@ package body Exp_Disp is
                     Expression =>
                       New_Reference_To (Com_Block, Loc))));
 
+            --  Generate:
+            --    F := False;
+
+            Append_To (Stmts,
+              Make_Assignment_Statement (Loc,
+                Name       => Make_Identifier (Loc, Name_uF),
+                Expression => New_Reference_To (Standard_False, Loc)));
+
          else
             pragma Assert (Ekind (Conc_Typ) = E_Task_Type);
 
@@ -2300,15 +2328,17 @@ package body Exp_Disp is
       else
          --  Ensure that the statements list is non-empty
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
+          Specification              =>
             Make_Disp_Asynchronous_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Asynchronous_Select_Body;
@@ -2391,7 +2421,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Conditional_Select;
 
    --  For protected types, generate:
@@ -2474,7 +2505,9 @@ package body Exp_Disp is
                No_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (Make_Assignment_Statement (Loc,
+                   Name       => Make_Identifier (Loc, Name_uF),
+                   Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -2675,17 +2708,23 @@ package body Exp_Disp is
          end if;
 
       else
-         --  Ensure that the statements list is non-empty
+         --  Initialize out parameters
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uC),
+             Expression => New_Reference_To (RTE (RE_POK_Function), Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
+          Specification              =>
             Make_Disp_Conditional_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Conditional_Select_Body;
@@ -3235,7 +3274,8 @@ package body Exp_Disp is
    --        F : out Boolean)
    --     is
    --     begin
-   --        null;
+   --        F := False;
+   --        C := Ada.Tags.POK_Function;
    --     end _Disp_Timed_Select;
 
    --  For protected types, generate:
@@ -3294,7 +3334,7 @@ package body Exp_Disp is
    --           P,
    --           D,
    --           M,
-   --           D);
+   --           F);
    --     end _Disp_Time_Select;
 
    function Make_Disp_Timed_Select_Body
@@ -3321,7 +3361,10 @@ package body Exp_Disp is
                New_List,
              Handled_Statement_Sequence =>
                Make_Handled_Sequence_Of_Statements (Loc,
-                 New_List (Make_Null_Statement (Loc))));
+                 New_List (
+                   Make_Assignment_Statement (Loc,
+                     Name       => Make_Identifier (Loc, Name_uF),
+                     Expression => New_Reference_To (Standard_False, Loc)))));
       end if;
 
       if Is_Concurrent_Record_Type (Typ) then
@@ -3335,10 +3378,8 @@ package body Exp_Disp is
 
          Append_To (Decls,
            Make_Object_Declaration (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Name_uI),
-             Object_Definition =>
-               New_Reference_To (Standard_Integer, Loc)));
+             Defining_Identifier => Make_Defining_Identifier (Loc, Name_uI),
+             Object_Definition   => New_Reference_To (Standard_Integer, Loc)));
 
          --  Generate:
          --    C := Get_Prim_Op_Kind (tag! (<type>VP), S);
@@ -3367,7 +3408,7 @@ package body Exp_Disp is
          else
             Tag_Node :=
               Make_Attribute_Reference (Loc,
-                Prefix => New_Reference_To (Typ, Loc),
+                Prefix         => New_Reference_To (Typ, Loc),
                 Attribute_Name => Name_Tag);
          end if;
 
@@ -3376,8 +3417,7 @@ package body Exp_Disp is
              Name       => Make_Identifier (Loc, Name_uI),
              Expression =>
                Make_Function_Call (Loc,
-                 Name =>
-                   New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
+                 Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
                  Parameter_Associations =>
                    New_List (
                      Tag_Node,
@@ -3500,17 +3540,22 @@ package body Exp_Disp is
          end if;
 
       else
-         --  Ensure that the statements list is non-empty
+         --  Initialize out parameters
 
-         Append_To (Stmts, Make_Null_Statement (Loc));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uF),
+             Expression => New_Reference_To (Standard_False, Loc)));
+         Append_To (Stmts,
+           Make_Assignment_Statement (Loc,
+             Name       => Make_Identifier (Loc, Name_uC),
+             Expression => New_Reference_To (RTE (RE_POK_Function), Loc)));
       end if;
 
       return
         Make_Subprogram_Body (Loc,
-          Specification =>
-            Make_Disp_Timed_Select_Spec (Typ),
-          Declarations =>
-            Decls,
+          Specification              => Make_Disp_Timed_Select_Spec (Typ),
+          Declarations               => Decls,
           Handled_Statement_Sequence =>
             Make_Handled_Sequence_Of_Statements (Loc, Stmts));
    end Make_Disp_Timed_Select_Body;
@@ -3699,13 +3744,61 @@ package body Exp_Disp is
       is
          Comp : Entity_Id;
 
+         function Is_Actual_For_Formal_Incomplete_Type
+           (T : Entity_Id) return Boolean;
+         --  In Ada 2012, if a nested generic has an incomplete formal type,
+         --  the actual may be (and usually is) a private type whose completion
+         --  appears later. It is safe to build the dispatch table in this
+         --  case, gigi will have full views available.
+
+         ------------------------------------------
+         -- Is_Actual_For_Formal_Incomplete_Type --
+         ------------------------------------------
+
+         function Is_Actual_For_Formal_Incomplete_Type
+           (T : Entity_Id) return Boolean
+         is
+            Gen_Par : Entity_Id;
+            F       : Node_Id;
+
+         begin
+            if not Is_Generic_Instance (Current_Scope)
+              or else not Used_As_Generic_Actual (T)
+            then
+               return False;
+
+            else
+               Gen_Par := Generic_Parent (Parent (Current_Scope));
+            end if;
+
+            F :=
+              First
+                (Generic_Formal_Declarations
+                     (Unit_Declaration_Node (Gen_Par)));
+            while Present (F) loop
+               if Ekind (Defining_Identifier (F)) = E_Incomplete_Type then
+                  return True;
+               end if;
+
+               Next (F);
+            end loop;
+
+            return False;
+         end Is_Actual_For_Formal_Incomplete_Type;
+
+      --  Start of processing for Check_Premature_Freezing
+
       begin
+         --  Note that if the type is a (subtype of) a generic actual, the
+         --  actual will have been frozen by the instantiation.
+
          if Present (N)
            and then Is_Private_Type (Typ)
            and then No (Full_View (Typ))
            and then not Is_Generic_Type (Typ)
            and then not Is_Tagged_Type (Typ)
            and then not Is_Frozen (Typ)
+           and then not Is_Generic_Actual_Type (Typ)
          then
             Error_Msg_Sloc := Sloc (Subp);
             Error_Msg_NE
@@ -3720,6 +3813,8 @@ package body Exp_Disp is
             if not Is_Tagged_Type (Typ)
               and then Present (Comp)
               and then not Is_Frozen (Comp)
+              and then
+                not Is_Actual_For_Formal_Incomplete_Type (Comp)
             then
                Error_Msg_Sloc := Sloc (Subp);
                Error_Msg_Node_2 := Subp;
@@ -4436,16 +4531,16 @@ package body Exp_Disp is
       end if;
 
       --  Ensure that the value of Max_Predef_Prims defined in a-tags is
-      --  correct. Valid values are 10 under configurable runtime or 16
+      --  correct. Valid values are 9 under configurable runtime or 15
       --  with full runtime.
 
       if RTE_Available (RE_Interface_Data) then
-         if Max_Predef_Prims /= 16 then
+         if Max_Predef_Prims /= 15 then
             Error_Msg_N ("run-time library configuration error", Typ);
             return Result;
          end if;
       else
-         if Max_Predef_Prims /= 10 then
+         if Max_Predef_Prims /= 9 then
             Error_Msg_N ("run-time library configuration error", Typ);
             Error_Msg_CRT ("tagged types", Typ);
             return Result;
@@ -4769,14 +4864,15 @@ package body Exp_Disp is
       --   TSD : Type_Specific_Data (I_Depth) :=
       --           (Idepth             => I_Depth,
       --            Access_Level       => Type_Access_Level (Typ),
+      --            Alignment          => Typ'Alignment,
       --            Expanded_Name      => Cstring_Ptr!(Exname'Address))
       --            External_Tag       => Cstring_Ptr!(Exname'Address))
       --            HT_Link            => HT_Link'Address,
       --            Transportable      => <<boolean-value>>,
       --            Type_Is_Abstract   => <<boolean-value>>,
       --            Needs_Finalization => <<boolean-value>>,
-      --            [ Size_Func         => Size_Prim'Access ]
-      --            [ Interfaces_Table  => <<access-value>> ]
+      --            [ Size_Func         => Size_Prim'Access, ]
+      --            [ Interfaces_Table  => <<access-value>>, ]
       --            [ SSD               => SSD_Table'Address ]
       --            Tags_Table         => (0 => null,
       --                                   1 => Parent'Tag
@@ -4818,12 +4914,29 @@ package body Exp_Disp is
       Append_To (TSD_Aggr_List,
         Make_Integer_Literal (Loc, Type_Access_Level (Typ)));
 
+      --  Alignment
+
+      --  For CPP types we cannot rely on the value of 'Alignment provided
+      --  by the backend to initialize this TSD field.
+
+      if Convention (Typ) = Convention_CPP
+        or else Is_CPP_Class (Root_Type (Typ))
+      then
+         Append_To (TSD_Aggr_List,
+           Make_Integer_Literal (Loc, 0));
+      else
+         Append_To (TSD_Aggr_List,
+           Make_Attribute_Reference (Loc,
+             Prefix => New_Reference_To (Typ, Loc),
+             Attribute_Name => Name_Alignment));
+      end if;
+
       --  Expanded_Name
 
       Append_To (TSD_Aggr_List,
         Unchecked_Convert_To (RTE (RE_Cstring_Ptr),
           Make_Attribute_Reference (Loc,
-            Prefix => New_Reference_To (Exname, Loc),
+            Prefix         => New_Reference_To (Exname, Loc),
             Attribute_Name => Name_Address)));
 
       --  External_Tag of a local tagged type
@@ -6368,6 +6481,7 @@ package body Exp_Disp is
       --           (Idepth                => I_Depth,
       --            Tag_Kind              => <tag_kind-value>,
       --            Access_Level          => Type_Access_Level (Typ),
+      --            Alignment             => Typ'Alignment,
       --            HT_Link               => null,
       --            Type_Is_Abstract      => <<boolean-value>>,
       --            Type_Is_Library_Level => <<boolean-value>>,
@@ -6418,6 +6532,23 @@ package body Exp_Disp is
       Append_To (TSD_Aggr_List,
         Make_Integer_Literal (Loc, Type_Access_Level (Typ)));
 
+      --  Alignment
+
+      --  For CPP types we cannot rely on the value of 'Alignment provided
+      --  by the backend to initialize this TSD field. Why not???
+
+      if Convention (Typ) = Convention_CPP
+        or else Is_CPP_Class (Root_Type (Typ))
+      then
+         Append_To (TSD_Aggr_List,
+           Make_Integer_Literal (Loc, 0));
+      else
+         Append_To (TSD_Aggr_List,
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Reference_To (Typ, Loc),
+             Attribute_Name => Name_Alignment));
+      end if;
+
       --  HT_Link
 
       Append_To (TSD_Aggr_List,
@@ -6482,13 +6613,13 @@ package body Exp_Disp is
                      Make_Aggregate (Loc,
                        Expressions => New_List (
 
-                           --  Iface_Tag
+                         --  Iface_Tag
 
                          Make_Attribute_Reference (Loc,
                            Prefix         => New_Reference_To (Iface, Loc),
                            Attribute_Name => Name_Tag),
 
-                           --  OSD
+                         --  OSD
 
                          Make_OSD (Iface))));
 
@@ -6560,7 +6691,7 @@ package body Exp_Disp is
 
             Append_To (TSD_Aggr_List,
               Make_Attribute_Reference (Loc,
-                Prefix => New_Reference_To (SSD, Loc),
+                Prefix         => New_Reference_To (SSD, Loc),
                 Attribute_Name => Name_Unchecked_Access));
          else
             Append_To (TSD_Aggr_List, Make_Null (Loc));
@@ -6576,7 +6707,7 @@ package body Exp_Disp is
 
       Append_To (TSD_Tags_List,
         Make_Attribute_Reference (Loc,
-          Prefix => New_Reference_To (Typ, Loc),
+          Prefix         => New_Reference_To (Typ, Loc),
           Attribute_Name => Name_Tag));
 
       --  Fill the rest of the table with the tags of the ancestors
@@ -6601,7 +6732,7 @@ package body Exp_Disp is
 
             Append_To (TSD_Tags_List,
               Make_Attribute_Reference (Loc,
-                Prefix => New_Reference_To (Parent_Typ, Loc),
+                Prefix         => New_Reference_To (Parent_Typ, Loc),
                 Attribute_Name => Name_Tag));
 
             Pos := Pos + 1;
@@ -6809,7 +6940,7 @@ package body Exp_Disp is
                else
                   Tag_Node :=
                     Make_Attribute_Reference (Loc,
-                      Prefix => New_Reference_To (Typ, Loc),
+                      Prefix         => New_Reference_To (Typ, Loc),
                       Attribute_Name => Name_Tag);
                end if;
 
@@ -6842,7 +6973,7 @@ package body Exp_Disp is
                   else
                      Tag_Node :=
                        Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Typ, Loc),
+                         Prefix         => New_Reference_To (Typ, Loc),
                          Attribute_Name => Name_Tag);
                   end if;
 
@@ -7047,15 +7178,15 @@ package body Exp_Disp is
                    Defining_Identifier => DT_Ptr,
                    Constant_Present    => True,
                    Object_Definition   => New_Reference_To (RTE (RE_Tag), Loc),
-                   Expression =>
+                   Expression          =>
                      Unchecked_Convert_To (RTE (RE_Tag),
                        Make_Attribute_Reference (Loc,
-                         Prefix =>
+                         Prefix         =>
                            Make_Selected_Component (Loc,
-                             Prefix => New_Reference_To (DT, Loc),
-                           Selector_Name =>
-                             New_Occurrence_Of
-                               (RTE_Record_Component (RE_Prims_Ptr), Loc)),
+                             Prefix        => New_Reference_To (DT, Loc),
+                             Selector_Name =>
+                               New_Occurrence_Of
+                                 (RTE_Record_Component (RE_Prims_Ptr), Loc)),
                          Attribute_Name => Name_Address))));
 
                --  Generate the SCIL node for the previous object declaration
@@ -7072,16 +7203,16 @@ package body Exp_Disp is
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Predef_Prims_Ptr,
                    Constant_Present    => True,
-                   Object_Definition   => New_Reference_To
-                                               (RTE (RE_Address), Loc),
-                   Expression =>
+                   Object_Definition   =>
+                     New_Reference_To (RTE (RE_Address), Loc),
+                   Expression          =>
                      Make_Attribute_Reference (Loc,
-                       Prefix =>
+                       Prefix         =>
                          Make_Selected_Component (Loc,
-                           Prefix => New_Reference_To (DT, Loc),
-                         Selector_Name =>
-                           New_Occurrence_Of
-                             (RTE_Record_Component (RE_Predef_Prims), Loc)),
+                           Prefix        => New_Reference_To (DT, Loc),
+                           Selector_Name =>
+                             New_Occurrence_Of
+                               (RTE_Record_Component (RE_Predef_Prims), Loc)),
                        Attribute_Name => Name_Address)));
 
             --  No dispatch table required
@@ -7092,15 +7223,16 @@ package body Exp_Disp is
                    Defining_Identifier => DT_Ptr,
                    Constant_Present    => True,
                    Object_Definition   => New_Reference_To (RTE (RE_Tag), Loc),
-                   Expression =>
+                   Expression          =>
                      Unchecked_Convert_To (RTE (RE_Tag),
                        Make_Attribute_Reference (Loc,
-                         Prefix =>
+                         Prefix         =>
                            Make_Selected_Component (Loc,
                              Prefix => New_Reference_To (DT, Loc),
-                           Selector_Name =>
-                             New_Occurrence_Of
-                               (RTE_Record_Component (RE_NDT_Prims_Ptr), Loc)),
+                             Selector_Name =>
+                               New_Occurrence_Of
+                                 (RTE_Record_Component (RE_NDT_Prims_Ptr),
+                                  Loc)),
                          Attribute_Name => Name_Address))));
             end if;
 
@@ -7210,15 +7342,17 @@ package body Exp_Disp is
                       Constant_Present    => True,
                       Object_Definition   => New_Reference_To
                                                (RTE (RE_Interface_Tag), Loc),
-                      Expression =>
+                      Expression          =>
                         Unchecked_Convert_To (RTE (RE_Interface_Tag),
                           Make_Attribute_Reference (Loc,
-                            Prefix =>
+                            Prefix         =>
                               Make_Selected_Component (Loc,
-                                Prefix => New_Reference_To (Iface_DT, Loc),
-                              Selector_Name =>
-                                New_Occurrence_Of
-                                  (RTE_Record_Component (RE_Prims_Ptr), Loc)),
+                                Prefix        =>
+                                  New_Reference_To (Iface_DT, Loc),
+                                Selector_Name =>
+                                  New_Occurrence_Of
+                                    (RTE_Record_Component (RE_Prims_Ptr),
+                                     Loc)),
                             Attribute_Name => Name_Address))));
                end if;
 
@@ -7562,7 +7696,7 @@ package body Exp_Disp is
                 Address_Node =>
                   Unchecked_Convert_To (RTE (RE_Prim_Ptr),
                     Make_Attribute_Reference (Loc,
-                      Prefix => New_Reference_To (Prim, Loc),
+                      Prefix         => New_Reference_To (Prim, Loc),
                       Attribute_Name => Name_Unrestricted_Access))));
 
             --  Register copy of the pointer to the 'size primitive in the TSD
@@ -7595,7 +7729,7 @@ package body Exp_Disp is
                    Address_Node =>
                      Unchecked_Convert_To (RTE (RE_Prim_Ptr),
                        Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Prim, Loc),
+                         Prefix         => New_Reference_To (Prim, Loc),
                          Attribute_Name => Name_Unrestricted_Access))));
             end if;
          end if;
@@ -7675,7 +7809,8 @@ package body Exp_Disp is
                    Address_Node =>
                      Unchecked_Convert_To (RTE (RE_Prim_Ptr),
                        Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Alias (Prim), Loc),
+                         Prefix          =>
+                           New_Reference_To (Alias (Prim), Loc),
                          Attribute_Name  => Name_Unrestricted_Access))));
 
             else
@@ -7706,7 +7841,8 @@ package body Exp_Disp is
                    Address_Node =>
                      Unchecked_Convert_To (RTE (RE_Prim_Ptr),
                        Make_Attribute_Reference (Loc,
-                         Prefix => New_Reference_To (Alias (Prim), Loc),
+                         Prefix         =>
+                           New_Reference_To (Alias (Prim), Loc),
                          Attribute_Name => Name_Unrestricted_Access))));
 
             end if;
@@ -7870,8 +8006,8 @@ package body Exp_Disp is
       First_Prim : constant Elmt_Id := First_Elmt (Primitive_Operations (Typ));
       The_Tag    : constant Entity_Id := First_Tag_Component (Typ);
 
-      Adjusted   : Boolean := False;
-      Finalized  : Boolean := False;
+      Adjusted  : Boolean := False;
+      Finalized : Boolean := False;
 
       Count_Prim : Nat;
       DT_Length  : Nat;
@@ -8330,8 +8466,9 @@ package body Exp_Disp is
 
                Set_Init_Proc (Typ, Init);
                Set_Is_Imported    (Init);
+               Set_Is_Constructor (Init);
                Set_Interface_Name (Init, Interface_Name (E));
-               Set_Convention     (Init, Convention_C);
+               Set_Convention     (Init, Convention_CPP);
                Set_Is_Public      (Init);
                Set_Has_Completion (Init);
             end if;
@@ -8424,8 +8561,9 @@ package body Exp_Disp is
                   Parameter_Specifications => Parms));
 
             Set_Is_Imported    (Constructor_Id);
+            Set_Is_Constructor (Constructor_Id);
             Set_Interface_Name (Constructor_Id, Interface_Name (E));
-            Set_Convention     (Constructor_Id, Convention_C);
+            Set_Convention     (Constructor_Id, Convention_CPP);
             Set_Is_Public      (Constructor_Id);
             Set_Has_Completion (Constructor_Id);