sem_util.ads (Indexed_Component_Bit_Offset): Declare.
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. From-SVN: r237511
This commit is contained in:
parent
3455747810
commit
36d3d5d3db
|
@ -1,3 +1,14 @@
|
|||
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
|
||||
|
|
|
@ -13626,6 +13626,53 @@ package body Sem_Ch13 is
|
|||
------------------------------
|
||||
|
||||
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
|
||||
|
@ -13640,6 +13687,8 @@ package body Sem_Ch13 is
|
|||
X_Size : Uint;
|
||||
Y_Size : Uint;
|
||||
|
||||
X_Offs : Uint;
|
||||
|
||||
begin
|
||||
-- Skip processing of this entry if warning already posted
|
||||
|
||||
|
@ -13651,16 +13700,25 @@ package body Sem_Ch13 is
|
|||
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
|
||||
|
@ -13672,6 +13730,11 @@ package body Sem_Ch13 is
|
|||
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
|
||||
|
|
|
@ -8780,7 +8780,6 @@ package body Sem_Util is
|
|||
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
|
||||
|
@ -8789,22 +8788,12 @@ package body Sem_Util is
|
|||
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;
|
||||
|
@ -11064,6 +11053,59 @@ package body Sem_Util is
|
|||
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 --
|
||||
-----------------------------------------
|
||||
|
|
|
@ -1232,6 +1232,12 @@ package Sem_Util is
|
|||
-- 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.
|
||||
|
|
Loading…
Reference in New Issue