From patchwork Tue Jun 22 10:07:26 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56449 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 4B347B6F06 for ; Tue, 22 Jun 2010 20:07:45 +1000 (EST) Received: (qmail 18744 invoked by alias); 22 Jun 2010 10:07:41 -0000 Received: (qmail 18708 invoked by uid 22791); 22 Jun 2010 10:07:36 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_FILL_THIS_FORM_SHORT, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 22 Jun 2010 10:07:27 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id DD308CB029C; Tue, 22 Jun 2010 12:07:26 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id i8U2et-ikgOx; Tue, 22 Jun 2010 12:07:26 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id CA4B2CB027F; Tue, 22 Jun 2010 12:07:26 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id BE0EBD9B31; Tue, 22 Jun 2010 12:07:26 +0200 (CEST) Date: Tue, 22 Jun 2010 12:07:26 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix computation of Bit attribute for bit-packed array references Message-ID: <20100622100726.GA10667@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * exp_attr.adb (Expand_N_Attribute_Reference) : 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. 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