X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fexp_disp.adb;h=12cfbdc647059e961685699bc2e59276b87801f2;hb=4c97a37dc04bd1838ea3d099bebf2900e10322dd;hp=10c0d799e7e2f842e165c1ebf760185612c49c11;hpb=cf365b48fc59b488e2cbf831dc2e9e8f59dfe0fa;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 10c0d799e7e..12cfbdc6470 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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! (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 => <>, -- Type_Is_Abstract => <>, -- Needs_Finalization => <>, - -- [ Size_Func => Size_Prim'Access ] - -- [ Interfaces_Table => <> ] + -- [ Size_Func => Size_Prim'Access, ] + -- [ Interfaces_Table => <>, ] -- [ 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 => , -- Access_Level => Type_Access_Level (Typ), + -- Alignment => Typ'Alignment, -- HT_Link => null, -- Type_Is_Abstract => <>, -- Type_Is_Library_Level => <>, @@ -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);