[Ada] Front-end support for attribute Scalar_Storage_Order

Message ID	20120309145513.GA6163@adacore.com
State	New
Headers	show Return-Path: <gcc-patches-return-314566-incoming=patchwork.ozlabs.org@gcc.gnu.org> Comment: DKIM? See http://www.dkim.org Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=SNwyQBgd5XH/df76AlF59kDS6bdRZh+6GPZ/JKazCzV3HWW/UUbmcoZzRR9jAm C5Bn+DljKcM1XD0pZ7SEiiyL1R5BaYMJFmxYy4ARYxLV5WaJxmG0/IR2s5EIperw hmkNvs/h0uTgMYLpbZ0XAeOnPpZMagnWWcwTeqJmLtP28=; Date: Fri, 9 Mar 2012 09:55:13 -0500 From: Arnaud Charlet <charlet@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot <quinot@adacore.com> Subject: [Ada] Front-end support for attribute Scalar_Storage_Order Message-ID: <20120309145513.GA6163@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="liOOAslEiF7prFVr" Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org

Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 185136) +++ exp_attr.adb (working copy) @@ -5672,7 +5672,8 @@ Attribute_Definite | Attribute_Null_Parameter | Attribute_Passed_By_Reference | - Attribute_Pool_Address => + Attribute_Pool_Address | + Attribute_Scalar_Storage_Order => null; -- The following attributes are also handled by the back end, but return Index: freeze.adb =================================================================== --- freeze.adb (revision 185136) +++ freeze.adb (working copy) @@ -2129,6 +2129,28 @@ Next_Entity (Comp); end loop; + -- Check compatibility of Scalar_Storage_Order with Bit_Order, if the + -- former is specified. + + ADC := Get_Attribute_Definition_Clause + (Rec, Attribute_Scalar_Storage_Order); + + if Present (ADC) + and then + Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec) + then + if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then + Error_Msg_N + ("Scalar_Storage_Order High_Order_First is inconsistent with" + & " Bit_Order", ADC); + else + Error_Msg_N + ("Scalar_Storage_Order Low_Order_First is inconsistent with" + & " Bit_Order", ADC); + + end if; + end if; + -- Deal with Bit_Order aspect specifying a non-default bit order if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 185136) +++ sem_attr.adb (working copy) @@ -4442,6 +4442,35 @@ Check_Object_Reference (E1); Set_Etype (N, Standard_Boolean); + -------------------------- + -- Scalar_Storage_Order -- + -------------------------- + + when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : + begin + Check_E0; + Check_Type; + + if not Is_Record_Type (P_Type) then + Error_Attr_P ("prefix of % attribute must be record type"); + end if; + + if Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then + Rewrite (N, + New_Occurrence_Of (RTE (RE_High_Order_First), Loc)); + else + Rewrite (N, + New_Occurrence_Of (RTE (RE_Low_Order_First), Loc)); + end if; + + Set_Etype (N, RTE (RE_Bit_Order)); + Resolve (N); + + -- Reset incorrect indication of staticness + + Set_Is_Static_Expression (N, False); + end Scalar_Storage_Order; + ----------- -- Scale -- ----------- @@ -7963,6 +7992,7 @@ Attribute_Priority | Attribute_Read | Attribute_Result | + Attribute_Scalar_Storage_Order | Attribute_Simple_Storage_Pool | Attribute_Storage_Pool | Attribute_Storage_Size | Index: aspects.adb =================================================================== --- aspects.adb (revision 185136) +++ aspects.adb (working copy) @@ -278,6 +278,7 @@ Aspect_Pure_12 => Aspect_Pure_12, Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface, Aspect_Remote_Types => Aspect_Remote_Types, + Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order, Aspect_Shared_Passive => Aspect_Shared_Passive, Aspect_Universal_Data => Aspect_Universal_Data, Aspect_Input => Aspect_Input, Index: aspects.ads =================================================================== --- aspects.ads (revision 185136) +++ aspects.ads (working copy) @@ -74,6 +74,7 @@ Aspect_Predicate, -- GNAT Aspect_Priority, Aspect_Read, + Aspect_Scalar_Storage_Order, -- GNAT Aspect_Simple_Storage_Pool, -- GNAT Aspect_Size, Aspect_Small, @@ -188,6 +189,7 @@ Aspect_Pure_Function => True, Aspect_Remote_Access_Type => True, Aspect_Shared => True, + Aspect_Scalar_Storage_Order => True, Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, Aspect_Suppress_Debug_Info => True, @@ -281,6 +283,7 @@ Aspect_Predicate => Expression, Aspect_Priority => Expression, Aspect_Read => Name, + Aspect_Scalar_Storage_Order => Expression, Aspect_Simple_Storage_Pool => Name, Aspect_Size => Expression, Aspect_Small => Expression, @@ -367,6 +370,7 @@ Aspect_Remote_Access_Type => Name_Remote_Access_Type, Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, Aspect_Remote_Types => Name_Remote_Types, + Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order, Aspect_Shared => Name_Shared, Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 185136) +++ sem_ch13.adb (working copy) @@ -1064,24 +1064,25 @@ -- Aspects corresponding to attribute definition clauses - when Aspect_Address | - Aspect_Alignment | - Aspect_Bit_Order | - Aspect_Component_Size | - Aspect_External_Tag | - Aspect_Input | - Aspect_Machine_Radix | - Aspect_Object_Size | - Aspect_Output | - Aspect_Read | - Aspect_Size | - Aspect_Small | - Aspect_Simple_Storage_Pool | - Aspect_Storage_Pool | - Aspect_Storage_Size | - Aspect_Stream_Size | - Aspect_Value_Size | - Aspect_Write => + when Aspect_Address | + Aspect_Alignment | + Aspect_Bit_Order | + Aspect_Component_Size | + Aspect_External_Tag | + Aspect_Input | + Aspect_Machine_Radix | + Aspect_Object_Size | + Aspect_Output | + Aspect_Read | + Aspect_Scalar_Storage_Order | + Aspect_Size | + Aspect_Small | + Aspect_Simple_Storage_Pool | + Aspect_Storage_Pool | + Aspect_Storage_Size | + Aspect_Stream_Size | + Aspect_Value_Size | + Aspect_Write => -- Construct the attribute definition clause @@ -2989,6 +2990,40 @@ Analyze_Stream_TSS_Definition (TSS_Stream_Read); Set_Has_Specified_Stream_Read (Ent); + -------------------------- + -- Scalar_Storage_Order -- + -------------------------- + + -- Scalar_Storage_Order attribute definition clause + + when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : declare + begin + if not Is_Record_Type (U_Ent) then + Error_Msg_N + ("Scalar_Storage_Order can only be defined for record type", + Nam); + + elsif Duplicate_Clause then + null; + + else + Analyze_And_Resolve (Expr, RTE (RE_Bit_Order)); + + if Etype (Expr) = Any_Type then + return; + + elsif not Is_Static_Expression (Expr) then + Flag_Non_Static_Expr + ("Scalar_Storage_Order requires static expression!", Expr); + + else + if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then + Set_Reverse_Storage_Order (U_Ent, True); + end if; + end if; + end if; + end Scalar_Storage_Order; + ---------- -- Size -- ---------- @@ -6147,7 +6182,7 @@ when Aspect_Address => T := RTE (RE_Address); - when Aspect_Bit_Order => + when Aspect_Bit_Order | Aspect_Scalar_Storage_Order => T := RTE (RE_Bit_Order); when Aspect_CPU => Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 185136) +++ snames.ads-tmpl (working copy) @@ -120,7 +120,7 @@ Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y'); Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z'); - -- Note: the following table is read by the utility program XSNAMES and + -- Note: the following table is read by the utility program XSNAMES, and -- its format should not be changed without coordinating with this program. N : constant Name_Id := First_Name_Id + 256; @@ -826,6 +826,7 @@ Name_Safe_Last : constant Name_Id := N + $; Name_Safe_Small : constant Name_Id := N + $; -- Ada 83 Name_Same_Storage : constant Name_Id := N + $; -- Ada 12 + Name_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT Name_Scale : constant Name_Id := N + $; Name_Scaling : constant Name_Id := N + $; Name_Signed_Zeros : constant Name_Id := N + $; @@ -1387,6 +1388,7 @@ Attribute_Safe_Last, Attribute_Safe_Small, Attribute_Same_Storage, + Attribute_Scalar_Storage_Order, Attribute_Scale, Attribute_Scaling, Attribute_Signed_Zeros,

[Ada] Front-end support for attribute Scalar_Storage_Order

Commit Message

Patch