===================================================================
@@ -1206,6 +1206,20 @@ package body Exp_Attr is
Analyze_And_Resolve (N, RTE (RE_AST_Handler));
end AST_Entry;
+ ---------
+ -- Bit --
+ ---------
+
+ -- We compute this if a packed array reference was present, otherwise we
+ -- leave the computation up to the back end.
+
+ when Attribute_Bit =>
+ if Involves_Packed_Array_Reference (Pref) then
+ Expand_Packed_Bit_Reference (N);
+ else
+ Apply_Universal_Integer_Attribute_Checks (N);
+ end if;
+
------------------
-- Bit_Position --
------------------
@@ -1218,8 +1232,7 @@ package body Exp_Attr is
-- in generated code (i.e. the prefix is an identifier that
-- references the component or discriminant entity).
- when Attribute_Bit_Position => Bit_Position :
- declare
+ when Attribute_Bit_Position => Bit_Position : declare
CE : Entity_Id;
begin
@@ -3232,9 +3245,9 @@ package body Exp_Attr is
-- For enumeration types with a standard representation, Pos is
-- handled by the back end.
- -- For enumeration types, with a non-standard representation we
- -- generate a call to the _Rep_To_Pos function created when the
- -- type was frozen. The call has the form
+ -- For enumeration types, with a non-standard representation we generate
+ -- a call to the _Rep_To_Pos function created when the type was frozen.
+ -- The call has the form
-- _rep_to_pos (expr, flag)
@@ -3541,6 +3554,7 @@ package body Exp_Attr is
------------------
when Attribute_Range_Length => Range_Length : begin
+
-- The only special processing required is for the case where
-- Range_Length is applied to an enumeration type with holes.
-- In this case we transform
@@ -4257,8 +4271,7 @@ package body Exp_Attr is
-- 2. For floating-point, generate call to attribute function
-- 3. For other cases, deal with constraint checking
- when Attribute_Succ => Succ :
- declare
+ when Attribute_Succ => Succ : declare
Etyp : constant Entity_Id := Base_Type (Ptyp);
begin
@@ -4350,8 +4363,7 @@ package body Exp_Attr is
-- Transforms X'Tag into a direct reference to the tag of X
- when Attribute_Tag => Tag :
- declare
+ when Attribute_Tag => Tag : declare
Ttyp : Entity_Id;
Prefix_Is_Type : Boolean;
@@ -4598,8 +4610,7 @@ package body Exp_Attr is
-- with a non-standard representation we use the _Pos_To_Rep array that
-- was created when the type was frozen.
- when Attribute_Val => Val :
- declare
+ when Attribute_Val => Val : declare
Etyp : constant Entity_Id := Base_Type (Entity (Pref));
begin
@@ -4662,8 +4673,7 @@ package body Exp_Attr is
-- The code for valid is dependent on the particular types involved.
-- See separate sections below for the generated code in each case.
- when Attribute_Valid => Valid :
- declare
+ when Attribute_Valid => Valid : declare
Btyp : Entity_Id := Base_Type (Ptyp);
Tst : Node_Id;
@@ -5267,7 +5277,6 @@ package body Exp_Attr is
-- that the result is in range.
when Attribute_Aft |
- Attribute_Bit |
Attribute_Max_Size_In_Storage_Elements
=>
Apply_Universal_Integer_Attribute_Checks (N);
===================================================================
@@ -455,6 +455,15 @@ package body Exp_Pakd is
-- expression whose type is the implementation type used to represent
-- the packed array. Aexp is analyzed and resolved on entry and on exit.
+ procedure Get_Base_And_Bit_Offset
+ (N : Node_Id;
+ Base : out Node_Id;
+ Offset : out Node_Id);
+ -- Given a node N for a name which involves a packed array reference,
+ -- return the base object of the reference and build an expression of
+ -- type Standard.Integer representing the zero-based offset in bits
+ -- from Base'Address to the first bit of the reference.
+
function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
-- There are two versions of the Set routines, the ones used when the
-- object is known to be sufficiently well aligned given the number of
@@ -1663,18 +1672,11 @@ package body Exp_Pakd is
procedure Expand_Packed_Address_Reference (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Ploc : Source_Ptr;
- Pref : Node_Id;
- Expr : Node_Id;
- Term : Node_Id;
- Atyp : Entity_Id;
- Subscr : Node_Id;
+ Base : Node_Id;
+ Offset : Node_Id;
begin
- Pref := Prefix (N);
- Expr := Empty;
-
- -- We build up an expression serially that has the form
+ -- We build an expression that has the form
-- outer_object'Address
-- + (linear-subscript * component_size for each array reference
@@ -1682,49 +1684,7 @@ package body Exp_Pakd is
-- + ...
-- + ...) / Storage_Unit;
- -- Some additional conversions are required to deal with the addition
- -- operation, which is not normally visible to generated code.
-
- loop
- Ploc := Sloc (Pref);
-
- if Nkind (Pref) = N_Indexed_Component then
- Convert_To_Actual_Subtype (Prefix (Pref));
- Atyp := Etype (Prefix (Pref));
- Compute_Linear_Subscript (Atyp, Pref, Subscr);
-
- Term :=
- Make_Op_Multiply (Ploc,
- Left_Opnd => Subscr,
- Right_Opnd =>
- Make_Attribute_Reference (Ploc,
- Prefix => New_Occurrence_Of (Atyp, Ploc),
- Attribute_Name => Name_Component_Size));
-
- elsif Nkind (Pref) = N_Selected_Component then
- Term :=
- Make_Attribute_Reference (Ploc,
- Prefix => Selector_Name (Pref),
- Attribute_Name => Name_Bit_Position);
-
- else
- exit;
- end if;
-
- Term := Convert_To (RTE (RE_Integer_Address), Term);
-
- if No (Expr) then
- Expr := Term;
-
- else
- Expr :=
- Make_Op_Add (Ploc,
- Left_Opnd => Expr,
- Right_Opnd => Term);
- end if;
-
- Pref := Prefix (Pref);
- end loop;
+ Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
Rewrite (N,
Unchecked_Convert_To (RTE (RE_Address),
@@ -1732,18 +1692,47 @@ package body Exp_Pakd is
Left_Opnd =>
Unchecked_Convert_To (RTE (RE_Integer_Address),
Make_Attribute_Reference (Loc,
- Prefix => Pref,
+ Prefix => Base,
Attribute_Name => Name_Address)),
Right_Opnd =>
- Make_Op_Divide (Loc,
- Left_Opnd => Expr,
- Right_Opnd =>
- Make_Integer_Literal (Loc, System_Storage_Unit)))));
+ Unchecked_Convert_To (RTE (RE_Integer_Address),
+ Make_Op_Divide (Loc,
+ Left_Opnd => Offset,
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, System_Storage_Unit))))));
Analyze_And_Resolve (N, RTE (RE_Address));
end Expand_Packed_Address_Reference;
+ ---------------------------------
+ -- Expand_Packed_Bit_Reference --
+ ---------------------------------
+
+ procedure Expand_Packed_Bit_Reference (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+ Base : Node_Id;
+ Offset : Node_Id;
+
+ begin
+ -- We build an expression that has the form
+
+ -- (linear-subscript * component_size for each array reference
+ -- + field'Bit_Position for each record field
+ -- + ...
+ -- + ...) mod Storage_Unit;
+
+ Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
+
+ Rewrite (N,
+ Unchecked_Convert_To (Universal_Integer,
+ Make_Op_Mod (Loc,
+ Left_Opnd => Offset,
+ Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
+
+ Analyze_And_Resolve (N, Universal_Integer);
+ end Expand_Packed_Bit_Reference;
+
------------------------------------
-- Expand_Packed_Boolean_Operator --
------------------------------------
@@ -2229,6 +2218,70 @@ package body Exp_Pakd is
end Expand_Packed_Not;
+ -----------------------------
+ -- Get_Base_And_Bit_Offset --
+ -----------------------------
+
+ procedure Get_Base_And_Bit_Offset
+ (N : Node_Id;
+ Base : out Node_Id;
+ Offset : out Node_Id)
+ is
+ Loc : Source_Ptr;
+ Term : Node_Id;
+ Atyp : Entity_Id;
+ Subscr : Node_Id;
+
+ begin
+ Base := N;
+ Offset := Empty;
+
+ -- We build up an expression serially that has the form
+
+ -- linear-subscript * component_size for each array reference
+ -- + field'Bit_Position for each record field
+ -- + ...
+
+ loop
+ Loc := Sloc (Base);
+
+ if Nkind (Base) = N_Indexed_Component then
+ Convert_To_Actual_Subtype (Prefix (Base));
+ Atyp := Etype (Prefix (Base));
+ Compute_Linear_Subscript (Atyp, Base, Subscr);
+
+ Term :=
+ Make_Op_Multiply (Loc,
+ Left_Opnd => Subscr,
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Atyp, Loc),
+ Attribute_Name => Name_Component_Size));
+
+ elsif Nkind (Base) = N_Selected_Component then
+ Term :=
+ Make_Attribute_Reference (Loc,
+ Prefix => Selector_Name (Base),
+ Attribute_Name => Name_Bit_Position);
+
+ else
+ return;
+ end if;
+
+ if No (Offset) then
+ Offset := Term;
+
+ else
+ Offset :=
+ Make_Op_Add (Loc,
+ Left_Opnd => Offset,
+ Right_Opnd => Term);
+ end if;
+
+ Base := Prefix (Base);
+ end loop;
+ end Get_Base_And_Bit_Offset;
+
-------------------------------------
-- Involves_Packed_Array_Reference --
-------------------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, 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- --
@@ -272,4 +272,9 @@ package Exp_Pakd is
-- the prefix involves a packed array reference. This routine expands the
-- necessary code for performing the address reference in this case.
+ procedure Expand_Packed_Bit_Reference (N : Node_Id);
+ -- The node N is an attribute reference for the 'Bit reference, where the
+ -- prefix involves a packed array reference. This routine expands the
+ -- necessary code for performing the bit reference in this case.
+
end Exp_Pakd;
===================================================================
@@ -4883,7 +4883,7 @@ package body Exp_Ch4 is
-- The second expression in a 'Read attribute reference
- -- The prefix of an address or size attribute reference
+ -- The prefix of an address or bit or size attribute reference
-- The following circuit detects these exceptions
@@ -4907,6 +4907,8 @@ package body Exp_Ch4 is
elsif Nkind (Parnt) = N_Attribute_Reference
and then (Attribute_Name (Parnt) = Name_Address
or else
+ Attribute_Name (Parnt) = Name_Bit
+ or else
Attribute_Name (Parnt) = Name_Size)
and then Prefix (Parnt) = Child
then
The Bit attribute is a GNAT-specific attribute which yields the bit offset within the byte that contains the first bit of storage allocated for the object to which it is applied. However, it was returning 0 for bit-packed array references. The fix is to extend the special handling of bit-packed array references already implemented for the Address attribute. That's quite natural since this pair of attributes can be seen as a (/,mod) pair for addresses. The following program must run quietly: with System; use System; procedure Bit_Attribute is type Bits is array (1..8) of Boolean; pragma Pack (Bits); My_Bits : Bits := (Others => False); pragma Volatile (My_Bits); type Rec is record A : Boolean; B : Bits; end record; pragma Pack (Rec); My_Rec : Rec := (A => False, B => (Others => False)); pragma Volatile (My_Rec); A : Address; N : Natural; begin A := My_Bits(3)'Address; if A /= My_Bits'Address then raise Program_Error; end if; N := My_Bits(3)'Bit; if N /= 2 then raise Program_Error; end if; A := My_Rec.B(3)'Address; if A /= My_Rec'Address then raise Program_Error; end if; N := My_Rec.B(3)'Bit; if N /= 3 then raise Program_Error; end if; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Eric Botcazou <ebotcazou@adacore.com> * exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Bit>: Deal with packed array references specially. * exp_ch4.adb (Expand_N_Indexed_Component): Do not convert a reference to a component of a bit packed array if it is the prefix of 'Bit. * exp_pakd.ads (Expand_Packed_Bit_Reference): Declare. * exp_pakd.adb (Expand_Packed_Bit_Reference): New procedure. Expand a 'Bit reference, where the prefix involves a packed array reference. (Get_Base_And_Bit_Offset): New helper, extracted from... (Expand_Packed_Address_Reference): ...here. Call above procedure to get the outer object and offset expression.