--
-- For all parameter modes, actuals that denote components and slices
-- of packed arrays are expanded into suitable temporaries.
+ --
+ -- For non-scalar objects that are possibly unaligned, add call by copy
+ -- code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
procedure Expand_Inlined_Call
(N : Node_Id;
-- also takes care of any constraint checks required for the type
-- conversion case (on both the way in and the way out).
- procedure Add_Packed_Call_By_Copy_Code;
- -- This is used when the actual involves a reference to an element
- -- of a packed array, where we can appropriately use a simpler
- -- approach than the full call by copy code. We just copy the value
- -- in and out of an appropriate temporary.
+ procedure Add_Simple_Call_By_Copy_Code;
+ -- This is similar to the above, but is used in cases where we know
+ -- that all that is needed is to simply create a temporary and copy
+ -- the value in and out of the temporary.
procedure Check_Fortran_Logical;
-- A value of type Logical that is passed through a formal parameter
Expr : Node_Id;
Init : Node_Id;
Temp : Entity_Id;
- Indic : Node_Id := New_Occurrence_Of (Etype (Formal), Loc);
+ Indic : Node_Id;
Var : Entity_Id;
F_Typ : constant Entity_Id := Etype (Formal);
V_Typ : Entity_Id;
begin
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
+ -- Use formal type for temp, unless formal type is an unconstrained
+ -- array, in which case we don't have to worry about bounds checks,
+ -- and we use the actual type, since that has appropriate bonds.
+
+ if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+ Indic := New_Occurrence_Of (Etype (Actual), Loc);
+ else
+ Indic := New_Occurrence_Of (Etype (Formal), Loc);
+ end if;
+
+
if Nkind (Actual) = N_Type_Conversion then
V_Typ := Etype (Expression (Actual));
then
-- Actual is a one-dimensional array or slice, and the type
-- requires no initialization. Create a temporary of the
- -- right size, but do copy actual into it (optimization).
+ -- right size, but do not copy actual into it (optimization).
Init := Empty;
Indic :=
Is_Bit_Packed_Array (Etype (Expression (Actual))))
then
if Conversion_OK (Actual) then
- Init :=
- OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
+ Init := OK_Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
else
- Init :=
- Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
+ Init := Convert_To (F_Typ, New_Occurrence_Of (Var, Loc));
end if;
elsif Ekind (Formal) = E_In_Parameter then
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Object_Definition => Indic,
- Expression => Init);
+ Expression => Init);
Set_Assignment_OK (N_Node);
Insert_Action (N, N_Node);
end Add_Call_By_Copy_Code;
----------------------------------
- -- Add_Packed_Call_By_Copy_Code --
+ -- Add_Simple_Call_By_Copy_Code --
----------------------------------
- procedure Add_Packed_Call_By_Copy_Code is
+ procedure Add_Simple_Call_By_Copy_Code is
Temp : Entity_Id;
Incod : Node_Id;
Outcod : Node_Id;
Lhs : Node_Id;
Rhs : Node_Id;
+ Indic : Node_Id;
+ F_Typ : constant Entity_Id := Etype (Formal);
begin
- Reset_Packed_Prefix;
+ -- Use formal type for temp, unless formal type is an unconstrained
+ -- array, in which case we don't have to worry about bounds checks,
+ -- and we use the actual type, since that has appropriate bonds.
+
+ if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
+ Indic := New_Occurrence_Of (Etype (Actual), Loc);
+ else
+ Indic := New_Occurrence_Of (Etype (Formal), Loc);
+ end if;
-- Prepare to generate code
+ Reset_Packed_Prefix;
+
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('T'));
Incod := Relocate_Node (Actual);
Outcod := New_Copy_Tree (Incod);
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
- Object_Definition =>
- New_Occurrence_Of (Etype (Formal), Loc),
- Expression => Incod));
+ Object_Definition => Indic,
+ Expression => Incod));
-- The actual is simply a reference to the temporary
Make_Assignment_Statement (Loc,
Name => Lhs,
Expression => Rhs));
+ Set_Assignment_OK (Name (Last (Post_Call)));
end if;
- end Add_Packed_Call_By_Copy_Code;
+ end Add_Simple_Call_By_Copy_Code;
---------------------------
-- Check_Fortran_Logical --
-- [in] out parameters.
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
- Add_Packed_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code;
+
+ -- If a non-scalar actual is possibly unaligned, we need a copy
+
+ elsif Is_Possibly_Unaligned_Object (Actual)
+ and then not Represented_As_Scalar (Etype (Formal))
+ then
+ Add_Simple_Call_By_Copy_Code;
-- References to slices of bit packed arrays are expanded
-- the special processing above for the OUT and IN OUT cases
-- could be performed. We could make the test in Exp_Ch4 more
-- complex and have it detect the parameter mode, but it is
- -- easier simply to handle all cases here.
+ -- easier simply to handle all cases here.)
if Nkind (Actual) = N_Indexed_Component
and then Is_Packed (Etype (Prefix (Actual)))
-- Is this really necessary in all cases???
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
- Add_Packed_Call_By_Copy_Code;
+ Add_Simple_Call_By_Copy_Code;
+
+ -- If a non-scalar actual is possibly unaligned, we need a copy
+
+ elsif Is_Possibly_Unaligned_Object (Actual)
+ and then not Represented_As_Scalar (Etype (Formal))
+ then
+ Add_Simple_Call_By_Copy_Code;
-- Similarly, we have to expand slices of packed arrays here
-- because the result must be byte aligned.
end loop;
end if;
- if Ekind (Subp) = E_Procedure
- or else (Ekind (Subp) = E_Subprogram_Type
- and then Etype (Subp) = Standard_Void_Type)
- or else Is_Entry (Subp)
- then
- Expand_Actuals (N, Subp);
- end if;
+ -- At this point we have all the actuals, so this is the point at
+ -- which the various expansion activities for actuals is carried out.
+
+ Expand_Actuals (N, Subp);
-- If the subprogram is a renaming, or if it is inherited, replace it
-- in the call with the name of the actual subprogram being called.
Designated_Type (Base_Type (Etype (Ptr)));
begin
- Obj := Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (T, Ptr),
- Selector_Name => New_Occurrence_Of (First_Entity (T), Loc));
-
- Nam := Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (T, Ptr),
- Selector_Name => New_Occurrence_Of (
- Next_Entity (First_Entity (T)), Loc));
+ Obj :=
+ Make_Selected_Component (Loc,
+ Prefix => Unchecked_Convert_To (T, Ptr),
+ Selector_Name =>
+ New_Occurrence_Of (First_Entity (T), Loc));
+
+ Nam :=
+ Make_Selected_Component (Loc,
+ Prefix => Unchecked_Convert_To (T, Ptr),
+ Selector_Name =>
+ New_Occurrence_Of (Next_Entity (First_Entity (T)), Loc));
Nam := Make_Explicit_Dereference (Loc, Nam);
-- Start of processing for Expand_Inlined_Call
begin
- -- Check for special case of To_Address call, and if so, just
- -- do an unchecked conversion instead of expanding the call.
- -- Not only is this more efficient, but it also avoids a
- -- problem with order of elaboration when address clauses
- -- are inlined (address expr elaborated at wrong point).
+ -- Check for special case of To_Address call, and if so, just do an
+ -- unchecked conversion instead of expanding the call. Not only is this
+ -- more efficient, but it also avoids problem with order of elaboration
+ -- when address clauses are inlined (address expr elaborated at wrong
+ -- point).
if Subp = RTE (RE_To_Address) then
Rewrite (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
+ -- subprograms this must be done explicitly.
+
+ if In_Open_Scopes (Subp) then
+ Error_Msg_N ("call to recursive subprogram cannot be inlined?", N);
+ Set_Is_Inlined (Subp, False);
+ return;
+ end if;
+
if Nkind (Orig_Bod) = N_Defining_Identifier then
-- Subprogram is a renaming_as_body. Calls appearing after the
-- renaming can be replaced with calls to the renamed entity
- -- directly, because the subprograms are subtype conformant.
+ -- directly, because the subprograms are subtype conformant. If
+ -- the renamed subprogram is an inherited operation, we must redo
+ -- the expansion because implicit conversions may be needed.
Set_Name (N, New_Occurrence_Of (Orig_Bod, Loc));
+
+ if Present (Alias (Orig_Bod)) then
+ Expand_Call (N);
+ end if;
+
return;
end if;
end if;
-- If the argument may be a controlling argument in a call within
- -- the inlined body, we must preserve its classwide nature to
- -- insure that dynamic dispatching take place subsequently.
- -- If the formal has a constraint it must be preserved to retain
- -- the semantics of the body.
+ -- the inlined body, we must preserve its classwide nature to insure
+ -- that dynamic dispatching take place subsequently. If the formal
+ -- has a constraint it must be preserved to retain the semantics of
+ -- the body.
if Is_Class_Wide_Type (Etype (F))
or else (Is_Access_Type (Etype (F))
end if;
-- Analyze Blk with In_Inlined_Body set, to avoid spurious errors on
- -- conflicting private views that Gigi would ignore. If this is a
+ -- conflicting private views that Gigi would ignore. If this is
-- predefined unit, analyze with checks off, as is done in the non-
-- inlined run-time units.
elsif Requires_Transient_Scope (Typ) then
- -- Verify that the return type of the enclosing function has
- -- the same constrained status as that of the expression.
+ -- Verify that the return type of the enclosing function has the
+ -- same constrained status as that of the expression.
while Ekind (S) /= E_Function loop
S := Scope (S);
begin
-- A special check. If stack checking is enabled, and the return type
- -- might generate a large temporary, and the call is not the right
- -- side of an assignment, then generate an explicit temporary. We do
- -- this because otherwise gigi may generate a large temporary on the
- -- fly and this can cause trouble with stack checking.
+ -- might generate a large temporary, and the call is not the right side
+ -- of an assignment, then generate an explicit temporary. We do this
+ -- because otherwise gigi may generate a large temporary on the fly and
+ -- this can cause trouble with stack checking.
-- This is unecessary if the call is the expression in an object
- -- declaration, or if it appears outside of any library unit. This
- -- can only happen if it appears as an actual in a library-level
- -- instance, in which case a temporary will be generated for it once
- -- the instance itself is installed.
+ -- declaration, or if it appears outside of any library unit. This can
+ -- only happen if it appears as an actual in a library-level instance,
+ -- in which case a temporary will be generated for it once the instance
+ -- itself is installed.
if May_Generate_Large_Temp (Typ)
and then not Rhs_Of_Assign_Or_Decl (N)
then
if Stack_Checking_Enabled then
- -- Note: it might be thought that it would be OK to use a call
- -- to Force_Evaluation here, but that's not good enough, because
- -- that can results in a 'Reference construct that may still
- -- need a temporary.
+ -- Note: it might be thought that it would be OK to use a call to
+ -- Force_Evaluation here, but that's not good enough, because
+ -- that can results in a 'Reference construct that may still need
+ -- a temporary.
declare
Loc : constant Source_Ptr := Sloc (N);
-- Add poll call if ATC polling is enabled, unless the body will be
-- inlined by the back-end.
- -- Add return statement if last statement in body is not a return
- -- statement (this makes things easier on Gigi which does not want
- -- to have to handle a missing return).
+ -- Add return statement if last statement in body is not a return statement
+ -- (this makes things easier on Gigi which does not want to have to handle
+ -- a missing return).
-- Add call to Activate_Tasks if body is a task activator
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
-- Currently the code in this unit requires that packed arrays
-- represented by non-modular arrays of bytes be on a byte
- -- boundary.
+ -- boundary for bit sizes handled by System.Pack_nn units.
+ -- That's because these units assume the array being accessed
+ -- starts on a byte boundary.
- Set_Must_Be_On_Byte_Boundary (Typ);
+ if Get_Id (UI_To_Int (Csize)) /= RE_Null then
+ Set_Must_Be_On_Byte_Boundary (Typ);
+ end if;
end if;
end Create_Packed_Array_Type;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
+with Exp_Aggr; use Exp_Aggr;
with Exp_Ch7; use Exp_Ch7;
with Exp_Ch11; use Exp_Ch11;
with Exp_Tss; use Exp_Tss;
-- Is_Possibly_Unaligned_Object --
----------------------------------
- function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean is
+ function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean is
+ T : constant Entity_Id := Etype (N);
+
begin
- -- If target does not have strict alignment, result is always
- -- False, since correctness of code does no depend on alignment.
+ -- If renamed object, apply test to underlying object
- if not Target_Strict_Alignment then
- return False;
+ if Is_Entity_Name (N)
+ and then Is_Object (Entity (N))
+ and then Present (Renamed_Object (Entity (N)))
+ then
+ return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (N)));
end if;
- -- If renamed object, apply test to underlying object
+ -- Tagged and controlled types and aliased types are always aligned,
+ -- as are concurrent types.
- if Is_Entity_Name (P)
- and then Is_Object (Entity (P))
- and then Present (Renamed_Object (Entity (P)))
+ if Is_Aliased (T)
+ or else Has_Controlled_Component (T)
+ or else Is_Concurrent_Type (T)
+ or else Is_Tagged_Type (T)
+ or else Is_Controlled (T)
then
- return Is_Possibly_Unaligned_Object (Renamed_Object (Entity (P)));
+ return False;
end if;
-- If this is an element of a packed array, may be unaligned
- if Is_Ref_To_Bit_Packed_Array (P) then
+ if Is_Ref_To_Bit_Packed_Array (N) then
return True;
end if;
-- Case of component reference
- if Nkind (P) = N_Selected_Component then
+ if Nkind (N) = N_Selected_Component then
+ declare
+ P : constant Node_Id := Prefix (N);
+ C : constant Entity_Id := Entity (Selector_Name (N));
+ M : Nat;
+ S : Nat;
- -- If component reference is for a record that is bit packed
- -- or has a specified alignment (that might be too small) or
- -- the component reference has a component clause, then the
- -- object may be unaligned.
+ begin
+ -- If component reference is for an array with non-static bounds,
+ -- then it is always aligned, we can only unaligned arrays with
+ -- static bounds (more accurately bounds known at compile time)
- if Is_Packed (Etype (Prefix (P)))
- or else Known_Alignment (Etype (Prefix (P)))
- or else Present (Component_Clause (Entity (Selector_Name (P))))
- then
- return True;
+ if Is_Array_Type (T)
+ and then not Compile_Time_Known_Bounds (T)
+ then
+ return False;
+ end if;
- -- Otherwise, for a component reference, test prefix
+ -- If component is aliased, it is definitely properly aligned
- else
- return Is_Possibly_Unaligned_Object (Prefix (P));
- end if;
+ if Is_Aliased (C) then
+ return False;
+ end if;
+
+ -- If component is for a type implemented as a scalar, and the
+ -- record is packed, and the component is other than the first
+ -- component of the record, then the component may be unaligned.
+
+ if Is_Packed (Etype (P))
+ and then Represented_As_Scalar (Etype (P))
+ and then First_Entity (Etype (Entity (P))) /= C
+ then
+ return True;
+ end if;
+
+ -- Compute maximum possible alignment for T
+
+ -- If alignment is known, then that settles things
+
+ if Known_Alignment (T) then
+ M := UI_To_Int (Alignment (T));
+
+ -- If alignment is not known, tentatively set max alignment
+
+ else
+ M := Ttypes.Maximum_Alignment;
+
+ -- We can reduce this if the Esize is known since the default
+ -- alignment will never be more than the smallest power of 2
+ -- that does not exceed this Esize value.
+
+ if Known_Esize (T) then
+ S := UI_To_Int (Esize (T));
+
+ while (M / 2) >= S loop
+ M := M / 2;
+ end loop;
+ end if;
+ end if;
+
+ -- If the component reference is for a record that has a specified
+ -- alignment, and we either know it is too small, or cannot tell,
+ -- then the component may be unaligned
+
+ if Known_Alignment (Etype (P))
+ and then Alignment (Etype (P)) < Ttypes.Maximum_Alignment
+ and then M > Alignment (Etype (P))
+ then
+ return True;
+ end if;
+
+ -- Case of component clause present which may specify an
+ -- unaligned position.
+
+ if Present (Component_Clause (C)) then
+
+ -- Otherwise we can do a test to make sure that the actual
+ -- start position in the record, and the length, are both
+ -- consistent with the required alignment. If not, we know
+ -- that we are unaligned.
+
+ declare
+ Align_In_Bits : constant Nat := M * System_Storage_Unit;
+ begin
+ if Component_Bit_Offset (C) mod Align_In_Bits /= 0
+ or else Esize (C) mod Align_In_Bits /= 0
+ then
+ return True;
+ end if;
+ end;
+ end if;
+
+ -- Otherwise, for a component reference, test prefix
+
+ return Is_Possibly_Unaligned_Object (P);
+ end;
-- If not a component reference, must be aligned
-- Is_Possibly_Unaligned_Slice --
---------------------------------
- function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
+ function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is
begin
-- ??? GCC3 will eventually handle strings with arbitrary alignments,
-- but for now the following check must be disabled.
-- For renaming case, go to renamed object
- if Is_Entity_Name (P)
- and then Is_Object (Entity (P))
- and then Present (Renamed_Object (Entity (P)))
+ if Is_Entity_Name (N)
+ and then Is_Object (Entity (N))
+ and then Present (Renamed_Object (Entity (N)))
then
- return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (P)));
+ return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (N)));
end if;
-- The reference must be a slice
- if Nkind (P) /= N_Slice then
+ if Nkind (N) /= N_Slice then
return False;
end if;
-- component clause, which gigi/gcc does not appear to handle well.
-- It is not clear why this special test is needed at all ???
- if Nkind (Prefix (P)) = N_Selected_Component
- and then Nkind (Prefix (Prefix (P))) = N_Selected_Component
+ if Nkind (Prefix (N)) = N_Selected_Component
+ and then Nkind (Prefix (Prefix (N))) = N_Selected_Component
and then
- Present (Component_Clause (Entity (Selector_Name (Prefix (P)))))
+ Present (Component_Clause (Entity (Selector_Name (Prefix (N)))))
then
return True;
end if;
-- If it is a slice, then look at the array type being sliced
declare
- Sarr : constant Node_Id := Prefix (P);
+ Sarr : constant Node_Id := Prefix (N);
-- Prefix of the slice, i.e. the array being sliced
- Styp : constant Entity_Id := Etype (Prefix (P));
+ Styp : constant Entity_Id := Etype (Prefix (N));
-- Type of the array being sliced
Pref : Node_Id;
-- Is_Ref_To_Bit_Packed_Array --
--------------------------------
- function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean is
+ function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean is
Result : Boolean;
Expr : Node_Id;
begin
- if Is_Entity_Name (P)
- and then Is_Object (Entity (P))
- and then Present (Renamed_Object (Entity (P)))
+ if Is_Entity_Name (N)
+ and then Is_Object (Entity (N))
+ and then Present (Renamed_Object (Entity (N)))
then
- return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (P)));
+ return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (N)));
end if;
- if Nkind (P) = N_Indexed_Component
+ if Nkind (N) = N_Indexed_Component
or else
- Nkind (P) = N_Selected_Component
+ Nkind (N) = N_Selected_Component
then
- if Is_Bit_Packed_Array (Etype (Prefix (P))) then
+ if Is_Bit_Packed_Array (Etype (Prefix (N))) then
Result := True;
else
- Result := Is_Ref_To_Bit_Packed_Array (Prefix (P));
+ Result := Is_Ref_To_Bit_Packed_Array (Prefix (N));
end if;
- if Result and then Nkind (P) = N_Indexed_Component then
- Expr := First (Expressions (P));
+ if Result and then Nkind (N) = N_Indexed_Component then
+ Expr := First (Expressions (N));
while Present (Expr) loop
Force_Evaluation (Expr);
Next (Expr);
-- Is_Ref_To_Bit_Packed_Slice --
--------------------------------
- function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean is
+ function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean is
begin
- if Is_Entity_Name (P)
- and then Is_Object (Entity (P))
- and then Present (Renamed_Object (Entity (P)))
+ if Is_Entity_Name (N)
+ and then Is_Object (Entity (N))
+ and then Present (Renamed_Object (Entity (N)))
then
- return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (P)));
+ return Is_Ref_To_Bit_Packed_Slice (Renamed_Object (Entity (N)));
end if;
- if Nkind (P) = N_Slice
- and then Is_Bit_Packed_Array (Etype (Prefix (P)))
+ if Nkind (N) = N_Slice
+ and then Is_Bit_Packed_Array (Etype (Prefix (N)))
then
return True;
- elsif Nkind (P) = N_Indexed_Component
+ elsif Nkind (N) = N_Indexed_Component
or else
- Nkind (P) = N_Selected_Component
+ Nkind (N) = N_Selected_Component
then
- return Is_Ref_To_Bit_Packed_Slice (Prefix (P));
+ return Is_Ref_To_Bit_Packed_Slice (Prefix (N));
else
return False;
Set_Is_Eliminated (Defining_Entity (N));
end if;
+ elsif Nkind (N) = N_Package_Declaration then
+ Kill_Dead_Code (Visible_Declarations (Specification (N)));
+ Kill_Dead_Code (Private_Declarations (Specification (N)));
+
+ declare
+ E : Entity_Id := First_Entity (Defining_Entity (N));
+ begin
+ while Present (E) loop
+ if Ekind (E) = E_Operator then
+ Set_Is_Eliminated (E);
+ end if;
+
+ Next_Entity (E);
+ end loop;
+ end;
+
-- Recurse into composite statement to kill individual statements,
-- in particular instantiations.
New_Exp := Make_Reference (Loc, E);
end if;
- if Nkind (E) = N_Aggregate and then Expansion_Delayed (E) then
- Set_Expansion_Delayed (E, False);
+ if Is_Delayed_Aggregate (E) then
+
+ -- The expansion of nested aggregates is delayed until the
+ -- enclosing aggregate is expanded. As aggregates are often
+ -- qualified, the predicate applies to qualified expressions
+ -- as well, indicating that the enclosing aggregate has not
+ -- been expanded yet. At this point the aggregate is part of
+ -- a stand-alone declaration, and must be fully expanded.
+
+ if Nkind (E) = N_Qualified_Expression then
+ Set_Expansion_Delayed (Expression (E), False);
+ Set_Analyzed (Expression (E), False);
+ else
+ Set_Expansion_Delayed (E, False);
+ end if;
+
Set_Analyzed (E, False);
end if;
Scope_Suppress := Svg_Suppress;
end Remove_Side_Effects;
+ ---------------------------
+ -- Represented_As_Scalar --
+ ---------------------------
+
+ function Represented_As_Scalar (T : Entity_Id) return Boolean is
+ UT : constant Entity_Id := Underlying_Type (T);
+ begin
+ return Is_Scalar_Type (UT)
+ or else (Is_Bit_Packed_Array (UT)
+ and then Is_Scalar_Type (Packed_Array_Type (UT)));
+ end Represented_As_Scalar;
+
------------------------------------
-- Safe_Unchecked_Type_Conversion --
------------------------------------
-- nodes. False otherwise. True for an empty list. It is an error
-- to call this routine with No_List as the argument.
- function Is_Ref_To_Bit_Packed_Array (P : Node_Id) return Boolean;
+ function Is_Ref_To_Bit_Packed_Array (N : Node_Id) return Boolean;
-- Determine whether the node P is a reference to a bit packed
-- array, i.e. whether the designated object is a component of
-- a bit packed array, or a subcomponent of such a component.
-- to Force_Evaluation, and True is returned. Otherwise False
-- is returned, and P is not affected.
- function Is_Ref_To_Bit_Packed_Slice (P : Node_Id) return Boolean;
+ function Is_Ref_To_Bit_Packed_Slice (N : Node_Id) return Boolean;
-- Determine whether the node P is a reference to a bit packed
-- slice, i.e. whether the designated object is bit packed slice
-- or a component of a bit packed slice. Return True if so.
- function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean;
+ function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean;
-- Determine whether the node P is a slice of an array where the slice
-- result may cause alignment problems because it has an alignment that
-- is not compatible with the type. Return True if so.
- function Is_Possibly_Unaligned_Object (P : Node_Id) return Boolean;
- -- Node P is an object reference. This function returns True if it
+ function Is_Possibly_Unaligned_Object (N : Node_Id) return Boolean;
+ -- Node N is an object reference. This function returns True if it
-- is possible that the object may not be aligned according to the
-- normal default alignment requirement for its type (e.g. if it
-- appears in a packed record, or as part of a component that has
-- call to Remove_Side_Effects, it is safe to call New_Copy_Tree to
-- obtain a copy of the resulting expression.
+ function Represented_As_Scalar (T : Entity_Id) return Boolean;
+ -- Returns True iff the implementation of this type in code generation
+ -- terms is scalar. This is true for scalars in the Ada sense, and for
+ -- packed arrays which are represented by a scalar (modular) type.
+
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
-- Given the node for an N_Unchecked_Type_Conversion, return True
-- if this is an unchecked conversion that Gigi can handle directly.
function Compile_Time_Compare
(L, R : Node_Id;
- Rec : Boolean := False)
- return Compare_Result
+ Rec : Boolean := False) return Compare_Result
is
Ltyp : constant Entity_Id := Etype (L);
Rtyp : constant Entity_Id := Etype (R);
end if;
end Compile_Time_Compare;
+ -------------------------------
+ -- Compile_Time_Known_Bounds --
+ -------------------------------
+
+ function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean is
+ Indx : Node_Id;
+ Typ : Entity_Id;
+
+ begin
+ if not Is_Array_Type (T) then
+ return False;
+ end if;
+
+ Indx := First_Index (T);
+ while Present (Indx) loop
+ Typ := Underlying_Type (Etype (Indx));
+ if not Compile_Time_Known_Value (Type_Low_Bound (Typ)) then
+ return False;
+ elsif not Compile_Time_Known_Value (Type_High_Bound (Typ)) then
+ return False;
+ else
+ Next_Index (Indx);
+ end if;
+ end loop;
+
+ return True;
+ end Compile_Time_Known_Bounds;
+
------------------------------
-- Compile_Time_Known_Value --
------------------------------
function In_Subrange_Of
(T1 : Entity_Id;
T2 : Entity_Id;
- Fixed_Int : Boolean := False)
- return Boolean
+ Fixed_Int : Boolean := False) return Boolean
is
L1 : Node_Id;
H1 : Node_Id;
(N : Node_Id;
Typ : Entity_Id;
Fixed_Int : Boolean := False;
- Int_Real : Boolean := False)
- return Boolean
+ Int_Real : Boolean := False) return Boolean
is
Val : Uint;
Valr : Ureal;
(N : Node_Id;
Typ : Entity_Id;
Fixed_Int : Boolean := False;
- Int_Real : Boolean := False)
- return Boolean
+ Int_Real : Boolean := False) return Boolean
is
Val : Uint;
Valr : Ureal;
------------------------------------
function Subtypes_Statically_Compatible
- (T1 : Entity_Id;
- T2 : Entity_Id)
- return Boolean
+ (T1 : Entity_Id;
+ T2 : Entity_Id) return Boolean
is
begin
if Is_Scalar_Type (T1) then
subtype Compare_LE is Compare_Result range LT .. EQ;
function Compile_Time_Compare
(L, R : Node_Id;
- Rec : Boolean := False)
- return Compare_Result;
+ Rec : Boolean := False) return Compare_Result;
-- Given two expression nodes, finds out whether it can be determined
-- at compile time how the runtime values will compare. An Unknown
-- result means that the result of a comparison cannot be determined at
-- range is not static, or because one or the other bound raises CE).
function Subtypes_Statically_Compatible
- (T1 : Entity_Id;
- T2 : Entity_Id)
- return Boolean;
+ (T1 : Entity_Id;
+ T2 : Entity_Id) return Boolean;
-- Returns true if the subtypes are unconstrained or the constraint on
-- on T1 is statically compatible with T2 (as defined by 4.9.1(4)).
-- Otherwise returns false.
-- whose constituent expressions are either compile time known values
-- or compile time known aggregates.
+ function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
+ -- If T is an array whose index bounds are all known at compile time,
+ -- then True is returned, if T is not an array, or one or more of its
+ -- index bounds is not known at compile time, then False is returned.
+
function Expr_Value (N : Node_Id) return Uint;
-- Returns the folded value of the expression N. This function is called
-- in instances where it has already been determined that the expression
(N : Node_Id;
Typ : Entity_Id;
Fixed_Int : Boolean := False;
- Int_Real : Boolean := False)
- return Boolean;
+ Int_Real : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that expression
-- N is known to be in range of the subtype Typ. If the values of N or
-- of either bouds of Type are unknown at compile time, False will
(N : Node_Id;
Typ : Entity_Id;
Fixed_Int : Boolean := False;
- Int_Real : Boolean := False)
- return Boolean;
+ Int_Real : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that expression
-- N is known to be out of range of the subtype Typ. True is returned
-- if Typ is a scalar type, at least one of whose bounds is known at
function In_Subrange_Of
(T1 : Entity_Id;
T2 : Entity_Id;
- Fixed_Int : Boolean := False)
- return Boolean;
+ Fixed_Int : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that the range
-- of values for scalar type T1 are always in the range of scalar type
-- T2. A result of False does not mean that T1 is not in T2's subrange,
OSDN Git Service
