+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@.
-- 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.
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;
-- 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;
-- 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
-- --
-- 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- --
-- 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).
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)));
-- 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
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
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.
-- 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;
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));
projects / gcc.git / commitdiff