Patchwork [Ada] Include scalar storage order information in -gnatR3 output

login
register
mail settings
Submitter Arnaud Charlet
Date April 12, 2013, 1:08 p.m.
Message ID <20130412130857.GA22312@adacore.com>
Download mbox | patch
Permalink /patch/236084/
State New
Headers show

Comments

Arnaud Charlet - April 12, 2013, 1:08 p.m.
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  <quinot@adacore.com>

	* gnat1drv.adb, repinfo.adb, repinfo.ads (Repinfo.List_Array_Info,
	List_Record_Info): Also include scalar storage order information in
	output.

Patch

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