+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.
-- 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
-- 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;
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;
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 --
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))
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);
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))
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))
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);
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
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
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;
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;
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;
("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
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)
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
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
(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;
(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
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;
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
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);
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
projects / platform / upstream / linaro-gcc.git / commitdiff