Patchwork [Ada] Fix computation of Bit attribute for bit-packed array references

login
register
mail settings
Submitter Arnaud Charlet
Date June 22, 2010, 10:07 a.m.
Message ID <20100622100726.GA10667@adacore.com>
Download mbox | patch
Permalink /patch/56449/
State New
Headers show

Comments

Arnaud Charlet - June 22, 2010, 10:07 a.m.
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.

Patch

Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 161159)
+++ exp_attr.adb	(working copy)
@@ -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);
Index: exp_pakd.adb
===================================================================
--- exp_pakd.adb	(revision 161073)
+++ exp_pakd.adb	(working copy)
@@ -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 --
    -------------------------------------
Index: exp_pakd.ads
===================================================================
--- exp_pakd.ads	(revision 161073)
+++ exp_pakd.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          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;
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 161132)
+++ exp_ch4.adb	(working copy)
@@ -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