From: Arnaud Charlet Date: Mon, 20 Apr 2009 08:35:16 +0000 (+0200) Subject: [multiple changes] X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=26a43556c88b96c608246b39023bc698be3b751d;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2009-04-20 Arnaud Charlet * switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining in inspector mode. 2009-04-20 Javier Miranda * sem_ch6.adb (New_Overloaded_Entity): Minor reformating. * sem_ch6.ads (Subtype_Conformant, Type_Conformant): Add missing documentation. * exp_aggr.adb (Build_Record_Aggr_Code): Code cleanup. * sem_disp.adb (Check_Dispatching_Operation): Set attribute Is_Dispatching_Operation in internally built overriding subprograms. 2009-04-20 Doug Rupp * s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types. * s-auxdec.ads: Likewise 2009-04-20 Ed Schonberg * sem_ch3.adb (Find_Type_Name): Reject the completion of a private type by an interface. * exp_ch6.adb (Expand_Call): Inline To_Address unconditionally, to minimze difference in expanded tree when compiled as spec of the main unit, or as a spec in the context of another unit. From-SVN: r146370 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b9463f6..447a783 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2009-04-20 Arnaud Charlet + + * switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining + in inspector mode. + +2009-04-20 Javier Miranda + + * sem_ch6.adb (New_Overloaded_Entity): Minor reformating. + + * sem_ch6.ads (Subtype_Conformant, Type_Conformant): Add missing + documentation. + + * exp_aggr.adb (Build_Record_Aggr_Code): Code cleanup. + + * sem_disp.adb + (Check_Dispatching_Operation): Set attribute Is_Dispatching_Operation + in internally built overriding subprograms. + +2009-04-20 Doug Rupp + + * s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types. + + * s-auxdec.ads: Likewise + +2009-04-20 Ed Schonberg + + * sem_ch3.adb (Find_Type_Name): Reject the completion of a private + type by an interface. + + * exp_ch6.adb (Expand_Call): Inline To_Address unconditionally, to + minimze difference in expanded tree when compiled as spec of the main + unit, or as a spec in the context of another unit. + 2009-04-20 Hristian Kirtchev * a-calend.adb: Remove types char_Pointer, int, tm and tm_Pointer. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index bd9fb0d..471a3ae 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2439,12 +2439,8 @@ package body Exp_Aggr is -- to the actual type of the aggregate, so that the proper components -- are visible. We know already that the types are compatible. - -- There should also be a comment here explaining why the conversion - -- is needed in the case of interfaces.??? - if Present (Etype (Lhs)) - and then (Is_Interface (Etype (Lhs)) - or else Is_Class_Wide_Type (Etype (Lhs))) + and then Is_Class_Wide_Type (Etype (Lhs)) then Target := Unchecked_Convert_To (Typ, Lhs); else @@ -2555,11 +2551,9 @@ package body Exp_Aggr is -- of one such. elsif Is_Limited_Type (Etype (A)) - and then Nkind (Unqualify (A)) /= N_Function_Call -- aggregate? - and then - (Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion - or else - Nkind (Expression (Unqualify (A))) /= N_Function_Call) + and then (Nkind (Unqualify (A)) = N_Aggregate + or else + Nkind (Unqualify (A)) = N_Extension_Aggregate) and then Nkind (Unqualify (A)) /= N_Explicit_Dereference then Ancestor_Is_Expression := True; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 17332f2..82311e1 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2891,10 +2891,26 @@ package body Exp_Ch6 is if Ekind (Subp) = E_Function or else Ekind (Subp) = E_Procedure then - -- A simple optimization: always replace calls to null procedures - -- with a null statement. + -- We perform two simple optimization on calls: - if Is_Null_Procedure (Subp) then + -- a) replace calls to null procedures unconditionally, + + -- b) For To_Address, just do an unchecked conversion. Not only is + -- this efficient, but it also avoids order of elaboration problems + -- when address clauses are inlined (address expression elaborated + -- at the wrong point). + + -- We perform these optimization regardless of whether we are in the + -- main unit or in a unit in the context of the main unit, to ensure + -- that tree generated is the same in both cases, for Inspector use. + + if Is_RTE (Subp, RE_To_Address) then + Rewrite (N, + Unchecked_Convert_To + (RTE (RE_Address), Relocate_Node (First_Actual (N)))); + return; + + elsif Is_Null_Procedure (Subp) then Rewrite (N, Make_Null_Statement (Loc)); return; end if; @@ -2908,9 +2924,9 @@ package body Exp_Ch6 is Scop : constant Entity_Id := Scope (Subp); function In_Unfrozen_Instance return Boolean; - -- If the subprogram comes from an instance in the same - -- unit, and the instance is not yet frozen, inlining might - -- trigger order-of-elaboration problems in gigi. + -- If the subprogram comes from an instance in the same unit, + -- and the instance is not yet frozen, inlining might trigger + -- order-of-elaboration problems in gigi. -------------------------- -- In_Unfrozen_Instance -- @@ -2953,9 +2969,9 @@ package body Exp_Ch6 is then Must_Inline := False; - -- If this an inherited function that returns a private - -- type, do not inline if the full view is an unconstrained - -- array, because such calls cannot be inlined. + -- If this an inherited function that returns a private type, + -- do not inline if the full view is an unconstrained array, + -- because such calls cannot be inlined. elsif Present (Orig_Subp) and then Is_Array_Type (Etype (Orig_Subp)) @@ -3013,22 +3029,20 @@ package body Exp_Ch6 is and then In_Same_Extended_Unit (Sloc (Spec), Loc) then Cannot_Inline - ("cannot inline& (body not seen yet)?", - N, Subp); + ("cannot inline& (body not seen yet)?", N, Subp); end if; end if; end Inlined_Subprogram; end if; end if; - -- Check for a protected subprogram. This is either an intra-object - -- call, or a protected function call. Protected procedure calls are - -- rewritten as entry calls and handled accordingly. + -- Check for protected subprogram. This is either an intra-object call, + -- or a protected function call. Protected procedure calls are rewritten + -- as entry calls and handled accordingly. - -- In Ada 2005, this may be an indirect call to an access parameter - -- that is an access_to_subprogram. In that case the anonymous type - -- has a scope that is a protected operation, but the call is a - -- regular one. + -- In Ada 2005, this may be an indirect call to an access parameter that + -- is an access_to_subprogram. In that case the anonymous type has a + -- scope that is a protected operation, but the call is a regular one. Scop := Scope (Subp); @@ -3036,14 +3050,14 @@ package body Exp_Ch6 is and then Is_Protected_Type (Scop) and then Ekind (Subp) /= E_Subprogram_Type then - -- If the call is an internal one, it is rewritten as a call to - -- to the corresponding unprotected subprogram. + -- If the call is an internal one, it is rewritten as a call to the + -- corresponding unprotected subprogram. Expand_Protected_Subprogram_Call (N, Subp, Scop); end if; - -- Functions returning controlled objects need special attention - -- If the return type is limited the context is an initialization + -- Functions returning controlled objects need special attention: + -- if the return type is limited, the context is an initialization -- and different processing applies. if Needs_Finalization (Etype (Subp)) @@ -3053,9 +3067,9 @@ package body Exp_Ch6 is Expand_Ctrl_Function_Call (N); end if; - -- Test for First_Optional_Parameter, and if so, truncate parameter - -- list if there are optional parameters at the trailing end. - -- Note we never delete procedures for call via a pointer. + -- Test for First_Optional_Parameter, and if so, truncate parameter list + -- if there are optional parameters at the trailing end. + -- Note: we never delete procedures for call via a pointer. if (Ekind (Subp) = E_Procedure or else Ekind (Subp) = E_Function) and then Present (First_Optional_Parameter (Subp)) @@ -3064,14 +3078,14 @@ package body Exp_Ch6 is Last_Keep_Arg : Node_Id; begin - -- Last_Keep_Arg will hold the last actual that should be - -- retained. If it remains empty at the end, it means that - -- all parameters are optional. + -- Last_Keep_Arg will hold the last actual that should be kept. + -- If it remains empty at the end, it means that all parameters + -- are optional. Last_Keep_Arg := Empty; - -- Find first optional parameter, must be present since we - -- checked the validity of the parameter before setting it. + -- Find first optional parameter, must be present since we checked + -- the validity of the parameter before setting it. Formal := First_Formal (Subp); Actual := First_Actual (N); @@ -3225,23 +3239,25 @@ package body Exp_Ch6 is Is_Unc : constant Boolean := Is_Array_Type (Etype (Subp)) and then not Is_Constrained (Etype (Subp)); - -- If the type returned by the function is unconstrained and the - -- call can be inlined, special processing is required. + -- If the type returned by the function is unconstrained and the call + -- can be inlined, special processing is required. procedure Make_Exit_Label; - -- Build declaration for exit label to be used in Return statements + -- Build declaration for exit label to be used in Return statements, + -- sets Exit_Lab (the label node) and Lab_Decl (corresponding implcit + -- declaration). function Process_Formals (N : Node_Id) return Traverse_Result; - -- Replace occurrence of a formal with the corresponding actual, or - -- the thunk generated for it. + -- Replace occurrence of a formal with the corresponding actual, or the + -- thunk generated for it. function Process_Sloc (Nod : Node_Id) return Traverse_Result; - -- If the call being expanded is that of an internal subprogram, - -- set the sloc of the generated block to that of the call itself, - -- so that the expansion is skipped by the -next- command in gdb. + -- If the call being expanded is that of an internal subprogram, set the + -- sloc of the generated block to that of the call itself, so that the + -- expansion is skipped by the "next" command in gdb. -- Same processing for a subprogram in a predefined file, e.g. - -- Ada.Tags. If Debug_Generated_Code is true, suppress this change - -- to simplify our own development. + -- Ada.Tags. If Debug_Generated_Code is true, suppress this change to + -- simplify our own development. procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id); -- If the function body is a single expression, replace call with @@ -3576,19 +3592,6 @@ package body Exp_Ch6 is begin - -- For To_Address, just do an unchecked conversion . Not only is this - -- efficient, but it also avoids problem with order of elaboration - -- when address clauses are inlined (address expression elaborated - -- at the wrong point). - - if Subp = RTE (RE_To_Address) then - Rewrite (N, - Unchecked_Convert_To - (RTE (RE_Address), - Relocate_Node (First_Actual (N)))); - return; - end if; - -- Check for an illegal attempt to inline a recursive procedure. If the -- subprogram has parameters this is detected when trying to supply a -- binding for parameters that already have one. For parameterless diff --git a/gcc/ada/s-auxdec-vms_64.ads b/gcc/ada/s-auxdec-vms_64.ads index e9d8762..b36341c 100644 --- a/gcc/ada/s-auxdec-vms_64.ads +++ b/gcc/ada/s-auxdec-vms_64.ads @@ -63,15 +63,23 @@ package System.Aux_DEC is type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; for Integer_8'Size use 8; + type Integer_8_Array is array (Integer range <>) of Integer_8; + type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1; for Integer_16'Size use 16; + type Integer_16_Array is array (Integer range <>) of Integer_16; + type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1; for Integer_32'Size use 32; + type Integer_32_Array is array (Integer range <>) of Integer_32; + type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1; for Integer_64'Size use 64; + type Integer_64_Array is array (Integer range <>) of Integer_64; + type Largest_Integer is range Min_Int .. Max_Int; type AST_Handler is private; diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads index a709956..3748bee 100644 --- a/gcc/ada/s-auxdec.ads +++ b/gcc/ada/s-auxdec.ads @@ -53,15 +53,23 @@ package System.Aux_DEC is type Integer_8 is range -2 ** (8 - 1) .. +2 ** (8 - 1) - 1; for Integer_8'Size use 8; + type Integer_8_Array is array (Integer range <>) of Integer_8; + type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1; for Integer_16'Size use 16; + type Integer_16_Array is array (Integer range <>) of Integer_16; + type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1; for Integer_32'Size use 32; + type Integer_32_Array is array (Integer range <>) of Integer_32; + type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1; for Integer_64'Size use 64; + type Integer_64_Array is array (Integer range <>) of Integer_64; + type Largest_Integer is range Min_Int .. Max_Int; type AST_Handler is private; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e80c662..b4e57b2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5568,15 +5568,17 @@ package body Sem_Ch3 is Install_Private_Declarations (Par_Scope); Install_Visible_Declarations (Par_Scope); - Insert_Before (N, Decl); + Insert_After (N, Decl); Analyze (Decl); Uninstall_Declarations (Par_Scope); -- Freeze the underlying record view, to prevent generation -- of useless dispatching information, which is simply shared - -- with the real derived type. + -- with the real derived type. The underlying view must be + -- treated as an itype by the back-end. Set_Is_Frozen (Full_Der); + Set_Is_Itype (Full_Der); Set_Underlying_Record_View (Derived_Type, Full_Der); end; @@ -13495,6 +13497,15 @@ package body Sem_Ch3 is ("completion of tagged private type must be tagged", N); end if; + + elsif Nkind (N) = N_Full_Type_Declaration + and then + Nkind (Type_Definition (N)) = N_Record_Definition + and then Interface_Present (Type_Definition (N)) + then + Error_Msg_N + ("completion of private type canot be an interface", + N); end if; -- Ada 2005 (AI-251): Private extension declaration of a task diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c51f843..17103e1 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7388,9 +7388,9 @@ package body Sem_Ch6 is return; - -- Within an instance, the renaming declarations for - -- actual subprograms may become ambiguous, but they do - -- not hide each other. + -- Within an instance, the renaming declarations for actual + -- subprograms may become ambiguous, but they do not hide each + -- other. elsif Ekind (E) /= E_Entry and then not Comes_From_Source (E) @@ -7402,8 +7402,8 @@ package body Sem_Ch6 is or else Nkind (Unit_Declaration_Node (E)) /= N_Subprogram_Renaming_Declaration) then - -- A subprogram child unit is not allowed to override - -- an inherited subprogram (10.1.1(20)). + -- A subprogram child unit is not allowed to override an + -- inherited subprogram (10.1.1(20)). if Is_Child_Unit (S) then Error_Msg_N diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index 543f01b..5752c21 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -57,8 +57,8 @@ package Sem_Ch6 is procedure Check_Conventions (Typ : Entity_Id); -- Ada 2005 (AI-430): Check that the conventions of all inherited and - -- overridden dispatching operations of type Typ are consistent with - -- their respective counterparts. + -- overridden dispatching operations of type Typ are consistent with their + -- respective counterparts. procedure Check_Delayed_Subprogram (Designator : Entity_Id); -- Designator can be a E_Subprogram_Type, E_Procedure or E_Function. If a @@ -69,10 +69,10 @@ package Sem_Ch6 is (N : Node_Id; Prev : Entity_Id; Prev_Loc : Node_Id); - -- Check that the discriminants of a full type N fully conform to - -- the discriminants of the corresponding partial view Prev. - -- Prev_Loc indicates the source location of the partial view, - -- which may be different than Prev in the case of private types. + -- Check that the discriminants of a full type N fully conform to the + -- discriminants of the corresponding partial view Prev. Prev_Loc indicates + -- the source location of the partial view, which may be different than + -- Prev in the case of private types. procedure Check_Fully_Conformant (New_Id : Entity_Id; @@ -230,15 +230,21 @@ package Sem_Ch6 is (New_Id : Entity_Id; Old_Id : Entity_Id; Skip_Controlling_Formals : Boolean := False) return Boolean; - -- Determine whether two callable entities (subprograms, entries, - -- literals) are subtype conformant (RM6.3.1(16)). + -- Determine whether two callable entities (subprograms, entries, literals) + -- are subtype conformant (RM6.3.1(16)). Skip_Controlling_Formals is True + -- when checking the conformance of a subprogram that implements an + -- interface operation. In that case, only the non-controlling formals + -- can (and must) be examined. function Type_Conformant (New_Id : Entity_Id; Old_Id : Entity_Id; Skip_Controlling_Formals : Boolean := False) return Boolean; - -- Determine whether two callable entities (subprograms, entries, - -- literals) are type conformant (RM6.3.1(14)). + -- Determine whether two callable entities (subprograms, entries, literals) + -- are type conformant (RM6.3.1(14)). Skip_Controlling_Formals is True when + -- checking the conformance of a subprogram that implements an interface + -- operation. In that case, only the non-controlling formals can (and must) + -- be examined. procedure Valid_Operator_Definition (Designator : Entity_Id); -- Verify that an operator definition has the proper number of formals diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index fc3db82..d6799bc 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -42,6 +42,7 @@ with Restrict; use Restrict; with Rident; use Rident; with Sem; use Sem; with Sem_Aux; use Sem_Aux; +with Sem_Ch3; use Sem_Ch3; with Sem_Ch6; use Sem_Ch6; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; @@ -711,12 +712,41 @@ package body Sem_Disp is return; -- The subprograms build internally after the freezing point (such as - -- the Init procedure) are not primitives + -- init procs, interface thunks, type support subprograms, and Offset + -- to top functions for accessing interface components in variable + -- size tagged types) are not primitives. elsif Is_Frozen (Tagged_Type) and then not Comes_From_Source (Subp) and then not Has_Dispatching_Parent then + -- Complete decoration if internally built subprograms that override + -- a dispatching primitive. These entities correspond with the + -- following cases: + + -- 1. Ada 2005 (AI-391): Wrapper functions built by the expander + -- to override functions of nonabstract null extensions. These + -- primitives were added to the list of primitives of the tagged + -- type by Make_Controlling_Function_Wrappers. However, attribute + -- Is_Dispatching_Operation must be set to true. + + -- 2. Subprograms associated with stream attributes (built by + -- New_Stream_Subprogram) + + if Present (Old_Subp) + and then Is_Overriding_Operation (Subp) + and then Is_Dispatching_Operation (Old_Subp) + then + pragma Assert + ((Ekind (Subp) = E_Function + and then Is_Dispatching_Operation (Old_Subp) + and then Is_Null_Extension (Base_Type (Etype (Subp)))) + or else Get_TSS_Name (Subp) = TSS_Stream_Read + or else Get_TSS_Name (Subp) = TSS_Stream_Write); + + Set_Is_Dispatching_Operation (Subp); + end if; + return; -- The operation may be a child unit, whose scope is the defining diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 8178afc..6c79b94 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -256,6 +256,14 @@ package body Switch.C is if Dot then Set_Dotted_Debug_Flag (C); Store_Compilation_Switch ("-gnatd." & C); + + -- Disable front-end inlining in inspector mode + -- ??? Change this when we use a non debug flag to + -- enable inspector mode. + + if C = 'I' then + Front_End_Inlining := False; + end if; else Set_Debug_Flag (C); Store_Compilation_Switch ("-gnatd" & C); @@ -632,7 +640,14 @@ package body Switch.C is when 'N' => Ptr := Ptr + 1; Inline_Active := True; - Front_End_Inlining := True; + + -- Do not enable front-end inlining in inspector mode, to + -- generate trees that can be converted to SCIL. We still + -- enable back-end inlining which is fine. + + if not Inspector_Mode then + Front_End_Inlining := True; + end if; -- Processing for o switch