+2016-06-16 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_util.ads (Indexed_Component_Bit_Offset): Declare.
+ * sem_util.adb (Indexed_Component_Bit_Offset): New
+ function returning the offset of an indexed component.
+ (Has_Compatible_Alignment_Internal): Call it.
+ * sem_ch13.adb (Offset_Value): New function returning the offset of an
+ Address attribute reference from the underlying entity.
+ (Validate_Address_Clauses): Call it and take the offset into
+ account for the size warning.
+
2016-06-16 Hristian Kirtchev <kirtchev@adacore.com>
* bindgen.adb, exp_util.adb, sem_ch9.adb, sem_util.adb: Minor
------------------------------
procedure Validate_Address_Clauses is
+ function Offset_Value (Expr : Node_Id) return Uint;
+ -- Given an Address attribute reference, return the value in bits of its
+ -- offset from the first bit of the underlying entity, or 0 if it is not
+ -- known at compile time.
+
+ ------------------
+ -- Offset_Value --
+ ------------------
+
+ function Offset_Value (Expr : Node_Id) return Uint is
+ N : Node_Id := Prefix (Expr);
+ Off : Uint;
+ Val : Uint := Uint_0;
+
+ begin
+ -- Climb the prefix chain and compute the cumulative offset
+
+ loop
+ if Is_Entity_Name (N) then
+ return Val;
+
+ elsif Nkind (N) = N_Selected_Component then
+ Off := Component_Bit_Offset (Entity (Selector_Name (N)));
+ if Off /= No_Uint and then Off >= Uint_0 then
+ Val := Val + Off;
+ N := Prefix (N);
+ else
+ return Uint_0;
+ end if;
+
+ elsif Nkind (N) = N_Indexed_Component then
+ Off := Indexed_Component_Bit_Offset (N);
+ if Off /= No_Uint then
+ Val := Val + Off;
+ N := Prefix (N);
+ else
+ return Uint_0;
+ end if;
+
+ else
+ return Uint_0;
+ end if;
+ end loop;
+ end Offset_Value;
+
+ -- Start of processing for Validate_Address_Clauses
+
begin
for J in Address_Clause_Checks.First .. Address_Clause_Checks.Last loop
declare
X_Size : Uint;
Y_Size : Uint;
+ X_Offs : Uint;
+
begin
-- Skip processing of this entry if warning already posted
X_Alignment := Alignment (ACCR.X);
Y_Alignment := Alignment (ACCR.Y);
- -- Similarly obtain sizes
+ -- Similarly obtain sizes and offset
X_Size := Esize (ACCR.X);
Y_Size := Esize (ACCR.Y);
+ if ACCR.Off
+ and then Nkind (Expr) = N_Attribute_Reference
+ and then Attribute_Name (Expr) = Name_Address
+ then
+ X_Offs := Offset_Value (Expr);
+ else
+ X_Offs := Uint_0;
+ end if;
+
-- Check for large object overlaying smaller one
if Y_Size > Uint_0
and then X_Size > Uint_0
- and then X_Size > Y_Size
+ and then X_Offs + X_Size > Y_Size
then
Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X);
Error_Msg_N
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
+ if X_Offs /= Uint_0 then
+ Error_Msg_Uint_1 := X_Offs;
+ Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X);
+ end if;
+
-- Check for inadequate alignment, both of the base object
-- and of the offset, if any. We only do this check if the
-- run-time Alignment_Check is active. No point in warning
elsif Nkind (Expr) = N_Indexed_Component then
declare
Typ : constant Entity_Id := Etype (Prefix (Expr));
- Ind : constant Node_Id := First_Index (Typ);
begin
-- Packing generates unknown alignment if layout is not done
Set_Result (Unknown);
end if;
- -- Check prefix and component offset
+ -- Check prefix and component offset (or at least size)
Check_Prefix;
- Offs := Component_Size (Typ);
-
- -- 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))));
+ Offs := Indexed_Component_Bit_Offset (Expr);
+ if Offs = No_Uint then
+ Offs := Component_Size (Typ);
end if;
end;
end if;
return Empty;
end Incomplete_Or_Partial_View;
+ ----------------------------------
+ -- Indexed_Component_Bit_Offset --
+ ----------------------------------
+
+ function Indexed_Component_Bit_Offset (N : Node_Id) return Uint is
+ Exp : constant Node_Id := First (Expressions (N));
+ Typ : constant Entity_Id := Etype (Prefix (N));
+ Off : constant Uint := Component_Size (Typ);
+ Ind : Node_Id;
+
+ begin
+ -- Return early if the component size is not known or variable
+
+ if Off = No_Uint or else Off < Uint_0 then
+ return No_Uint;
+ end if;
+
+ -- Deal with the degenerate case of an empty component
+
+ if Off = Uint_0 then
+ return Off;
+ end if;
+
+ -- Check that both the index value and the low bound are known
+
+ if not Compile_Time_Known_Value (Exp) then
+ return No_Uint;
+ end if;
+
+ Ind := First_Index (Typ);
+ if No (Ind) then
+ return No_Uint;
+ end if;
+
+ if Nkind (Ind) = N_Subtype_Indication then
+ Ind := Constraint (Ind);
+
+ if Nkind (Ind) = N_Range_Constraint then
+ Ind := Range_Expression (Ind);
+ end if;
+ end if;
+
+ if Nkind (Ind) /= N_Range
+ or else not Compile_Time_Known_Value (Low_Bound (Ind))
+ then
+ return No_Uint;
+ end if;
+
+ -- Return the scaled offset
+
+ return Off * (Expr_Value (Exp) - Expr_Value (Low_Bound ((Ind))));
+ end Indexed_Component_Bit_Offset;
+
-----------------------------------------
-- Inherit_Default_Init_Cond_Procedure --
-----------------------------------------
-- partial view of the same entity. Note that Id may not have a partial
-- view in which case the function returns Empty.
+ function Indexed_Component_Bit_Offset (N : Node_Id) return Uint;
+ -- Given an N_Indexed_Component node, return the first bit position of the
+ -- component if it is known at compile time. A value of No_Uint means that
+ -- either the value is not yet known before back-end processing or it is
+ -- not known at compile time after back-end processing.
+
procedure Inherit_Default_Init_Cond_Procedure (Typ : Entity_Id);
-- Inherit the default initial condition procedure from the parent type of
-- derived type Typ.
projects / gcc.git / commitdiff