From: ebotcazou Date: Sat, 11 Jul 2009 20:52:28 +0000 (+0000) Subject: * checks.adb (Apply_Address_Clause_Check): Remove Size_Warning_Output X-Git-Tag: upstream/4.9.2~34919 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=d6da74485431adc364c4bdeae355f7bc24e6e480;p=platform%2Fupstream%2Flinaro-gcc.git * 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) : 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) : 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149520 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6abe933..7f2c2e2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,35 @@ 2009-07-11 Eric Botcazou + * 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) : 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) : 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 + * gcc-interface/ada-tree.h: Minor reorganization. * gcc-interface/misc.c (gnat_print_decl): Minor tweaks. (gnat_print_type): Likewise. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 7f78a5e..d086161 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -532,16 +532,11 @@ package body Checks is -- 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 -- @@ -549,9 +544,7 @@ package body Checks is 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); @@ -565,7 +558,24 @@ package body Checks is -- 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); @@ -603,69 +613,7 @@ package body Checks is 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)) @@ -690,20 +638,14 @@ package body Checks is -- 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 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 4208612..67d8cd1 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -905,6 +905,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) mark_visited (&gnu_decl); save_gnu_tree (gnat_entity, gnu_decl, true); saved = true; + annotate_object (gnat_entity, gnu_type, NULL_TREE, + false); break; } @@ -1382,32 +1384,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && 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; @@ -7223,6 +7208,39 @@ annotate_value (tree gnu_size) 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. */ diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 7bc89ee..de253b8 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -135,6 +135,13 @@ extern tree maybe_pad_type (tree type, tree size, unsigned int align, 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 diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 76200ab..5b4e5e8 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -2328,13 +2328,18 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) 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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 8f4d6ee..b763aa5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -87,9 +87,6 @@ package body Sem_Ch13 is -- 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; @@ -164,6 +161,9 @@ package body Sem_Ch13 is 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 ( @@ -174,33 +174,6 @@ package body Sem_Ch13 is 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 -- ----------------------------------------- @@ -906,11 +879,12 @@ package body Sem_Ch13 is 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 @@ -918,12 +892,15 @@ package body Sem_Ch13 is 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); @@ -934,9 +911,9 @@ package body Sem_Ch13 is 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); @@ -964,10 +941,15 @@ package body Sem_Ch13 is -- 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 @@ -1015,53 +997,42 @@ package body Sem_Ch13 is -- 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 @@ -4255,6 +4226,8 @@ package body Sem_Ch13 is ACCR : Address_Clause_Check_Record renames Address_Clause_Checks.Table (J); + Expr : Node_Id; + X_Alignment : Uint; Y_Alignment : Uint; @@ -4266,35 +4239,17 @@ package body Sem_Ch13 is 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 @@ -4302,8 +4257,10 @@ package body Sem_Ch13 is 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); @@ -4311,16 +4268,23 @@ package body Sem_Ch13 is 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 " @@ -4337,6 +4301,11 @@ package body Sem_Ch13 is 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; 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 diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b4adabf..1d83684 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -320,12 +320,16 @@ package Sem_Util is -- 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 36a9bd3..5fd1d6b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2009-07-11 Eric Botcazou + + * gnat.dg/specs/addr1.ads: New test. + 2009-07-11 Jan Hubicka PR middle-end/48388 diff --git a/gcc/testsuite/gnat.dg/specs/addr1.ads b/gcc/testsuite/gnat.dg/specs/addr1.ads new file mode 100644 index 0000000..83d432c --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/addr1.ads @@ -0,0 +1,35 @@ +-- { 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;