OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_util.ads (Set_Rep_Info): New inline procedure. 

* sem_util.ads (Set_Rep_Info): New inline procedure.
	* sem_util.adb (Set_Rep_Info): Implement it.
	* sem_ch3.adb (Process_Subtype): If the case of a constraint present,
	always copy the representation aspects onto the subtype.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Only set the TYPE_ALIGN_OK
	and TYPE_BY_REFERENCE_P flags on types after various promotions.
	* gcc-interface/trans.c (node_has_volatile_full_access) <N_Identifier>:
	Consider all kinds of entities.

From-SVN: r251928
This commit is contained in:
Eric Botcazou 2017-09-09 12:06:48 +00:00 committed by Eric Botcazou
parent 753161f615
commit 2d9534b215
9 changed files with 167 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2017-09-09 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.ads (Set_Rep_Info): New inline procedure.
* sem_util.adb (Set_Rep_Info): Implement it.
* sem_ch3.adb (Process_Subtype): If the case of a constraint present,
always copy the representation aspects onto the subtype.
* gcc-interface/decl.c (gnat_to_gnu_entity): Only set the TYPE_ALIGN_OK
and TYPE_BY_REFERENCE_P flags on types after various promotions.
* gcc-interface/trans.c (node_has_volatile_full_access) <N_Identifier>:
Consider all kinds of entities.
2017-09-05 Eric Botcazou <ebotcazou@adacore.com>
PR ada/62235

30
gcc/ada/gcc-interface/decl.c
View File

