The following compilation must produce the indicated output: $ gcc -gnat05 -c -gnatR3 sso_r3.ads
Representation information for unit SSO_R3 (spec) for A'Size use 64; for A'Alignment use 4; for A'Component_Size use 32; for A'Scalar_Storage_Order use System.High_Order_First; for R'Object_Size use 16; for R'Value_Size use 9; for R'Alignment use 1; for R use record B at 0 range 0 .. 0; C at 0 range 1 .. 8; end record; for R'Bit_Order use System.High_Order_First; for R'Scalar_Storage_Order use System.High_Order_First; with System; package SSO_R3 is type A is array (0 .. 1) of Integer; for A'Scalar_Storage_Order use System.High_Order_First; type R is record B : Boolean; C : Character; end record; for R'Bit_Order use System.High_Order_First; for R'Scalar_Storage_Order use System.High_Order_First; for R use record B at 0 range 0 .. 0; C at 0 range 1 .. 8; end record; end SSO_R3; Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-12 Thomas Quinot <qui...@adacore.com> * gnat1drv.adb, repinfo.adb, repinfo.ads (Repinfo.List_Array_Info, List_Record_Info): Also include scalar storage order information in output.
Index: gnat1drv.adb =================================================================== --- gnat1drv.adb (revision 197899) +++ gnat1drv.adb (working copy) @@ -1259,7 +1259,7 @@ Errout.Finalize (Last_Call => True); Errout.Output_Messages; - List_Rep_Info; + List_Rep_Info (Ttypes.Bytes_Big_Endian); List_Inlining_Info; -- Only write the library if the backend did not generate any error Index: repinfo.adb =================================================================== --- repinfo.adb (revision 197899) +++ repinfo.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2013, 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- -- @@ -29,22 +29,23 @@ -- -- ------------------------------------------------------------------------------ -with Alloc; use Alloc; -with Atree; use Atree; -with Casing; use Casing; -with Debug; use Debug; -with Einfo; use Einfo; -with Lib; use Lib; -with Namet; use Namet; -with Opt; use Opt; -with Output; use Output; -with Sinfo; use Sinfo; -with Sinput; use Sinput; -with Snames; use Snames; -with Stand; use Stand; -with Table; use Table; -with Uname; use Uname; -with Urealp; use Urealp; +with Alloc; use Alloc; +with Atree; use Atree; +with Casing; use Casing; +with Debug; use Debug; +with Einfo; use Einfo; +with Lib; use Lib; +with Namet; use Namet; +with Opt; use Opt; +with Output; use Output; +with Sem_Aux; use Sem_Aux; +with Sinfo; use Sinfo; +with Sinput; use Sinput; +with Snames; use Snames; +with Stand; use Stand; +with Table; use Table; +with Uname; use Uname; +with Urealp; use Urealp; with Ada.Unchecked_Conversion; @@ -133,7 +134,7 @@ -- Called before outputting anything for an entity. Ensures that -- a blank line precedes the output for a particular entity. - procedure List_Entities (Ent : Entity_Id); + procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean); -- This procedure lists the entities associated with the entity E, starting -- with the First_Entity and using the Next_Entity link. If a nested -- package is found, entities within the package are recursively processed. @@ -142,7 +143,7 @@ -- List name of entity Ent in appropriate case. The name is listed with -- full qualification up to but not including the compilation unit name. - procedure List_Array_Info (Ent : Entity_Id); + procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean); -- List representation info for array type Ent procedure List_Mechanisms (Ent : Entity_Id); @@ -152,9 +153,14 @@ procedure List_Object_Info (Ent : Entity_Id); -- List representation info for object Ent - procedure List_Record_Info (Ent : Entity_Id); + procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean); -- List representation info for record type Ent + procedure List_Scalar_Storage_Order + (Ent : Entity_Id; + Bytes_Big_Endian : Boolean); + -- List scalar storage order information for record or array type Ent + procedure List_Type_Info (Ent : Entity_Id); -- List type info for type Ent @@ -286,7 +292,7 @@ -- List_Array_Info -- ---------------------- - procedure List_Array_Info (Ent : Entity_Id) is + procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is begin List_Type_Info (Ent); Write_Str ("for "); @@ -294,13 +300,15 @@ Write_Str ("'Component_Size use "); Write_Val (Component_Size (Ent)); Write_Line (";"); + + List_Scalar_Storage_Order (Ent, Bytes_Big_Endian); end List_Array_Info; ------------------- -- List_Entities -- ------------------- - procedure List_Entities (Ent : Entity_Id) is + procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is Body_E : Entity_Id; E : Entity_Id; @@ -379,12 +387,12 @@ elsif Is_Record_Type (E) then if List_Representation_Info >= 1 then - List_Record_Info (E); + List_Record_Info (E, Bytes_Big_Endian); end if; elsif Is_Array_Type (E) then if List_Representation_Info >= 1 then - List_Array_Info (E); + List_Array_Info (E, Bytes_Big_Endian); end if; elsif Is_Type (E) then @@ -411,7 +419,7 @@ if Ekind (E) = E_Package then if No (Renamed_Object (E)) then - List_Entities (E); + List_Entities (E, Bytes_Big_Endian); end if; -- Recurse into bodies @@ -428,12 +436,12 @@ or else Ekind (E) = E_Protected_Body then - List_Entities (E); + List_Entities (E, Bytes_Big_Endian); -- Recurse into blocks elsif Ekind (E) = E_Block then - List_Entities (E); + List_Entities (E, Bytes_Big_Endian); end if; end if; @@ -461,7 +469,7 @@ and then Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit then - List_Entities (Body_E); + List_Entities (Body_E, Bytes_Big_Endian); end if; end if; @@ -779,7 +787,7 @@ -- List_Record_Info -- ---------------------- - procedure List_Record_Info (Ent : Entity_Id) is + procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is Comp : Entity_Id; Cfbit : Uint; Sunit : Uint; @@ -963,13 +971,15 @@ end loop; Write_Line ("end record;"); + + List_Scalar_Storage_Order (Ent, Bytes_Big_Endian); end List_Record_Info; ------------------- -- List_Rep_Info -- ------------------- - procedure List_Rep_Info is + procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is Col : Nat; begin @@ -994,7 +1004,7 @@ end loop; Write_Eol; - List_Entities (Cunit_Entity (U)); + List_Entities (Cunit_Entity (U), Bytes_Big_Endian); -- List representation information to file @@ -1002,7 +1012,7 @@ Create_Repinfo_File_Access.all (Get_Name_String (File_Name (Source_Index (U)))); Set_Special_Output (Write_Info_Line'Access); - List_Entities (Cunit_Entity (U)); + List_Entities (Cunit_Entity (U), Bytes_Big_Endian); Set_Special_Output (null); Close_Repinfo_File_Access.all; end if; @@ -1011,6 +1021,49 @@ end if; end List_Rep_Info; + ------------------------------- + -- List_Scalar_Storage_Order -- + ------------------------------- + + procedure List_Scalar_Storage_Order + (Ent : Entity_Id; + Bytes_Big_Endian : Boolean) + is + procedure List_Attr (Attr_Name : String); + -- Show attribute definition clause for Attr_Name + + --------------- + -- List_Attr -- + --------------- + + procedure List_Attr (Attr_Name : String) is + begin + Write_Str ("for "); + List_Name (Ent); + Write_Str ("'" & Attr_Name & " use System."); + if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then + Write_Str ("High"); + else + Write_Str ("Low"); + end if; + Write_Line ("_Order_First;"); + end List_Attr; + + -- Start of processing for List_Scalar_Storage_Order + + begin + if Has_Rep_Item (Ent, Name_Scalar_Storage_Order) then + + -- For a record type with explicitly specified scalar storage order, + -- also display explicit Bit_Order. + + if Is_Record_Type (Ent) then + List_Attr ("Bit_Order"); + end if; + List_Attr ("Scalar_Storage_Order"); + end if; + end List_Scalar_Storage_Order; + -------------------- -- List_Type_Info -- -------------------- Index: repinfo.ads =================================================================== --- repinfo.ads (revision 197899) +++ repinfo.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2013, 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- -- @@ -283,8 +283,9 @@ -- Compiler Interface -- ------------------------ - procedure List_Rep_Info; - -- Procedure to list representation information + procedure List_Rep_Info (Bytes_Big_Endian : Boolean); + -- Procedure to list representation information. Bytes_Big_Endian is the + -- value from Ttypes (Repinfo cannot have a dependency on Ttypes). procedure Tree_Write; -- Writes out internal tables to current tree file using the relevant