diff options
-rw-r--r-- | gcc/ada/exp_ch3.adb | 4 | ||||
-rw-r--r-- | gcc/ada/exp_disp.adb | 160 | ||||
-rw-r--r-- | gcc/ada/exp_disp.ads | 10 | ||||
-rw-r--r-- | gcc/ada/freeze.adb | 20 | ||||
-rw-r--r-- | gcc/ada/freeze.ads | 6 |
5 files changed, 19 insertions, 181 deletions
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 4216fec..87a84b4 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6909,9 +6909,9 @@ package body Exp_Ch3 is begin if Is_Concurrent_Type (Base_Typ) then - New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ), N); + New_Nodes := Make_DT (Corresponding_Record_Type (Base_Typ)); else - New_Nodes := Make_DT (Base_Typ, N); + New_Nodes := Make_DT (Base_Typ); end if; Insert_List_Before (N, New_Nodes); diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index e9967b4..a0a3449 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3660,7 +3660,7 @@ package body Exp_Disp is -- replaced by gotos which jump to the end of the routine and restore the -- Ghost mode. - function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id is + function Make_DT (Typ : Entity_Id) return List_Id is Loc : constant Source_Ptr := Sloc (Typ); Max_Predef_Prims : constant Int := @@ -3678,23 +3678,6 @@ package body Exp_Disp is -- offset to the components that reference secondary dispatch tables. -- Used to compute the offset of components located at fixed position. - procedure Check_Premature_Freezing - (Subp : Entity_Id; - Tagged_Type : Entity_Id; - Typ : Entity_Id); - -- Verify that all untagged types in the profile of a subprogram are - -- frozen at the point the subprogram is frozen. This enforces the rule - -- on RM 13.14 (14) as modified by AI05-019. At the point a subprogram - -- is frozen, enough must be known about it to build the activation - -- record for it, which requires at least that the size of all - -- parameters be known. Controlling arguments are by-reference, - -- and therefore the rule only applies to untagged types. Typical - -- violation of the rule involves an object declaration that freezes a - -- tagged type, when one of its primitive operations has a type in its - -- profile whose full view has not been analyzed yet. More complex cases - -- involve composite types that have one private unfrozen subcomponent. - -- Move this check to sem??? - procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0); -- Export the dispatch table DT of tagged type Typ. Required to generate -- forward references and statically allocate the table. For primary @@ -3733,103 +3716,6 @@ package body Exp_Disp is function Number_Of_Predefined_Prims (Typ : Entity_Id) return Nat; -- Returns the number of predefined primitives of Typ - ------------------------------ - -- Check_Premature_Freezing -- - ------------------------------ - - procedure Check_Premature_Freezing - (Subp : Entity_Id; - Tagged_Type : Entity_Id; - Typ : Entity_Id) - 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 Has_Private_Declaration (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 - ("declaration must appear after completion of type &", N, Typ); - Error_Msg_NE - ("\which is an untagged type in the profile of " - & "primitive operation & declared#", N, Subp); - - else - Comp := Private_Component (Typ); - - if not Is_Tagged_Type (Typ) - and then Present (Comp) - and then not Is_Frozen (Comp) - and then not Has_Private_Declaration (Comp) - and then not Is_Actual_For_Formal_Incomplete_Type (Comp) - then - Error_Msg_Sloc := Sloc (Subp); - Error_Msg_NE - ("declaration must appear after completion of type &", - N, Comp); - Error_Msg_Node_2 := Subp; - Error_Msg_Name_1 := Chars (Tagged_Type); - Error_Msg_NE - ("\which is a component of untagged type& in the profile " - & "of primitive & of type % that is frozen by the " - & "declaration", N, Typ); - end if; - end if; - end Check_Premature_Freezing; - --------------- -- Export_DT -- --------------- @@ -4584,55 +4470,31 @@ package body Exp_Disp is end if; -- Ensure that all the primitives are frozen. This is only required when - -- building static dispatch tables --- the primitives must be frozen to - -- be referenced (otherwise we have problems with the backend). It is + -- building static dispatch tables: the primitives must be frozen to be + -- referenced, otherwise we have problems with the back end. But this is -- not a requirement with nonstatic dispatch tables because in this case - -- we generate now an empty dispatch table; the extra code required to - -- register the primitives in the slots will be generated later --- when - -- each primitive is frozen (see Freeze_Subprogram). + -- we generate an empty dispatch table at this point and the extra code + -- required to register the primitives in their slot will be generated + -- later, when each primitive is frozen (see Freeze_Subprogram). if Building_Static_DT (Typ) then declare - Saved_FLLTT : constant Boolean := - Freezing_Library_Level_Tagged_Type; - - Formal : Entity_Id; - Frnodes : List_Id; + F_List : List_Id; Prim : Entity_Id; Prim_Elmt : Elmt_Id; begin - Freezing_Library_Level_Tagged_Type := True; - Prim_Elmt := First_Elmt (Primitive_Operations (Typ)); while Present (Prim_Elmt) loop - Prim := Node (Prim_Elmt); - Frnodes := Freeze_Entity (Prim, Typ); - - -- We disable this check for abstract subprograms, given that - -- they cannot be called directly and thus the state of their - -- untagged formals is of no concern. The RM is unclear in any - -- case concerning the need for this check, and this topic may - -- go back to the ARG. - - if not Is_Abstract_Subprogram (Prim) then - Formal := First_Formal (Prim); - while Present (Formal) loop - Check_Premature_Freezing (Prim, Typ, Etype (Formal)); - Next_Formal (Formal); - end loop; - - Check_Premature_Freezing (Prim, Typ, Etype (Prim)); - end if; + Prim := Node (Prim_Elmt); + F_List := Freeze_Entity (Prim, Typ, Do_Freeze_Profile => False); - if Present (Frnodes) then - Append_List_To (Result, Frnodes); + if Present (F_List) then + Append_List_To (Result, F_List); end if; Next_Elmt (Prim_Elmt); end loop; - - Freezing_Library_Level_Tagged_Type := Saved_FLLTT; end; end if; diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index cbb5ba6..96eae30 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -168,11 +168,9 @@ package Exp_Disp is -- Generate checks required on dispatching calls function Building_Static_DT (Typ : Entity_Id) return Boolean; - pragma Inline (Building_Static_DT); -- Returns true when building statically allocated dispatch tables function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean; - pragma Inline (Building_Static_Secondary_DT); -- Returns true when building statically allocated secondary dispatch -- tables @@ -187,7 +185,6 @@ package Exp_Disp is function Convert_Tag_To_Interface (Typ : Entity_Id; Expr : Node_Id) return Node_Id; - pragma Inline (Convert_Tag_To_Interface); -- This function is used in class-wide interface conversions; the expanded -- code generated to convert a tagged object to a class-wide interface type -- involves referencing the tag component containing the secondary dispatch @@ -256,11 +253,8 @@ package Exp_Disp is function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean; -- Returns true if N is the expanded code of a dispatching call - function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id; - -- Expand the declarations for the Dispatch Table. The node N is the - -- declaration that forces the generation of the table. It is used to place - -- error messages when the declaration leads to the freezing of a given - -- primitive operation that has an incomplete non- tagged formal. + function Make_DT (Typ : Entity_Id) return List_Id; + -- Expand the declarations for the Dispatch Table of Typ function Make_Disp_Asynchronous_Select_Body (Typ : Entity_Id) return Node_Id; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4ff7036..0301bf4 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4631,9 +4631,7 @@ package body Freeze is Result := No_List; return False; - elsif not After_Last_Declaration - and then not Freezing_Library_Level_Tagged_Type - then + elsif not After_Last_Declaration then Error_Msg_NE ("type & must be fully defined before this point", N, @@ -4751,17 +4749,6 @@ package body Freeze is if Is_Access_Type (F_Type) then F_Type := Designated_Type (F_Type); end if; - - -- If the formal is an anonymous_access_to_subprogram - -- freeze the subprogram type as well, to prevent - -- scope anomalies in gigi, because there is no other - -- clear point at which it could be frozen. - - if Is_Itype (Etype (Formal)) - and then Ekind (F_Type) = E_Subprogram_Type - then - Freeze_And_Append (F_Type, N, Result); - end if; end if; Next_Formal (Formal); @@ -6490,9 +6477,10 @@ package body Freeze is -- In Ada 2012, freezing a subprogram does not always freeze the -- corresponding profile (see AI05-019). An attribute reference - -- is not a freezing point of the profile. Flag Do_Freeze_Profile + -- is not a freezing point of the profile. Similarly, we do not + -- freeze the profile of primitives of a library-level tagged type + -- when we are building its dispatch table. Flag Do_Freeze_Profile -- indicates whether the profile should be frozen now. - -- Other constructs that should not freeze ??? -- This processing doesn't apply to internal entities (see below) diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads index 749fb79..bef4e14 100644 --- a/gcc/ada/freeze.ads +++ b/gcc/ada/freeze.ads @@ -120,12 +120,6 @@ package Freeze is -- where the freeze node is preallocated at the point of declaration, so -- that the First_Subtype_Link field can be set. - Freezing_Library_Level_Tagged_Type : Boolean := False; - -- Flag used to indicate that we are freezing the primitives of a library - -- level tagged type. Used to disable checks on premature freezing. - -- More documentation needed??? why is this flag needed? what are these - -- checks? why do they need disabling in some cases? - ----------------- -- Subprograms -- ----------------- |