From 36d3d5d3db9e70689f4eb47baf18f59d545e73ad Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 16 Jun 2016 10:19:51 +0000 Subject: [PATCH] sem_util.ads (Indexed_Component_Bit_Offset): Declare. 2016-06-16 Eric Botcazou * 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 --- gcc/ada/ChangeLog | 11 +++++++ gcc/ada/sem_ch13.adb | 67 +++++++++++++++++++++++++++++++++++++++-- gcc/ada/sem_util.adb | 72 +++++++++++++++++++++++++++++++++++--------- gcc/ada/sem_util.ads | 6 ++++ 4 files changed, 139 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af0fcc8c371..d9239fff946 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2016-06-16 Eric Botcazou + + * 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 * bindgen.adb, exp_util.adb, sem_ch9.adb, sem_util.adb: Minor diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 06e5d1b66e5..1d732b9b590 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 49401d5665b..014d86ad2ce 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 -- ----------------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index ea5f4e63c9f..503c5eb96e5 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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. -- 2.30.2