diff options
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 194 |
1 files changed, 117 insertions, 77 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 77bf311..5ff2d7c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2892,11 +2892,15 @@ package body Sem_Util is 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: @@ -2912,24 +2916,25 @@ package body Sem_Util is -- 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 @@ -2941,13 +2946,36 @@ package body Sem_Util is -- 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 -- @@ -3829,16 +3857,16 @@ package body Sem_Util is 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 @@ -3849,33 +3877,6 @@ package body Sem_Util is -- 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 -- ------------------ @@ -3940,33 +3941,55 @@ package body Sem_Util is 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; @@ -3981,9 +4004,16 @@ package body Sem_Util is -- 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)); @@ -3995,26 +4025,29 @@ package body Sem_Util is 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)); @@ -4038,6 +4071,13 @@ package body Sem_Util is 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 |