@ -4508,18 +4508,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
already defined so we cannot pass true for IN_PLACE here. */
process_attributes (&gnu_type, &attr_list, false, gnat_entity);
/* Tell the middle-end that objects of tagged types are guaranteed to
be properly aligned. This is necessary because conversions to the
class-wide type are translated into conversions to the root type,
which can be less aligned than some of its derived types. */
if (Is_Tagged_Type (gnat_entity)
|| Is_Class_Wide_Equivalent_Type (gnat_entity))
TYPE_ALIGN_OK (gnu_type) = 1;
/* Record whether the type is passed by reference. */
if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
TYPE_BY_REFERENCE_P (gnu_type) = 1;
/* ??? Don't set the size for a String_Literal since it is either
confirming or we don't handle it properly (if the low bound is
non-constant). */
@ -4729,17 +4717,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is not an unconstrained array type, set some flags. */
if (TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE)
{
/* Tell the middle-end that objects of tagged types are guaranteed to
be properly aligned. This is necessary because conversions to the
class-wide type are translated into conversions to the root type,
which can be less aligned than some of its derived types. */
if (Is_Tagged_Type (gnat_entity)
|| Is_Class_Wide_Equivalent_Type (gnat_entity))
TYPE_ALIGN_OK (gnu_type) = 1;
/* Record whether the type is passed by reference. */
if (Is_By_Reference_Type (gnat_entity) && !VOID_TYPE_P (gnu_type))
TYPE_BY_REFERENCE_P (gnu_type) = 1;
/* Record whether an alignment clause was specified. */
if (Present (Alignment_Clause (gnat_entity)))
TYPE_USER_ALIGN (gnu_type) = 1;
/* Record whether a pragma Universal_Aliasing was specified. */
if (Universal_Aliasing (gnat_entity) && !TYPE_IS_DUMMY_P (gnu_type))
TYPE_UNIVERSAL_ALIASING_P (gnu_type) = 1;
/* If it is passed by reference, force BLKmode to ensure that
objects of this type will always be put in memory. */
if (TYPE_MODE (gnu_type) != BLKmode
&& AGGREGATE_TYPE_P (gnu_type)
&& TYPE_BY_REFERENCE_P (gnu_type))
if (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
SET_TYPE_MODE (gnu_type, BLKmode);
}

2
gcc/ada/gcc-interface/trans.c
View File

@ -4058,8 +4058,6 @@ node_has_volatile_full_access (Node_Id gnat_node)
case N_Identifier:
case N_Expanded_Name:
gnat_entity = Entity (gnat_node);
if (Ekind (gnat_entity) != E_Variable)
break;
return Is_Volatile_Full_Access (gnat_entity)
|| Is_Volatile_Full_Access (Etype (gnat_entity));

4
gcc/ada/sem_ch3.adb
View File

@ -21211,9 +21211,11 @@ package body Sem_Ch3 is
Error_Msg_N ("invalid subtype mark in subtype indication", S);
end case;
-- Size and Convention are always inherited from the base type
-- Size, Alignment, Representation aspects and Convention are always
-- inherited from the base type.
Set_Size_Info (Def_Id, (Subtype_Mark_Id));
Set_Rep_Info (Def_Id, (Subtype_Mark_Id));
Set_Convention (Def_Id, Convention (Subtype_Mark_Id));
return Def_Id;

14
gcc/ada/sem_util.adb
View File

@ -20302,6 +20302,20 @@ package body Sem_Util is
end if;
end Set_Referenced_Modified;
------------------
-- Set_Rep_Info --
------------------
procedure Set_Rep_Info (T1, T2 : Entity_Id) is
begin
Set_Is_Atomic (T1, Is_Atomic (T2));
Set_Is_Independent (T1, Is_Independent (T2));
Set_Is_Volatile_Full_Access (T1, Is_Volatile_Full_Access (T2));
if Is_Base_Type (T1) then
Set_Is_Volatile (T1, Is_Volatile (T2));
end if;
end Set_Rep_Info;
----------------------------
-- Set_Scope_Is_Transient --
----------------------------

6
gcc/ada/sem_util.ads
View File

@ -2313,6 +2313,12 @@ package Sem_Util is
-- (Referenced_As_LHS if Out_Param is False, Referenced_As_Out_Parameter
-- if Out_Param is True) is set True, and the other flag set False.
procedure Set_Rep_Info (T1, T2 : Entity_Id);
pragma Inline (Set_Rep_Info);
-- Copies the Is_Atomic, Is_Independent and Is_Volatile_Full_Access flags
-- from sub(type) entity T2 to (sub)type entity T1, as well as Is_Volatile
-- if T1 is a base type.
procedure Set_Scope_Is_Transient (V : Boolean := True);
-- Set the flag Is_Transient of the current scope

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-09-09 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/vfa.ads: Rename into...
* gnat.dg/specs/vfa1.ads: ...this.
* gnat.dg/specs/vfa2.ads: New test.
2017-09-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc.dg/pr81988.c: New test.

4
gcc/testsuite/gnat.dg/specs/vfa.ads → gcc/testsuite/gnat.dg/specs/vfa1.ads
View File

@ -1,7 +1,7 @@
-- { dg-do compile }
-- { dg-options "-g" }
package VFA is
package VFA1 is
type Rec is record
A : Short_Integer;
@ -11,4 +11,4 @@ package VFA is
type Rec_VFA is new Rec;
pragma Volatile_Full_Access (Rec_VFA);
end VFA;
end VFA1;

110
gcc/testsuite/gnat.dg/specs/vfa2.ads Normal file
View File

@ -0,0 +1,110 @@
-- { dg-do compile }
-- { dg-options "-O" }
package VFA2 is
type Bit is mod 2**1
with Size => 1;
type UInt2 is mod 2**2
with Size => 2;
type UInt22 is mod 2**22
with Size => 22;
type MODE_ENUM is
(
Function_0_Default,
Function_1,
Function_2,
Function_3,
Function_4,
Function_5,
Function_6,
Function_7)
with Size => 3;
type EPD_ENUM is
(
Disable_Pull_Down,
Enable_Pull_Down)
with Size => 1;
type EPUN_ENUM is
(
Enable_Pull_Up,
Disable_Pull_Up)
with Size => 1;
type EHS_ENUM is
(
Slow_Low_Noise_With,
Fast_Medium_Noise_W)
with Size => 1;
type EZI_ENUM is
(
Disable_Input_Buffer,
Enable_Input_Buffer)
with Size => 1;
type ZIF_ENUM is
(
Enable_Input_Glitch,
Disable_Input_Glitch)
with Size => 1;
type EHD_ENUM is
(
Normal_Drive_4_Ma_D,
Medium_Drive_8_Ma_D,
High_Drive_14_Ma_Dr,
Ultra_High_Drive_20)
with Size => 2;
type Pin_Type is (Normal_Drive, High_Drive, High_Speed);
type SFS_Register(Pin : Pin_Type := Normal_Drive) is record
MODE : MODE_ENUM;
EPD : EPD_ENUM;
EPUN : EPUN_ENUM;
EZI : EZI_ENUM;
ZIF : ZIF_ENUM;
RESERVED : UInt22;
case Pin is
when Normal_Drive =>
ND_EHS_RESERVED : Bit;
ND_EHD_RESERVED : UInt2;
when High_Drive =>
EHD : EHD_ENUM;
HD_EHS_RESERVED : Bit;
when High_Speed =>
EHS : EHS_ENUM;
HS_EHD_RESERVED : UInt2;
end case;
end record
with Unchecked_Union, Size => 32, Volatile_Full_Access;
for SFS_Register use record
MODE at 0 range 0 .. 2;
EPD at 0 range 3 .. 3;
EPUN at 0 range 4 .. 4;
ND_EHS_RESERVED at 0 range 5 .. 5;
HD_EHS_RESERVED at 0 range 5 .. 5;
EHS at 0 range 5 .. 5;
EZI at 0 range 6 .. 6;
ZIF at 0 range 7 .. 7;
ND_EHD_RESERVED at 0 range 8 .. 9;
EHD at 0 range 8 .. 9;
HS_EHD_RESERVED at 0 range 8 .. 9;
RESERVED at 0 range 10 .. 31;
end record;
type Normal_Drive_Pins is array (Integer range <>)
of SFS_Register(Normal_Drive) with Volatile;
end VFA2;