diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_tss.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 49 | ||||
| -rw-r--r-- | gcc/ada/sem_disp.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 17 |
8 files changed, 110 insertions, 31 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aa4aa18..c9f142f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2015-05-28 Robert Dewar <dewar@adacore.com> + + * sem_ch13.adb, sem_disp.ads: Minor reformatting. + +2015-05-28 Ed Schonberg <schonberg@adacore.com> + + * sem_util.adb (Set_Debug_Info_Needed): For a private type + whose full view is itself a derived private type, set flag on + underlying full view as well, for proper gdb display. + +2015-05-28 Bob Duff <duff@adacore.com> + + * exp_tss.ads: Minor comment fix. + * exp_ch3.adb (Build_Array_Init_Proc, Build_Record_Init_Proc): + Inline init_procs when the type has controlled parts. Remove + obsolete comments about those init_procs -- init_procs for + such types are no longer complex. A typical init_proc just + initializes the 'Tag field, and calls the parent init_proc + (e.g. for Limited_Controlled), which calls the grandparent + (for Root_Controlled), which does nothing. This all boils down + to one instruction when inlined. + * exp_ch7.adb (Create_Finalizer): Inline the finalizer. + +2015-05-28 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Analyze_Selected_Component): If the type to use + is a derived type and is a generic actual, the selected component + appears within an instance body, and the check over the type + has failed, examine ancestor types for the desired component. + (Find_Component_In_Instance): If record type is a derived type, + examine all ancestors in order to locate desired component. + 2015-05-27 H.J. Lu <hongjiu.lu@intel.com> * gcc-interface/Makefile.in (TOOLS_LIBS): Add @NO_PIE_FLAG@. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d6783d6..885e63a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -311,7 +311,7 @@ package body Exp_Ch3 is -- Predefined_Primitive_Bodies. function Has_New_Non_Standard_Rep (T : Entity_Id) return Boolean; - -- returns True if there are representation clauses for type T that are not + -- Returns True if there are representation clauses for type T that are not -- inherited. If the result is false, the init_proc and the discriminant -- checking functions of the parent can be reused by a derived type. @@ -761,14 +761,12 @@ package body Exp_Ch3 is Set_Debug_Info_Off (Proc_Id); end if; - -- Set inlined unless controlled stuff or tasks around, in which - -- case we do not want to inline, because nested stuff may cause - -- difficulties in inter-unit inlining, and furthermore there is - -- in any case no point in inlining such complex init procs. + -- Set inlined unless tasks are around, in which case we do not + -- want to inline, because nested stuff may cause difficulties in + -- inter-unit inlining, and furthermore there is in any case no + -- point in inlining such complex init procs. - if not Has_Task (Proc_Id) - and then not Needs_Finalization (Proc_Id) - then + if not Has_Task (Proc_Id) then Set_Is_Inlined (Proc_Id); end if; @@ -3619,14 +3617,10 @@ package body Exp_Ch3 is -- The initialization of protected records is not worth inlining. -- In addition, when compiled for another unit for inlining purposes, -- it may make reference to entities that have not been elaborated - -- yet. The initialization of controlled records contains a nested - -- clean-up procedure that makes it impractical to inline as well, - -- and leads to undefined symbols if inlined in a different unit. - -- Similar considerations apply to task types. + -- yet. Similar considerations apply to task types. if not Is_Concurrent_Type (Rec_Type) and then not Has_Task (Rec_Type) - and then not Needs_Finalization (Rec_Type) then Set_Is_Inlined (Proc_Id); end if; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 74854ba..23d97d5 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1440,6 +1440,13 @@ package body Exp_Ch7 is -- resides, there is no need for elaboration checks. Set_Kill_Elaboration_Checks (Fin_Id); + + -- Inlining the finalizer produces a substantial speedup at -O2. + -- It is inlined by default at -O3. Either way, it is called + -- exactly twice (once on the normal path, and once for + -- exceptions/abort), so this won't bloat the code too much. + + Set_Is_Inlined (Fin_Id); end if; -- Step 2: Creation of the finalizer specification diff --git a/gcc/ada/exp_tss.ads b/gcc/ada/exp_tss.ads index 0fd967e..a66e41d 100644 --- a/gcc/ada/exp_tss.ads +++ b/gcc/ada/exp_tss.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -213,7 +213,7 @@ package Exp_Tss is -- case arises for concurrent types. Such types do not themselves have an -- init proc TSS, but initialization is required. The init proc used is -- the one for the corresponding record type (see Base_Init_Proc). If - -- Ref is present it is call to a subprogram whose profile matches the + -- Ref is present it is a call to a subprogram whose profile matches the -- profile of the required constructor (this argument is used to handle -- non-default CPP constructors). diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8e1501a..5494d33 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6496,7 +6496,7 @@ package body Sem_Ch13 is return; end if; - -- We know we have a first subtype, now possibly go the anonymous + -- We know we have a first subtype, now possibly go to the anonymous -- base type to determine whether Rectype is a record extension. Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype))); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index bbfe118..80f0234 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4102,7 +4102,8 @@ package body Sem_Ch4 is -- searches have failed. If a match is found, the Etype of both N and -- Sel are set from this component, and the entity of Sel is set to -- reference this component. If no match is found, Entity (Sel) remains - -- unset. + -- unset. For a derived type that is an actual of the instance, the + -- desired component may be found in any ancestor. function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean; -- It is known that the parent of N denotes a subprogram call. Comp @@ -4117,18 +4118,36 @@ package body Sem_Ch4 is procedure Find_Component_In_Instance (Rec : Entity_Id) is Comp : Entity_Id; + Typ : Entity_Id; begin - Comp := First_Component (Rec); - while Present (Comp) loop - if Chars (Comp) = Chars (Sel) then - Set_Entity_With_Checks (Sel, Comp); - Set_Etype (Sel, Etype (Comp)); - Set_Etype (N, Etype (Comp)); + Typ := Rec; + while Present (Typ) loop + Comp := First_Component (Typ); + while Present (Comp) loop + if Chars (Comp) = Chars (Sel) then + Set_Entity_With_Checks (Sel, Comp); + Set_Etype (Sel, Etype (Comp)); + Set_Etype (N, Etype (Comp)); + return; + end if; + + Next_Component (Comp); + end loop; + + -- If not found, the component may be declared in the parent + -- type or its full view, if any. + + if Is_Derived_Type (Typ) then + Typ := Etype (Typ); + + if Is_Private_Type (Typ) then + Typ := Full_View (Typ); + end if; + + else return; end if; - - Next_Component (Comp); end loop; -- If we fall through, no match, so no changes made @@ -4789,6 +4808,18 @@ package body Sem_Ch4 is Par := Etype (Par); end loop; + -- Another special case: the type is an extension of a private + -- type T, is an actual in an instance, and we are in the body + -- of the instance, so the generic body had a full view of the + -- type declaration for T or of some ancestor that defines the + -- component in question. + + elsif Is_Derived_Type (Type_To_Use) + and then Used_As_Generic_Actual (Type_To_Use) + and then In_Instance_Body + then + Find_Component_In_Instance (Parent_Subtype (Type_To_Use)); + -- In ASIS mode the generic parent type may be absent. Examine -- the parent type directly for a component that may have been -- visible in a parent generic unit. diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads index 8f91c02..6100afc 100644 --- a/gcc/ada/sem_disp.ads +++ b/gcc/ada/sem_disp.ads @@ -48,11 +48,11 @@ package Sem_Disp is -- primitive operations (new primitives are only defined in package spec, -- overridden operation can be defined in any scope). If Old_Subp is not -- Empty we are in the overriding case. If the tagged type associated with - -- Subp is a concurrent type (case that occurs when the type is declared in - -- a generic because the analysis of generics disables generation of the - -- corresponding record) then this routine does not add Subp to the - -- list of primitive operations but leaves Subp decorated as dispatching - -- operation to enable checks associated with the Object.Operation notation + -- Subp is a concurrent type (case that occurs when the type is declared + -- in a generic because the analysis of generics disables generation of the + -- corresponding record) then this routine does not add Subp to the list of + -- primitive operations but leaves Subp decorated as dispatching operation + -- to enable checks associated with the Object.Operation notation. procedure Check_Operation_From_Incomplete_Type (Subp : Entity_Id; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1a3b411..d749ea1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -17704,7 +17704,22 @@ package body Sem_Util is Set_Debug_Info_Needed_If_Not_Set (Directly_Designated_Type (T)); elsif Is_Private_Type (T) then - Set_Debug_Info_Needed_If_Not_Set (Full_View (T)); + declare + FV : constant Entity_Id := Full_View (T); + + begin + Set_Debug_Info_Needed_If_Not_Set (FV); + + -- If the full view is itself a derived private type, we need + -- debug information on its underlying type. + + if Present (FV) + and then Is_Private_Type (FV) + and then Present (Underlying_Full_View (FV)) + then + Set_Needs_Debug_Info (Underlying_Full_View (FV)); + end if; + end; elsif Is_Protected_Type (T) then Set_Debug_Info_Needed_If_Not_Set (Corresponding_Record_Type (T)); |