diff options
Diffstat (limited to 'gcc/ada/layout.adb')
| -rw-r--r-- | gcc/ada/layout.adb | 129 |
1 files changed, 93 insertions, 36 deletions
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index ad80849..e69386c 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2020, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2021, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -23,19 +23,23 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Debug; use Debug; -with Einfo; use Einfo; -with Errout; use Errout; -with Opt; use Opt; -with Sem_Aux; use Sem_Aux; -with Sem_Ch13; use Sem_Ch13; -with Sem_Eval; use Sem_Eval; -with Sem_Util; use Sem_Util; -with Sinfo; use Sinfo; -with Snames; use Snames; -with Ttypes; use Ttypes; -with Uintp; use Uintp; +with Atree; use Atree; +with Debug; use Debug; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Errout; use Errout; +with Opt; use Opt; +with Sem_Aux; use Sem_Aux; +with Sem_Ch13; use Sem_Ch13; +with Sem_Eval; use Sem_Eval; +with Sem_Util; use Sem_Util; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Snames; use Snames; +with Ttypes; use Ttypes; +with Uintp; use Uintp; package body Layout is @@ -73,7 +77,7 @@ package body Layout is begin -- Nothing to do if size unknown - if Unknown_Esize (E) then + if not Known_Esize (E) then return; end if; @@ -115,7 +119,7 @@ package body Layout is -- Now we have the size set, it must be a multiple of the alignment -- nothing more we can do here if the alignment is unknown here. - if Unknown_Alignment (E) then + if not Known_Alignment (E) then return; end if; @@ -235,8 +239,8 @@ package body Layout is Desig_Type : Entity_Id; begin - -- For string literal types, for now, kill the size always, this is - -- because gigi does not like or need the size to be set ??? + -- For string literal types, kill the size always, because gigi does not + -- like or need the size to be set. if Ekind (E) = E_String_Literal_Subtype then Set_Esize (E, Uint_0); @@ -266,15 +270,15 @@ package body Layout is Desig_Type := Non_Limited_View (Designated_Type (E)); end if; - -- If Esize already set (e.g. by a size clause), then nothing further - -- to be done here. + -- If Esize already set (e.g. by a size or value size clause), then + -- nothing further to be done here. if Known_Esize (E) then null; - -- Access to subprogram is a strange beast, and we let the backend - -- figure out what is needed (it may be some kind of fat pointer, - -- including the static link for example. + -- Access to protected subprogram is a strange beast, and we let the + -- backend figure out what is needed (it may be some kind of fat + -- pointer, including the static link for example). elsif Is_Access_Protected_Subprogram_Type (E) then null; @@ -368,7 +372,7 @@ package body Layout is if not Known_Esize (E) then declare - S : Int := 8; + S : Pos := 8; begin loop @@ -381,7 +385,7 @@ package body Layout is -- If the RM_Size is greater than System_Max_Integer_Size -- (happens only when strange values are specified by the -- user), then Esize is simply a copy of RM_Size, it will - -- be further refined later on). + -- be further refined later on. elsif S = System_Max_Integer_Size then Set_Esize (E, RM_Size (E)); @@ -400,7 +404,7 @@ package body Layout is -- it now to a copy of the Esize if the Esize is set. else - if Known_Esize (E) and then Unknown_RM_Size (E) then + if Known_Esize (E) and then not Known_RM_Size (E) then Set_RM_Size (E, Esize (E)); end if; end if; @@ -421,15 +425,15 @@ package body Layout is PAT : constant Entity_Id := Packed_Array_Impl_Type (E); begin - if Unknown_Esize (E) then + if not Known_Esize (E) then Set_Esize (E, Esize (PAT)); end if; - if Unknown_RM_Size (E) then + if not Known_RM_Size (E) then Set_RM_Size (E, RM_Size (PAT)); end if; - if Unknown_Alignment (E) then + if not Known_Alignment (E) and then Known_Alignment (PAT) then Set_Alignment (E, Alignment (PAT)); end if; end; @@ -442,13 +446,13 @@ package body Layout is -- gave up because, in this case, the object size is not a multiple -- of the alignment and, therefore, cannot be the component size. - if Ekind (E) = E_Array_Type and then Unknown_Component_Size (E) then + if Ekind (E) = E_Array_Type and then not Known_Component_Size (E) then declare CT : constant Entity_Id := Component_Type (E); begin -- For some reason, access types can cause trouble, So let's - -- just do this for scalar types ??? + -- just do this for scalar types. if Present (CT) and then Is_Scalar_Type (CT) @@ -474,7 +478,7 @@ package body Layout is if Is_Array_Type (E) and then not Is_Packed (E) - and then Unknown_Alignment (E) + and then not Known_Alignment (E) and then Known_Alignment (Component_Type (E)) and then Known_Static_Component_Size (E) and then Known_Static_Esize (Component_Type (E)) @@ -483,6 +487,59 @@ package body Layout is then Set_Alignment (E, Alignment (Component_Type (E))); end if; + + -- If packing was requested, the one-dimensional array is constrained + -- with static bounds, the component size was set explicitly, and + -- the alignment is known, we can set (if not set explicitly) the + -- RM_Size and the Esize of the array type, as RM_Size is equal to + -- (arr'length * arr'component_size) and Esize is the same value + -- rounded to the next multiple of arr'alignment. This is not + -- applicable to packed arrays that are implemented specially + -- in GNAT, i.e. when Packed_Array_Impl_Type is set. + + if Is_Array_Type (E) + and then Present (First_Index (E)) -- Skip types in error + and then Number_Dimensions (E) = 1 + and then not Present (Packed_Array_Impl_Type (E)) + and then Has_Pragma_Pack (E) + and then Is_Constrained (E) + and then Compile_Time_Known_Bounds (E) + and then Known_Component_Size (E) + and then Known_Alignment (E) + then + declare + Abits : constant Int := UI_To_Int (Alignment (E)) * SSU; + Lo, Hi : Node_Id; + Siz : Uint; + + begin + Get_Index_Bounds (First_Index (E), Lo, Hi); + + -- Even if the bounds are known at compile time, they could + -- have been replaced by an error node. Check each bound + -- explicitly. + + if Compile_Time_Known_Value (Lo) + and then Compile_Time_Known_Value (Hi) + then + Siz := (Expr_Value (Hi) - Expr_Value (Lo) + 1) + * Component_Size (E); + + -- Do not overwrite a different value of 'Size specified + -- explicitly by the user. In that case, also do not set + -- Esize. + + if not Known_RM_Size (E) or else RM_Size (E) = Siz then + Set_RM_Size (E, Siz); + + if not Known_Esize (E) then + Siz := ((Siz + (Abits - 1)) / Abits) * Abits; + Set_Esize (E, Siz); + end if; + end if; + end if; + end; + end if; end if; -- Even if the backend performs the layout, we still do a little in @@ -519,7 +576,7 @@ package body Layout is -- arrays when passed to subprogram parameters (see special test -- in Exp_Ch6.Expand_Actuals). - if not Is_Packed (E) and then Unknown_Alignment (E) then + if not Is_Packed (E) and then not Known_Alignment (E) then if Known_Static_Component_Size (E) and then Component_Size (E) = 1 then @@ -691,7 +748,7 @@ package body Layout is if Known_Static_Esize (E) then Siz := Esize (E); - elsif Unknown_Esize (E) and then Known_Static_RM_Size (E) then + elsif not Known_Esize (E) and then Known_Static_RM_Size (E) then Siz := RM_Size (E); else return; @@ -796,7 +853,7 @@ package body Layout is if Calign > Align and then - (Unknown_Esize (Comp) + (not Known_Esize (Comp) or else (Known_Static_Esize (Comp) and then Esize (Comp) = Calign * SSU)) @@ -963,7 +1020,7 @@ package body Layout is -- If alignment is currently not set, then we can safely set it to -- this new calculated value. - if Unknown_Alignment (E) then + if not Known_Alignment (E) then Init_Alignment (E, A); -- Cases where we have inherited an alignment |