[Ada] Include scalar storage order information in -gnatR3 output
Arnaud Charlet
charlet@adacore.com
Fri Apr 12 14:20:00 GMT 2013
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.
-------------- next part --------------
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
More information about the Gcc-patches
mailing list