mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-16 23:31:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-04-20  Arnaud Charlet  <charlet@adacore.com>

	* switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining
	in inspector mode.

2009-04-20  Javier Miranda  <miranda@adacore.com>

	* 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  <rupp@adacore.com>

	* s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types.

	* s-auxdec.ads: Likewise

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2009-04-20 10:35:16 +02:00
parent 3f25c54d81
commit 26a43556c8
10 changed files with 190 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gcc/ada/ChangeLog
View File

@ -1,3 +1,36 @@
2009-04-20 Arnaud Charlet <charlet@adacore.com>
* switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining
in inspector mode.
2009-04-20 Javier Miranda <miranda@adacore.com>
* 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 <rupp@adacore.com>
* s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types.
* s-auxdec.ads: Likewise
2009-04-20 Ed Schonberg <schonberg@adacore.com>
* 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 <kirtchev@adacore.com>
* a-calend.adb: Remove types char_Pointer, int, tm and tm_Pointer.

14
gcc/ada/exp_aggr.adb
View File

@ -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;

109
gcc/ada/exp_ch6.adb
View File

@ -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

8
gcc/ada/s-auxdec-vms_64.ads
View File

@ -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;

8
gcc/ada/s-auxdec.ads
View File

@ -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;

15
gcc/ada/sem_ch3.adb
View File

@ -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

10
gcc/ada/sem_ch6.adb
View File

@ -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

26
gcc/ada/sem_ch6.ads
View File

@ -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

32
gcc/ada/sem_disp.adb
View File

@ -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

17
gcc/ada/switch-c.adb
View File

@ -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