diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-22 10:07:05 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-06-22 10:07:05 +0000 |
commit | 5c182b3b24203d60a0f19de61f9c653ce1cf8abc (patch) | |
tree | 817abe2e078de21d449193162217e6853732d04c /gcc/ada/exp_pakd.adb | |
parent | 36dccb2bbbe74a99cf34791744751dbfba656ee2 (diff) | |
download | ppe42-gcc-5c182b3b24203d60a0f19de61f9c653ce1cf8abc.tar.gz ppe42-gcc-5c182b3b24203d60a0f19de61f9c653ce1cf8abc.zip |
2010-06-22 Robert Dewar <dewar@adacore.com>
* lib-writ.ads, errout.adb, einfo.adb, einfo.ads: Minor reformatting.
2010-06-22 Vincent Celier <celier@adacore.com>
* adaint.c (__gnat_locate_regular_file): If a directory in the path is
empty, make it the current working directory.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): When deriving a tagged
private type with discriminants, make sure the parent type is frozen.
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161160 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_pakd.adb')
-rw-r--r-- | gcc/ada/exp_pakd.adb | 169 |
1 files changed, 111 insertions, 58 deletions
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index bf41756c9a1..be4669ce9b8 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -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 -- ------------------------------------- |