2009-07-11 Eric Botcazou <ebotcazou@adacore.com>
+ * checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output
+ local variable and do not test it in Compile_Time_Bad_Alignment.
+ Do not issue size or alignment warnings for the X'Address form.
+ * sem_util.ads (Find_Overlaid_Object): Delete.
+ (Find_Overlaid_Entity): New procedure.
+ * sem_util.adb (Find_Overlaid_Object): Rename to...
+ (Find_Overlaid_Entity): ...this and turn into a procedure. Report
+ whether the address is offseted within the overlaid entity.
+ (Has_Compatible_Alignment): Track the offset globally instead of
+ passing it to Check_Offset. For an indexed component, compute the
+ full offset when possible. If the resulting offset is zero, only
+ check the prefix.
+ (Check_Offset): Delete.
+ * sem_ch13.adb (Address_Clause_Check_Record): Add Off field.
+ (Address_Aliased_Entity): Delete.
+ (Analyze_Attribute_Definition_Clause) <Attribute_Address>: Call
+ Find_Overlaid_Entity to find the overlaid entity and the offset.
+ Adjust throughout for above change.
+ (Validate_Address_Clauses): Always use attributes of entities, not of
+ their type. Tweak message for warning. Call Has_Compatible_Alignment
+ if the address is offseted to warn about incompatible alignments.
+ * gcc-interface/gigi.h (annotate_object): Declare.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Annotate renaming
+ entity. Call annotate_object instead of annotating manually objects.
+ (annotate_object): New function.
+ * gcc-interface/trans.c (Subprogram_Body_to_gnu): Annotate parameters
+ at the end.
+
+2009-07-11 Eric Botcazou <ebotcazou@adacore.com>
+
* gcc-interface/ada-tree.h: Minor reorganization.
* gcc-interface/misc.c (gnat_print_decl): Minor tweaks.
(gnat_print_type): Likewise.
-- when Aexp is a reference to a constant, in which case Expr gets
-- reset to reference the value expression of the constant.
- Size_Warning_Output : Boolean := False;
- -- If we output a size warning we set this True, to stop generating
- -- what is likely to be an unuseful redundant alignment warning.
-
procedure Compile_Time_Bad_Alignment;
-- Post error warnings when alignment is known to be incompatible. Note
-- that we do not go as far as inserting a raise of Program_Error since
-- this is an erroneous case, and it may happen that we are lucky and an
- -- underaligned address turns out to be OK after all. Also this warning
- -- is suppressed if we already complained about the size.
+ -- underaligned address turns out to be OK after all.
--------------------------------
-- Compile_Time_Bad_Alignment --
procedure Compile_Time_Bad_Alignment is
begin
- if not Size_Warning_Output
- and then Address_Clause_Overlay_Warnings
- then
+ if Address_Clause_Overlay_Warnings then
Error_Msg_FE
("?specified address for& may be inconsistent with alignment ",
Aexp, E);
-- Start of processing for Apply_Address_Clause_Check
begin
- -- First obtain expression from address clause
+ -- See if alignment check needed. Note that we never need a check if the
+ -- maximum alignment is one, since the check will always succeed.
+
+ -- Note: we do not check for checks suppressed here, since that check
+ -- was done in Sem_Ch13 when the address clause was processed. We are
+ -- only called if checks were not suppressed. The reason for this is
+ -- that we have to delay the call to Apply_Alignment_Check till freeze
+ -- time (so that all types etc are elaborated), but we have to check
+ -- the status of check suppressing at the point of the address clause.
+
+ if No (AC)
+ or else not Check_Address_Alignment (AC)
+ or else Maximum_Alignment = 1
+ then
+ return;
+ end if;
+
+ -- Obtain expression from address clause
Expr := Expression (AC);
end if;
end loop;
- -- Output a warning if we have the situation of
-
- -- for X'Address use Y'Address
-
- -- and X and Y both have known object sizes, and Y is smaller than X
-
- if Nkind (Expr) = N_Attribute_Reference
- and then Attribute_Name (Expr) = Name_Address
- and then Is_Entity_Name (Prefix (Expr))
- then
- declare
- Exp_Ent : constant Entity_Id := Entity (Prefix (Expr));
- Obj_Size : Uint := No_Uint;
- Exp_Size : Uint := No_Uint;
-
- begin
- if Known_Esize (E) then
- Obj_Size := Esize (E);
- elsif Known_Esize (Etype (E)) then
- Obj_Size := Esize (Etype (E));
- end if;
-
- if Known_Esize (Exp_Ent) then
- Exp_Size := Esize (Exp_Ent);
- elsif Known_Esize (Etype (Exp_Ent)) then
- Exp_Size := Esize (Etype (Exp_Ent));
- end if;
-
- if Obj_Size /= No_Uint
- and then Exp_Size /= No_Uint
- and then Obj_Size > Exp_Size
- and then not Has_Warnings_Off (E)
- then
- if Address_Clause_Overlay_Warnings then
- Error_Msg_FE
- ("?& overlays smaller object", Aexp, E);
- Error_Msg_FE
- ("\?program execution may be erroneous", Aexp, E);
- Size_Warning_Output := True;
- Set_Address_Warning_Posted (AC);
- end if;
- end if;
- end;
- end if;
-
- -- See if alignment check needed. Note that we never need a check if the
- -- maximum alignment is one, since the check will always succeed.
-
- -- Note: we do not check for checks suppressed here, since that check
- -- was done in Sem_Ch13 when the address clause was processed. We are
- -- only called if checks were not suppressed. The reason for this is
- -- that we have to delay the call to Apply_Alignment_Check till freeze
- -- time (so that all types etc are elaborated), but we have to check
- -- the status of check suppressing at the point of the address clause.
-
- if No (AC)
- or else not Check_Address_Alignment (AC)
- or else Maximum_Alignment = 1
- then
- return;
- end if;
-
- -- See if we know that Expr is a bad alignment at compile time
+ -- See if we know that Expr has a bad alignment at compile time
if Compile_Time_Known_Value (Expr)
and then (Known_Alignment (E) or else Known_Alignment (Typ))
-- If the expression has the form X'Address, then we can find out if
-- the object X has an alignment that is compatible with the object E.
+ -- If it hasn't or we don't know, we defer issuing the warning until
+ -- the end of the compilation to take into account back end annotations.
elsif Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
+ and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible
then
- declare
- AR : constant Alignment_Result :=
- Has_Compatible_Alignment (E, Prefix (Expr));
- begin
- if AR = Known_Compatible then
- return;
- elsif AR = Known_Incompatible then
- Compile_Time_Bad_Alignment;
- end if;
- end;
+ return;
end if;
-- Here we do not know if the value is acceptable. Stricly we don't have
mark_visited (&gnu_decl);
save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true;
+ annotate_object (gnat_entity, gnu_type, NULL_TREE,
+ false);
break;
}
&& Exception_Mechanism != Back_End_Exceptions)
TREE_ADDRESSABLE (gnu_decl) = 1;
- gnu_type = TREE_TYPE (gnu_decl);
-
- /* Back-annotate Alignment and Esize of the object if not already
- known, except for when the object is actually a pointer to the
- real object, since alignment and size of a pointer don't have
- anything to do with those of the designated object. Note that
- we pick the values of the type, not those of the object, to
- shield ourselves from low-level platform-dependent adjustments
- like alignment promotion. This is both consistent with all the
- treatment above, where alignment and size are set on the type of
- the object and not on the object directly, and makes it possible
- to support confirming representation clauses in all cases. */
-
- if (!used_by_ref && Unknown_Alignment (gnat_entity))
- Set_Alignment (gnat_entity,
- UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
-
- if (!used_by_ref && Unknown_Esize (gnat_entity))
- {
- if (TREE_CODE (gnu_type) == RECORD_TYPE
- && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
- gnu_object_size
- = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
-
- Set_Esize (gnat_entity, annotate_value (gnu_object_size));
- }
+ /* Back-annotate Esize and Alignment of the object if not already
+ known. Note that we pick the values of the type, not those of
+ the object, to shield ourselves from low-level platform-dependent
+ adjustments like alignment promotion. This is both consistent with
+ all the treatment above, where alignment and size are set on the
+ type of the object and not on the object directly, and makes it
+ possible to support all confirming representation clauses. */
+ annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
+ used_by_ref);
}
break;
return ret;
}
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+ and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+ size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null.
+ BY_REF is true if the object is used by reference. */
+
+void
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
+{
+ if (by_ref)
+ {
+ if (TYPE_FAT_POINTER_P (gnu_type))
+ gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
+ else
+ gnu_type = TREE_TYPE (gnu_type);
+ }
+
+ if (Unknown_Esize (gnat_entity))
+ {
+ if (TREE_CODE (gnu_type) == RECORD_TYPE
+ && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
+ size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
+ else if (!size)
+ size = TYPE_SIZE (gnu_type);
+
+ if (size)
+ Set_Esize (gnat_entity, annotate_value (size));
+ }
+
+ if (Unknown_Alignment (gnat_entity))
+ Set_Alignment (gnat_entity,
+ UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
+}
+
/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding
GCC type, set Component_Bit_Offset and Esize to the position and size
used by Gigi. */
the value passed against the list of choices. */
extern tree choices_to_gnu (tree operand, Node_Id choices);
+/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
+ and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
+ size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null.
+ BY_REF is true if the object is used by reference. */
+extern void annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size,
+ bool by_ref);
+
/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
type with all size expressions that contain F updated by replacing F
with R. If F is NULL_TREE, always make a new RECORD_TYPE, even if
end_subprog_body (gnu_result, false);
- /* Disconnect the trees for parameters that we made variables for from the
- GNAT entities since these are unusable after we end the function. */
+ /* Finally annotate the parameters and disconnect the trees for parameters
+ that we have turned into variables since they are now unusable. */
for (gnat_param = First_Formal_With_Extras (gnat_subprog_id);
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param))
- if (TREE_CODE (get_gnu_tree (gnat_param)) == VAR_DECL)
- save_gnu_tree (gnat_param, NULL_TREE, false);
+ {
+ tree gnu_param = get_gnu_tree (gnat_param);
+ annotate_object (gnat_param, TREE_TYPE (gnu_param), NULL_TREE,
+ DECL_BY_REF_P (gnu_param));
+ if (TREE_CODE (gnu_param) == VAR_DECL)
+ save_gnu_tree (gnat_param, NULL_TREE, false);
+ }
if (DECL_FUNCTION_STUB (gnu_subprog_decl))
build_function_stub (gnu_subprog_decl, gnat_subprog_id);
-- Attributes that do not specify a representation characteristic are
-- operational attributes.
- function Address_Aliased_Entity (N : Node_Id) return Entity_Id;
- -- If expression N is of the form E'Address, return E
-
procedure New_Stream_Subprogram
(N : Node_Id;
Ent : Entity_Id;
Y : Entity_Id;
-- The entity of the object being overlaid
+
+ Off : Boolean;
+ -- Whether the address is offseted within Y
end record;
package Address_Clause_Checks is new Table.Table (
Table_Increment => 200,
Table_Name => "Address_Clause_Checks");
- ----------------------------
- -- Address_Aliased_Entity --
- ----------------------------
-
- function Address_Aliased_Entity (N : Node_Id) return Entity_Id is
- begin
- if Nkind (N) = N_Attribute_Reference
- and then Attribute_Name (N) = Name_Address
- then
- declare
- P : Node_Id;
-
- begin
- P := Prefix (N);
- while Nkind_In (P, N_Selected_Component, N_Indexed_Component) loop
- P := Prefix (P);
- end loop;
-
- if Is_Entity_Name (P) then
- return Entity (P);
- end if;
- end;
- end if;
-
- return Empty;
- end Address_Aliased_Entity;
-
-----------------------------------------
-- Adjust_Record_For_Reverse_Bit_Order --
-----------------------------------------
Ekind (U_Ent) = E_Constant
then
declare
- Expr : constant Node_Id := Expression (N);
- Aent : constant Entity_Id := Address_Aliased_Entity (Expr);
- Ent_Y : constant Entity_Id := Find_Overlaid_Object (N);
+ Expr : constant Node_Id := Expression (N);
+ O_Ent : Entity_Id;
+ Off : Boolean;
begin
+
-- Exported variables cannot have an address clause,
-- because this cancels the effect of the pragma Export
Error_Msg_N
("cannot export object with address clause", Nam);
return;
+ end if;
+
+ Find_Overlaid_Entity (N, O_Ent, Off);
-- Overlaying controlled objects is erroneous
- elsif Present (Aent)
- and then (Has_Controlled_Component (Etype (Aent))
- or else Is_Controlled (Etype (Aent)))
+ if Present (O_Ent)
+ and then (Has_Controlled_Component (Etype (O_Ent))
+ or else Is_Controlled (Etype (O_Ent)))
then
Error_Msg_N
("?cannot overlay with controlled object", Expr);
Reason => PE_Overlaid_Controlled_Object));
return;
- elsif Present (Aent)
+ elsif Present (O_Ent)
and then Ekind (U_Ent) = E_Constant
- and then not Is_Constant_Object (Aent)
+ and then not Is_Constant_Object (O_Ent)
then
Error_Msg_N ("constant overlays a variable?", Expr);
-- Here we are checking for explicit overlap of one variable
-- by another, and if we find this then mark the overlapped
-- variable as also being volatile to prevent unwanted
- -- optimizations.
+ -- optimizations. This is a significant pessimization so
+ -- avoid it when there is an offset, i.e. when the object
+ -- is composite; they cannot be optimized easily anyway.
- if Present (Ent_Y) then
- Set_Treat_As_Volatile (Ent_Y);
+ if Present (O_Ent)
+ and then Is_Object (O_Ent)
+ and then not Off
+ then
+ Set_Treat_As_Volatile (O_Ent);
end if;
-- Legality checks on the address clause for initialized
-- the variable, it is somewhere else.
Kill_Size_Check_Code (U_Ent);
- end;
-
- -- If the address clause is of the form:
-
- -- for Y'Address use X'Address
- -- or
+ -- If the address clause is of the form:
- -- Const : constant Address := X'Address;
- -- ...
- -- for Y'Address use Const;
+ -- for Y'Address use X'Address
- -- then we make an entry in the table for checking the size and
- -- alignment of the overlaying variable. We defer this check
- -- till after code generation to take full advantage of the
- -- annotation done by the back end. This entry is only made if
- -- we have not already posted a warning about size/alignment
- -- (some warnings of this type are posted in Checks), and if
- -- the address clause comes from source.
+ -- or
- if Address_Clause_Overlay_Warnings
- and then Comes_From_Source (N)
- then
- declare
- Ent_X : Entity_Id := Empty;
- Ent_Y : Entity_Id := Empty;
+ -- Const : constant Address := X'Address;
+ -- ...
+ -- for Y'Address use Const;
- begin
- Ent_Y := Find_Overlaid_Object (N);
+ -- then we make an entry in the table for checking the size
+ -- and alignment of the overlaying variable. We defer this
+ -- check till after code generation to take full advantage
+ -- of the annotation done by the back end. This entry is
+ -- only made if the address clause comes from source.
- if Present (Ent_Y) and then Is_Entity_Name (Name (N)) then
- Ent_X := Entity (Name (N));
- Address_Clause_Checks.Append ((N, Ent_X, Ent_Y));
+ if Address_Clause_Overlay_Warnings
+ and then Comes_From_Source (N)
+ and then Present (O_Ent)
+ and then Is_Object (O_Ent)
+ then
+ Address_Clause_Checks.Append ((N, U_Ent, O_Ent, Off));
- -- If variable overlays a constant view, and we are
- -- warning on overlays, then mark the variable as
- -- overlaying a constant (we will give warnings later
- -- if this variable is assigned).
+ -- If variable overlays a constant view, and we are
+ -- warning on overlays, then mark the variable as
+ -- overlaying a constant (we will give warnings later
+ -- if this variable is assigned).
- if Is_Constant_Object (Ent_Y)
- and then Ekind (Ent_X) = E_Variable
- then
- Set_Overlays_Constant (Ent_X);
- end if;
+ if Is_Constant_Object (O_Ent)
+ and then Ekind (U_Ent) = E_Variable
+ then
+ Set_Overlays_Constant (U_Ent);
end if;
- end;
- end if;
+ end if;
+ end;
-- Not a valid entity for an address clause
ACCR : Address_Clause_Check_Record
renames Address_Clause_Checks.Table (J);
+ Expr : Node_Id;
+
X_Alignment : Uint;
Y_Alignment : Uint;
if not Address_Warning_Posted (ACCR.N) then
- -- Get alignments. Really we should always have the alignment
- -- of the objects properly back annotated, but right now the
- -- back end fails to back annotate for address clauses???
+ Expr := Original_Node (Expression (ACCR.N));
- if Known_Alignment (ACCR.X) then
- X_Alignment := Alignment (ACCR.X);
- else
- X_Alignment := Alignment (Etype (ACCR.X));
- end if;
+ -- Get alignments
- if Known_Alignment (ACCR.Y) then
- Y_Alignment := Alignment (ACCR.Y);
- else
- Y_Alignment := Alignment (Etype (ACCR.Y));
- end if;
+ X_Alignment := Alignment (ACCR.X);
+ Y_Alignment := Alignment (ACCR.Y);
-- Similarly obtain sizes
- if Known_Esize (ACCR.X) then
- X_Size := Esize (ACCR.X);
- else
- X_Size := Esize (Etype (ACCR.X));
- end if;
-
- if Known_Esize (ACCR.Y) then
- Y_Size := Esize (ACCR.Y);
- else
- Y_Size := Esize (Etype (ACCR.Y));
- end if;
+ X_Size := Esize (ACCR.X);
+ Y_Size := Esize (ACCR.Y);
-- Check for large object overlaying smaller one
and then X_Size > Uint_0
and then X_Size > Y_Size
then
+ Error_Msg_NE
+ ("?& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
- ("?size for overlaid object is too small", ACCR.N);
+ ("\?program execution may be erroneous", ACCR.N);
Error_Msg_Uint_1 := X_Size;
Error_Msg_NE
("\?size of & is ^", ACCR.N, ACCR.X);
Error_Msg_NE
("\?size of & is ^", ACCR.N, ACCR.Y);
- -- Check for inadequate alignment. Again the defensive check
- -- on Y_Alignment should not be needed, but because of the
- -- failure in back end annotation, we can have an alignment
- -- of 0 here???
+ -- Check for inadequate alignment, both of the base object
+ -- and of the offset, if any.
- -- Note: we do not check alignments if we gave a size
- -- warning, since it would likely be redundant.
+ -- Note: we do not check the alignment if we gave a size
+ -- warning, since it would likely be redundant.
elsif Y_Alignment /= Uint_0
- and then Y_Alignment < X_Alignment
+ and then (Y_Alignment < X_Alignment
+ or else (ACCR.Off
+ and then
+ Nkind (Expr) = N_Attribute_Reference
+ and then
+ Attribute_Name (Expr) = Name_Address
+ and then
+ Has_Compatible_Alignment
+ (ACCR.X, Prefix (Expr))
+ /= Known_Compatible))
then
Error_Msg_NE
("?specified address for& may be inconsistent "
Error_Msg_NE
("\?alignment of & is ^",
ACCR.N, ACCR.Y);
+ if Y_Alignment >= X_Alignment then
+ Error_Msg_N
+ ("\?but offset is not multiple of alignment",
+ ACCR.N);
+ end if;
end if;
end if;
end;
end Find_Corresponding_Discriminant;
--------------------------
- -- Find_Overlaid_Object --
+ -- Find_Overlaid_Entity --
--------------------------
- function Find_Overlaid_Object (N : Node_Id) return Entity_Id is
- Expr : Node_Id;
+ procedure Find_Overlaid_Entity
+ (N : Node_Id;
+ Ent : out Entity_Id;
+ Off : out Boolean)
+ is
+ Expr : Node_Id;
begin
-- We are looking for one of the two following forms:
-- In the second case, the expr is either Y'Address, or recursively a
-- constant that eventually references Y'Address.
+ Ent := Empty;
+ Off := False;
+
if Nkind (N) = N_Attribute_Definition_Clause
and then Chars (N) = Name_Address
then
- -- This loop checks the form of the expression for Y'Address where Y
- -- is an object entity name. The first loop checks the original
- -- expression in the attribute definition clause. Subsequent loops
- -- check referenced constants.
-
Expr := Expression (N);
+
+ -- This loop checks the form of the expression for Y'Address,
+ -- using recursion to deal with intermediate constants.
+
loop
- -- Check for Y'Address where Y is an object entity
+ -- Check for Y'Address
if Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) = Name_Address
- and then Is_Entity_Name (Prefix (Expr))
- and then Is_Object (Entity (Prefix (Expr)))
then
- return Entity (Prefix (Expr));
+ Expr := Prefix (Expr);
+ exit;
-- Check for Const where Const is a constant entity
-- Anything else does not need checking
else
- exit;
+ return;
end if;
end loop;
- end if;
- return Empty;
- end Find_Overlaid_Object;
+ -- This loop checks the form of the prefix for an entity,
+ -- using recursion to deal with intermediate components.
+
+ loop
+ -- Check for Y where Y is an entity
+
+ if Is_Entity_Name (Expr) then
+ Ent := Entity (Expr);
+ return;
+
+ -- Check for components
+
+ elsif
+ Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) then
+
+ Expr := Prefix (Expr);
+ Off := True;
+
+ -- Anything else does not need checking
+
+ else
+ return;
+ end if;
+ end loop;
+ end if;
+ end Find_Overlaid_Entity;
-------------------------
-- Find_Parameter_Type --
Default : Alignment_Result) return Alignment_Result
is
Result : Alignment_Result := Known_Compatible;
- -- Set to result if Problem_Prefix or Problem_Offset returns True.
- -- Note that once a value of Known_Incompatible is set, it is sticky
- -- and does not get changed to Unknown (the value in Result only gets
- -- worse as we go along, never better).
+ -- Holds the current status of the result. Note that once a value of
+ -- Known_Incompatible is set, it is sticky and does not get changed
+ -- to Unknown (the value in Result only gets worse as we go along,
+ -- never better).
- procedure Check_Offset (Offs : Uint);
- -- Called when Expr is a selected or indexed component with Offs set
- -- to resp Component_First_Bit or Component_Size. Checks that if the
- -- offset is specified it is compatible with the object alignment
- -- requirements. The value in Result is modified accordingly.
+ Offs : Uint := No_Uint;
+ -- Set to a factor of the offset from the base object when Expr is a
+ -- selected or indexed component, based on Component_Bit_Offset and
+ -- Component_Size respectively. A negative value is used to represent
+ -- a value which is not known at compile time.
procedure Check_Prefix;
-- Checks the prefix recursively in the case where the expression
-- compatible, or known incompatible), then set Result to R.
------------------
- -- Check_Offset --
- ------------------
-
- procedure Check_Offset (Offs : Uint) is
- begin
- -- Unspecified or zero offset is always OK
-
- if Offs = No_Uint or else Offs = Uint_0 then
- null;
-
- -- If we do not know required alignment, any non-zero offset is
- -- a potential problem (but certainly may be OK, so result is
- -- unknown).
-
- elsif Unknown_Alignment (Obj) then
- Set_Result (Unknown);
-
- -- If we know the required alignment, see if offset is compatible
-
- else
- if Offs mod (System_Storage_Unit * Alignment (Obj)) /= 0 then
- Set_Result (Known_Incompatible);
- end if;
- end if;
- end Check_Offset;
-
- ------------------
-- Check_Prefix --
------------------
Set_Result (Unknown);
end if;
- -- Check possible bad component offset and check prefix
+ -- Check prefix and component offset
- Check_Offset
- (Component_Bit_Offset (Entity (Selector_Name (Expr))));
Check_Prefix;
+ Offs := Component_Bit_Offset (Entity (Selector_Name (Expr)));
-- If Expr is an indexed component, we must make sure there is no
-- potentially troublesome Component_Size clause and that the array
-- is not bit-packed.
elsif Nkind (Expr) = N_Indexed_Component then
+ declare
+ Typ : constant Entity_Id := Etype (Prefix (Expr));
+ Ind : constant Node_Id := First_Index (Typ);
+ begin
+ -- Bit packed array always generates unknown alignment
- -- Bit packed array always generates unknown alignment
+ if Is_Bit_Packed_Array (Typ) then
+ Set_Result (Unknown);
+ end if;
- if Is_Bit_Packed_Array (Etype (Prefix (Expr))) then
- Set_Result (Unknown);
- end if;
+ -- Check prefix and component offset
- -- Check possible bad component size and check prefix
+ Check_Prefix;
+ Offs := Component_Size (Typ);
- Check_Offset (Component_Size (Etype (Prefix (Expr))));
- Check_Prefix;
+ -- Small optimization: compute the full offset when possible
+
+ if Offs /= No_Uint
+ and then Offs > Uint_0
+ and then Present (Ind)
+ and then Nkind (Ind) = N_Range
+ and then Compile_Time_Known_Value (Low_Bound (Ind))
+ and then Compile_Time_Known_Value (First (Expressions (Expr)))
+ then
+ Offs := Offs * (Expr_Value (First (Expressions (Expr)))
+ - Expr_Value (Low_Bound ((Ind))));
+ end if;
+ end;
end if;
+ -- If we have a null offset, the result is entirely determined by
+ -- the base object and has already been computed recursively.
+
+ if Offs = Uint_0 then
+ null;
+
-- Case where we know the alignment of the object
- if Known_Alignment (Obj) then
+ elsif Known_Alignment (Obj) then
declare
ObjA : constant Uint := Alignment (Obj);
ExpA : Uint := No_Uint;
-- Alignment of Obj is greater than 1, so we need to check
else
- -- See if Expr is an object with known alignment
+ -- If we have an offset, see if it is compatible
- if Is_Entity_Name (Expr)
+ if Offs /= No_Uint and Offs > Uint_0 then
+ if Offs mod (System_Storage_Unit * ObjA) /= 0 then
+ Set_Result (Known_Incompatible);
+ end if;
+
+ -- See if Expr is an object with known alignment
+
+ elsif Is_Entity_Name (Expr)
and then Known_Alignment (Entity (Expr))
then
ExpA := Alignment (Entity (Expr));
elsif Known_Alignment (Etype (Expr)) then
ExpA := Alignment (Etype (Expr));
+
+ -- Otherwise the alignment is unknown
+
+ else
+ Set_Result (Default);
end if;
-- If we got an alignment, see if it is acceptable
- if ExpA /= No_Uint then
- if ExpA < ObjA then
- Set_Result (Known_Incompatible);
- end if;
+ if ExpA /= No_Uint and then ExpA < ObjA then
+ Set_Result (Known_Incompatible);
+ end if;
- -- Case of Expr alignment unknown
+ -- If Expr is not a piece of a larger object, see if size
+ -- is given. If so, check that it is not too small for the
+ -- required alignment.
- else
- Set_Result (Default);
- end if;
+ if Offs /= No_Uint then
+ null;
- -- See if size is given. If so, check that it is not too
- -- small for the required alignment.
- -- See if Expr is an object with known alignment
+ -- See if Expr is an object with known size
- if Is_Entity_Name (Expr)
+ elsif Is_Entity_Name (Expr)
and then Known_Static_Esize (Entity (Expr))
then
SizA := Esize (Entity (Expr));
end if;
end;
+ -- If we do not know required alignment, any non-zero offset is
+ -- a potential problem (but certainly may be OK, so result is
+ -- unknown).
+
+ elsif Offs /= No_Uint then
+ Set_Result (Unknown);
+
-- If we can't find the result by direct comparison of alignment
-- values, then there is still one case that we can determine known
-- result, and that is when we can determine that the types are the
-- denotes when analyzed. Subsequent uses of this id on a different
-- type denote the discriminant at the same position in this new type.
- function Find_Overlaid_Object (N : Node_Id) return Entity_Id;
- -- The node N should be an address representation clause. This function
- -- checks if the target expression is the address of some stand alone
- -- object (variable or constant), and if so, returns its entity. If N is
- -- not an address representation clause, or if it is not possible to
- -- determine that the address is of this form, then Empty is returned.
+ procedure Find_Overlaid_Entity
+ (N : Node_Id;
+ Ent : out Entity_Id;
+ Off : out Boolean);
+ -- The node N should be an address representation clause. Determines if
+ -- the target expression is the address of an entity with an optional
+ -- offset. If so, set Ent to the entity and, if there is an offset, set
+ -- Off to True, otherwise to False. If N is not an address representation
+ -- clause, or if it is not possible to determine that the address is of
+ -- this form, then set Ent to Empty.
function Find_Parameter_Type (Param : Node_Id) return Entity_Id;
-- Return the type of formal parameter Param as determined by its
+2009-07-11 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/specs/addr1.ads: New test.
+
2009-07-11 Jan Hubicka <jh@suse.cz>
PR middle-end/48388
--- /dev/null
+-- { dg-do compile }
+
+with Interfaces; use Interfaces;
+
+package Addr1 is
+
+ type Arr is array (Integer range <>) of Unsigned_16;
+
+ type Rec1 is record
+ I1, I2: Integer;
+ end record;
+
+ type Rec2 is record
+ I1, I2: Integer;
+ end record;
+ for Rec2'Size use 64;
+
+ A: Arr (1 .. 12);
+
+ Obj1: Rec1;
+ for Obj1'Address use A'Address; -- { dg-bogus "alignment" }
+
+ Obj2: Rec2;
+ for Obj2'Address use A'Address; -- { dg-bogus "alignment" }
+
+ Obj3: Rec1;
+ for Obj3'Address use A(1)'Address; -- { dg-bogus "alignment" }
+
+ Obj4: Rec1;
+ for Obj4'Address use A(2)'Address; -- { dg-warning "(alignment|erroneous)" }
+
+ Obj5: Rec1;
+ for Obj5'Address use A(3)'Address; -- { dg-bogus "alignment" }
+
+end Addr1;
projects / platform / upstream / linaro-gcc.git / commitdiff