This adds a new variant to the -gnatR switch, namely -gnatRj, which causes
the compiler to output representation information to a file in the JSON
data interchange format. It can be combined with -gnatR0/1/2/3/m (but is
incompatible with -gnaRe and -gnatRs).
The information output in this mode is a superset of that output in the
traditional -gnatR mode, but is otherwise equivalent for the common part.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-29 Eric Botcazou <ebotca...@adacore.com>
gcc/ada/
* doc/gnat_ugn/building_executable_programs_with_gnat.rst (Alphabetical
List of All Switches): Document -gnatRj.
(Debugging Control): Likewise.
* gnat_ugn.texi: Regenerate.
* opt.ads (List_Representation_Info_To_JSON): New boolean variable.
* osint-c.adb (Create_Repinfo_File): Use the .json instead of .rep
extension if List_Representation_Info_To_JSON is true.
* repinfo.ads: Document the JSON output format.
* repinfo.adb (List_Location): New procedure.
(List_Array_Info): Add support for JSON output.
(List_Entities): Likewise.
(Unop): Likewise.
(Binop): Likewise.
(Print_Expr): Likewise.
(List_Linker_Section): Likewise.
(List_Mechanisms): Likewise.
(List_Name): Likewise.
(List_Object_Info): Likewise.
(List_Record_Info): Likewise.
(List_Component_Layout): Likewise. Add Indent parameter.
(List_Structural_Record_Layout): New procedure.
(List_Attr): Add support for JSON output.
(List_Type_Info): Likewise.
(Write_Unknown_Val): Likewise.
* switch-c.adb (Scan_Front_End_Switches) <R>: Deal with 'j'.
* usage.adb (Usage): List -gnatRj.--- gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -2024,7 +2024,7 @@ Alphabetical List of All Switches
.. index:: -gnatR (gcc)
-:switch:`-gnatR[0/1/2/3][e][m][s]`
+:switch:`-gnatR[0|1|2|3][e][j][m][s]`
Output representation information for declared types, objects and
subprograms. Note that this switch is not allowed if a previous
:switch:`-gnatD` switch has been given, since these two switches
@@ -5786,7 +5786,7 @@ Debugging Control
.. index:: -gnatR (gcc)
-:switch:`-gnatR[0|1|2|3][e][m][s]`
+:switch:`-gnatR[0|1|2|3][e][j][m][s]`
This switch controls output from the compiler of a listing showing
representation information for declared types, objects and subprograms.
For :switch:`-gnatR0`, no information is output (equivalent to omitting
@@ -5817,6 +5817,13 @@ Debugging Control
the output is to a file with the name :file:`file.rep` where file is
the name of the corresponding source file.
+ If the switch is followed by a ``j`` (e.g., :switch:`-gnatR3j`), then
+ the output is to a file with the name :file:`file.json` where file is
+ the name of the corresponding source file, and it uses the JSON data
+ interchange format specified by the ECMA-404 standard. The semantic
+ description of this JSON output is available in the specification of
+ the Repinfo unit present in the compiler sources.
+
Note that it is possible for record components to have zero size. In
this case, the component clause uses an obvious extension of permitted
Ada syntax, for example ``at 0 range 0 .. -1``.
--- gcc/ada/gnat_ugn.texi
+++ gcc/ada/gnat_ugn.texi
@@ -9898,7 +9898,7 @@ Treat pragma Restrictions as Restriction_Warnings.
@table @asis
-@item @code{-gnatR[0/1/2/3][e][m][s]}
+@item @code{-gnatR[0|1|2|3][e][j][m][s]}
Output representation information for declared types, objects and
subprograms. Note that this switch is not allowed if a previous
@@ -15013,7 +15013,7 @@ restriction warnings rather than restrictions.
@table @asis
-@item @code{-gnatR[0|1|2|3][e][m][s]}
+@item @code{-gnatR[0|1|2|3][e][j][m][s]}
This switch controls output from the compiler of a listing showing
representation information for declared types, objects and subprograms.
@@ -15045,6 +15045,13 @@ If the switch is followed by an @code{s} (e.g., @code{-gnatR3s}), then
the output is to a file with the name @code{file.rep} where file is
the name of the corresponding source file.
+If the switch is followed by a @code{j} (e.g., @code{-gnatR3j}), then
+the output is to a file with the name @code{file.json} where file is
+the name of the corresponding source file, and it uses the JSON data
+interchange format specified by the ECMA-404 standard. The semantic
+description of this JSON output is available in the specification of
+the Repinfo unit present in the compiler sources.
+
Note that it is possible for record components to have zero size. In
this case, the component clause uses an obvious extension of permitted
Ada syntax, for example @code{at 0 range 0 .. -1}.
--- gcc/ada/opt.ads
+++ gcc/ada/opt.ads
@@ -1003,6 +1003,12 @@ package Opt is
-- of stdout. For example, if file x.adb is compiled using -gnatR2s then
-- representation info is written to x.adb.ref.
+ List_Representation_Info_To_JSON : Boolean := False;
+ -- GNAT
+ -- Set true by -gnatRj switch. Causes information from -gnatR/1/2/3/m to be
+ -- written to file.json (where file is the name of the source file) in the
+ -- JSON data interchange format.
+
List_Representation_Info_Mechanisms : Boolean := False;
-- GNAT
-- Set true by -gnatRm switch. Causes information on mechanisms to be
--- gcc/ada/osint-c.adb
+++ gcc/ada/osint-c.adb
@@ -273,8 +273,11 @@ package body Osint.C is
begin
Name_Buffer (1 .. Src'Length) := Src;
Name_Len := Src'Length;
- Discard := Create_Auxiliary_File (Name_Find, "rep");
- return;
+ if List_Representation_Info_To_JSON then
+ Discard := Create_Auxiliary_File (Name_Find, "json");
+ else
+ Discard := Create_Auxiliary_File (Name_Find, "rep");
+ end if;
end Create_Repinfo_File;
---------------------------
--- gcc/ada/repinfo.adb
+++ gcc/ada/repinfo.adb
@@ -153,6 +153,9 @@ package body Repinfo is
-- List linker section for Ent (caller has checked that Ent is an entity
-- for which the Linker_Section_Pragma field is defined).
+ procedure List_Location (Ent : Entity_Id);
+ -- List location information for Ent
+
procedure List_Mechanisms (Ent : Entity_Id);
-- List mechanism information for parameters of Ent, which is subprogram,
-- subprogram type, or an entry or entry family.
@@ -306,17 +309,33 @@ package body Repinfo is
procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
begin
Blank_Line;
+
+ if List_Representation_Info_To_JSON then
+ Write_Line ("{");
+ end if;
+
List_Type_Info (Ent);
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Component_Size use ");
- Write_Val (Component_Size (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""Component_Size"": ");
+ Write_Val (Component_Size (Ent));
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Component_Size use ");
+ Write_Val (Component_Size (Ent));
+ Write_Line (";");
+ end if;
List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
List_Linker_Section (Ent);
+
+ if List_Representation_Info_To_JSON then
+ Write_Eol;
+ Write_Line ("}");
+ end if;
end List_Array_Info;
-------------------
@@ -428,8 +447,15 @@ package body Repinfo is
elsif Is_Type (E) then
if List_Representation_Info >= 2 then
Blank_Line;
+ if List_Representation_Info_To_JSON then
+ Write_Line ("{");
+ end if;
List_Type_Info (E);
List_Linker_Section (E);
+ if List_Representation_Info_To_JSON then
+ Write_Eol;
+ Write_Line ("}");
+ end if;
end if;
elsif Ekind_In (E, E_Variable, E_Constant) then
@@ -537,8 +563,20 @@ package body Repinfo is
procedure Unop (S : String) is
begin
- Write_Str (S);
- Print_Expr (Node.Op1);
+ if List_Representation_Info_To_JSON then
+ Write_Str ("{ ""code"": """);
+ if S (S'Last) = ' ' then
+ Write_Str (S (S'First .. S'Last - 1));
+ else
+ Write_Str (S);
+ end if;
+ Write_Str (""", ""operands"": [ ");
+ Print_Expr (Node.Op1);
+ Write_Str (" ] }");
+ else
+ Write_Str (S);
+ Print_Expr (Node.Op1);
+ end if;
end Unop;
-----------
@@ -547,11 +585,21 @@ package body Repinfo is
procedure Binop (S : String) is
begin
- Write_Char ('(');
- Print_Expr (Node.Op1);
- Write_Str (S);
- Print_Expr (Node.Op2);
- Write_Char (')');
+ if List_Representation_Info_To_JSON then
+ Write_Str ("{ ""code"": """);
+ Write_Str (S (S'First + 1 .. S'Last - 1));
+ Write_Str (""", ""operands"": [ ");
+ Print_Expr (Node.Op1);
+ Write_Str (", ");
+ Print_Expr (Node.Op2);
+ Write_Str (" ] }");
+ else
+ Write_Char ('(');
+ Print_Expr (Node.Op1);
+ Write_Str (S);
+ Print_Expr (Node.Op2);
+ Write_Char (')');
+ end if;
end Binop;
-- Start of processing for Print_Expr
@@ -559,13 +607,24 @@ package body Repinfo is
begin
case Node.Expr is
when Cond_Expr =>
- Write_Str ("(if ");
- Print_Expr (Node.Op1);
- Write_Str (" then ");
- Print_Expr (Node.Op2);
- Write_Str (" else ");
- Print_Expr (Node.Op3);
- Write_Str (" end)");
+ if List_Representation_Info_To_JSON then
+ Write_Str ("{ ""code"": ""?<>""");
+ Write_Str (", ""operands"": [ ");
+ Print_Expr (Node.Op1);
+ Write_Str (", ");
+ Print_Expr (Node.Op2);
+ Write_Str (", ");
+ Print_Expr (Node.Op3);
+ Write_Str (" ] }");
+ else
+ Write_Str ("(if ");
+ Print_Expr (Node.Op1);
+ Write_Str (" then ");
+ Print_Expr (Node.Op2);
+ Write_Str (" else ");
+ Print_Expr (Node.Op3);
+ Write_Str (" end)");
+ end if;
when Plus_Expr =>
Binop (" + ");
@@ -702,99 +761,136 @@ package body Repinfo is
Args := Pragma_Argument_Associations (Linker_Section_Pragma (Ent));
Sect := Expr_Value_S (Get_Pragma_Arg (Last (Args)));
- Write_Str ("pragma Linker_Section (");
- List_Name (Ent);
- Write_Str (", """);
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""Linker_Section"": """);
+ else
+ Write_Str ("pragma Linker_Section (");
+ List_Name (Ent);
+ Write_Str (", """);
+ end if;
pragma Assert (Nkind (Sect) = N_String_Literal);
String_To_Name_Buffer (Strval (Sect));
Write_Str (Name_Buffer (1 .. Name_Len));
- Write_Str (""");");
- Write_Eol;
+ Write_Str ("""");
+ if not List_Representation_Info_To_JSON then
+ Write_Line (");");
+ end if;
end if;
end List_Linker_Section;
+ -------------------
+ -- List_Location --
+ -------------------
+
+ procedure List_Location (Ent : Entity_Id) is
+ begin
+ pragma Assert (List_Representation_Info_To_JSON);
+ Write_Str (" ""location"": """);
+ Write_Location (Sloc (Ent));
+ Write_Line (""",");
+ end List_Location;
+
---------------------
-- List_Mechanisms --
---------------------
procedure List_Mechanisms (Ent : Entity_Id) is
- Plen : Natural;
- Form : Entity_Id;
+ First : Boolean := True;
+ Plen : Natural;
+ Form : Entity_Id;
begin
Blank_Line;
- case Ekind (Ent) is
- when E_Function =>
- Write_Str ("function ");
+ if List_Representation_Info_To_JSON then
+ Write_Line ("{");
+ Write_Str (" ""name"": """);
+ List_Name (Ent);
+ Write_Line (""",");
+ List_Location (Ent);
- when E_Operator =>
- Write_Str ("operator ");
+ Write_Str (" ""Convention"": """);
+ else
+ case Ekind (Ent) is
+ when E_Function =>
+ Write_Str ("function ");
- when E_Procedure =>
- Write_Str ("procedure ");
+ when E_Operator =>
+ Write_Str ("operator ");
- when E_Subprogram_Type =>
- Write_Str ("type ");
+ when E_Procedure =>
+ Write_Str ("procedure ");
- when E_Entry
- | E_Entry_Family
- =>
- Write_Str ("entry ");
+ when E_Subprogram_Type =>
+ Write_Str ("type ");
- when others =>
- raise Program_Error;
- end case;
+ when E_Entry
+ | E_Entry_Family
+ =>
+ Write_Str ("entry ");
- List_Name (Ent);
- Write_Str (" declared at ");
- Write_Location (Sloc (Ent));
- Write_Eol;
+ when others =>
+ raise Program_Error;
+ end case;
- Write_Str ("convention : ");
+ List_Name (Ent);
+ Write_Str (" declared at ");
+ Write_Location (Sloc (Ent));
+ Write_Eol;
+
+ Write_Str ("convention : ");
+ end if;
case Convention (Ent) is
when Convention_Ada =>
- Write_Line ("Ada");
+ Write_Str ("Ada");
when Convention_Ada_Pass_By_Copy =>
- Write_Line ("Ada_Pass_By_Copy");
+ Write_Str ("Ada_Pass_By_Copy");
when Convention_Ada_Pass_By_Reference =>
- Write_Line ("Ada_Pass_By_Reference");
+ Write_Str ("Ada_Pass_By_Reference");
when Convention_Intrinsic =>
- Write_Line ("Intrinsic");
+ Write_Str ("Intrinsic");
when Convention_Entry =>
- Write_Line ("Entry");
+ Write_Str ("Entry");
when Convention_Protected =>
- Write_Line ("Protected");
+ Write_Str ("Protected");
when Convention_Assembler =>
- Write_Line ("Assembler");
+ Write_Str ("Assembler");
when Convention_C =>
- Write_Line ("C");
+ Write_Str ("C");
when Convention_COBOL =>
- Write_Line ("COBOL");
+ Write_Str ("COBOL");
when Convention_CPP =>
- Write_Line ("C++");
+ Write_Str ("C++");
when Convention_Fortran =>
- Write_Line ("Fortran");
+ Write_Str ("Fortran");
when Convention_Stdcall =>
- Write_Line ("Stdcall");
+ Write_Str ("Stdcall");
when Convention_Stubbed =>
- Write_Line ("Stubbed");
+ Write_Str ("Stubbed");
end case;
+ if List_Representation_Info_To_JSON then
+ Write_Line (""",");
+ Write_Str (" ""formal"": [");
+ else
+ Write_Eol;
+ end if;
+
-- Find max length of formal name
Plen := 0;
@@ -815,29 +911,67 @@ package body Repinfo is
while Present (Form) loop
Get_Unqualified_Decoded_Name_String (Chars (Form));
Set_Casing (Unit_Casing);
- while Name_Len <= Plen loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := ' ';
- end loop;
- Write_Str (" ");
- Write_Str (Name_Buffer (1 .. Plen + 1));
- Write_Str (": passed by ");
+ if List_Representation_Info_To_JSON then
+ if First then
+ Write_Eol;
+ First := False;
+ else
+ Write_Line (",");
+ end if;
+
+ Write_Line (" {");
+ Write_Str (" ""name"": """);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line (""",");
+
+ Write_Str (" ""mechanism"": """);
+ Write_Mechanism (Mechanism (Form));
+ Write_Line ("""");
+ Write_Str (" }");
+ else
+ while Name_Len <= Plen loop
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := ' ';
+ end loop;
+
+ Write_Str (" ");
+ Write_Str (Name_Buffer (1 .. Plen + 1));
+ Write_Str (": passed by ");
+
+ Write_Mechanism (Mechanism (Form));
+ Write_Eol;
+ end if;
- Write_Mechanism (Mechanism (Form));
- Write_Eol;
Next_Formal (Form);
end loop;
- if Etype (Ent) /= Standard_Void_Type then
- Write_Str ("returns by ");
- Write_Mechanism (Mechanism (Ent));
+ if List_Representation_Info_To_JSON then
Write_Eol;
+ Write_Str (" ]");
+ end if;
+
+ if Etype (Ent) /= Standard_Void_Type then
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""mechanism"": """);
+ Write_Mechanism (Mechanism (Ent));
+ Write_Str ("""");
+ else
+ Write_Str ("returns by ");
+ Write_Mechanism (Mechanism (Ent));
+ Write_Eol;
+ end if;
end if;
if not Is_Entry (Ent) then
List_Linker_Section (Ent);
end if;
+
+ if List_Representation_Info_To_JSON then
+ Write_Eol;
+ Write_Line ("}");
+ end if;
end List_Mechanisms;
---------------
@@ -846,7 +980,14 @@ package body Repinfo is
procedure List_Name (Ent : Entity_Id) is
begin
- if not Is_Compilation_Unit (Scope (Ent)) then
+ -- List the qualified name recursively, except
+ -- at compilation unit level in default mode.
+
+ if Is_Compilation_Unit (Ent) then
+ null;
+ elsif not Is_Compilation_Unit (Scope (Ent))
+ or else List_Representation_Info_To_JSON
+ then
List_Name (Scope (Ent));
Write_Char ('.');
end if;
@@ -864,19 +1005,40 @@ package body Repinfo is
begin
Blank_Line;
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Size use ");
- Write_Val (Esize (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Line ("{");
+
+ Write_Str (" ""name"": """);
+ List_Name (Ent);
+ Write_Line (""",");
+ List_Location (Ent);
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Alignment use ");
- Write_Val (Alignment (Ent));
- Write_Line (";");
+ Write_Str (" ""Size"": ");
+ Write_Val (Esize (Ent));
+ Write_Line (",");
- List_Linker_Section (Ent);
+ Write_Str (" ""Alignment"": ");
+ Write_Val (Alignment (Ent));
+
+ List_Linker_Section (Ent);
+
+ Write_Eol;
+ Write_Line ("}");
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Size use ");
+ Write_Val (Esize (Ent));
+ Write_Line (";");
+
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Alignment use ");
+ Write_Val (Alignment (Ent));
+ Write_Line (";");
+
+ List_Linker_Section (Ent);
+ end if;
end List_Object_Info;
----------------------
@@ -895,7 +1057,8 @@ package body Repinfo is
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0;
- Prefix : String := "");
+ Prefix : String := "";
+ Indent : Natural := 0);
-- Procedure to display the layout of a single component
procedure List_Record_Layout
@@ -905,6 +1068,12 @@ package body Repinfo is
Prefix : String := "");
-- Internal recursive procedure to display the layout
+ procedure List_Structural_Record_Layout
+ (Ent : Entity_Id;
+ Variant : Node_Id := Empty;
+ Indent : Natural := 0);
+ -- Internal recursive procedure to display the structural layout
+
Max_Name_Length : Natural := 0;
Max_Spos_Length : Natural := 0;
@@ -1017,7 +1186,8 @@ package body Repinfo is
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0;
- Prefix : String := "")
+ Prefix : String := "";
+ Indent : Natural := 0)
is
Esiz : constant Uint := Esize (Ent);
Npos : constant Uint := Normalized_Position (Ent);
@@ -1027,11 +1197,23 @@ package body Repinfo is
Lbit : Uint;
begin
- Write_Str (" ");
- Write_Str (Prefix);
- Write_Str (Name_Buffer (1 .. Name_Len));
- Spaces (Max_Name_Length - Prefix'Length - Name_Len);
- Write_Str (" at ");
+ if List_Representation_Info_To_JSON then
+ Spaces (Indent);
+ Write_Line (" {");
+ Spaces (Indent);
+ Write_Str (" ""name"": """);
+ Write_Str (Prefix);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Write_Line (""",");
+ Spaces (Indent);
+ Write_Str (" ""Position"": ");
+ else
+ Write_Str (" ");
+ Write_Str (Prefix);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+ Spaces (Max_Name_Length - Prefix'Length - Name_Len);
+ Write_Str (" at ");
+ end if;
if Known_Static_Normalized_Position (Ent) then
Spos := Starting_Position + Npos;
@@ -1061,7 +1243,14 @@ package body Repinfo is
Write_Unknown_Val;
end if;
- Write_Str (" range ");
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Spaces (Indent);
+ Write_Str (" ""First_Bit"": ");
+ else
+ Write_Str (" range ");
+ end if;
+
Sbit := Starting_First_Bit + Fbit;
if Sbit >= SSU then
@@ -1069,7 +1258,14 @@ package body Repinfo is
end if;
UI_Write (Sbit);
- Write_Str (" .. ");
+
+ if List_Representation_Info_To_JSON then
+ Write_Line (", ");
+ Spaces (Indent);
+ Write_Str (" ""Size"": ");
+ else
+ Write_Str (" .. ");
+ end if;
-- Allowing Uint_0 here is an annoying special case. Really
-- this should be a fine Esize value but currently it means
@@ -1082,11 +1278,15 @@ package body Repinfo is
then
Lbit := Sbit + Esiz - 1;
- if Lbit < 10 then
- Write_Char (' ');
- end if;
+ if List_Representation_Info_To_JSON then
+ UI_Write (Esiz);
+ else
+ if Lbit < 10 then
+ Write_Char (' ');
+ end if;
- UI_Write (Lbit);
+ UI_Write (Lbit);
+ end if;
-- The test for Esize (Ent) not Uint_0 here is an annoying
-- special case. Officially a value of zero for Esize means
@@ -1102,7 +1302,7 @@ package body Repinfo is
-- List_Representation >= 3 and Known_Esize (Ent)
else
- Write_Val (Esiz, Paren => True);
+ Write_Val (Esiz, Paren => not List_Representation_Info_To_JSON);
-- If in front end layout mode, then dynamic size is stored
-- in storage units, so renormalize for output
@@ -1114,19 +1314,27 @@ package body Repinfo is
-- Add appropriate first bit offset
- if Sbit = 0 then
- Write_Str (" - 1");
+ if not List_Representation_Info_To_JSON then
+ if Sbit = 0 then
+ Write_Str (" - 1");
- elsif Sbit = 1 then
- null;
+ elsif Sbit = 1 then
+ null;
- else
- Write_Str (" + ");
- Write_Int (UI_To_Int (Sbit) - 1);
+ else
+ Write_Str (" + ");
+ Write_Int (UI_To_Int (Sbit) - 1);
+ end if;
end if;
end if;
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Eol;
+ Spaces (Indent);
+ Write_Str (" }");
+ else
+ Write_Line (";");
+ end if;
end List_Component_Layout;
------------------------
@@ -1203,15 +1411,180 @@ package body Repinfo is
end loop;
end List_Record_Layout;
+ -----------------------------------
+ -- List_Structural_Record_Layout --
+ -----------------------------------
+
+ procedure List_Structural_Record_Layout
+ (Ent : Entity_Id;
+ Variant : Node_Id := Empty;
+ Indent : Natural := 0)
+ is
+ Comp : Node_Id;
+ Comp_List : Node_Id;
+ Var : Node_Id;
+ First : Boolean := True;
+
+ begin
+ -- If we are dealing with a variant, just process the components
+
+ if Present (Variant) then
+ Comp_List := Component_List (Variant);
+
+ -- Otherwise, we are dealing with the full record and need to get
+ -- to its definition in order to retrieve its structural layout.
+
+ else
+ declare
+ Definition : Node_Id :=
+ Type_Definition (Declaration_Node (Ent));
+ Is_Extension : constant Boolean :=
+ Is_Tagged_Type (Ent)
+ and then
+ Nkind (Definition) = N_Derived_Type_Definition;
+ Disc : Entity_Id;
+ begin
+ -- If this is an extension, first list the layout of the parent
+ -- and then proceed to the extension part, if any.
+
+ if Is_Extension then
+ List_Structural_Record_Layout
+ (Base_Type (Parent_Subtype (Ent)), Variant, Indent);
+
+ if Present (Record_Extension_Part (Definition)) then
+ Definition := Record_Extension_Part (Definition);
+ end if;
+ end if;
+
+ -- If the record has discriminants and is not an unchecked
+ -- union, then display them now.
+
+ if Has_Discriminants (Ent)
+ and then not Is_Unchecked_Union (Ent)
+ then
+ Disc := First_Stored_Discriminant (Ent);
+ while Present (Disc) loop
+
+ -- If this is a record extension and the discriminant is
+ -- the renaming of another discriminant, skip it.
+
+ if Is_Extension
+ and then Present (Corresponding_Discriminant (Disc))
+ then
+ goto Continue_Disc;
+ end if;
+
+ Get_Decoded_Name_String (Chars (Disc));
+ Set_Casing (Unit_Casing);
+
+ if First then
+ Write_Eol;
+ First := False;
+ else
+ Write_Line (",");
+ end if;
+
+ List_Component_Layout (Disc, Indent => Indent);
+
+ <<Continue_Disc>>
+ Next_Stored_Discriminant (Disc);
+ end loop;
+ end if;
+
+ Comp_List := Component_List (Definition);
+ end;
+ end if;
+
+ -- Bail out for the null record
+
+ if No (Comp_List) then
+ return;
+ end if;
+
+ -- Now deal with the regular components, if any
+
+ if Present (Component_Items (Comp_List)) then
+ Comp := First_Non_Pragma (Component_Items (Comp_List));
+ while Present (Comp) loop
+
+ -- Skip _Parent component in extension (to avoid overlap)
+
+ if Chars (Defining_Identifier (Comp)) = Name_uParent then
+ goto Continue_Comp;
+ end if;
+
+ Get_Decoded_Name_String (Chars (Defining_Identifier (Comp)));
+ Set_Casing (Unit_Casing);
+
+ if First then
+ Write_Eol;
+ First := False;
+ else
+ Write_Line (",");
+ end if;
+
+ List_Component_Layout
+ (Defining_Identifier (Comp), Indent => Indent);
+
+ <<Continue_Comp>>
+ Next_Non_Pragma (Comp);
+ end loop;
+ end if;
+
+ -- We are done if there is no variant part
+
+ if No (Variant_Part (Comp_List)) then
+ return;
+ end if;
+
+ Write_Eol;
+ Spaces (Indent);
+ Write_Line (" ],");
+ Spaces (Indent);
+ Write_Str (" ""variant"" : [");
+
+ -- Otherwise we recurse on each variant
+
+ Var := First_Non_Pragma (Variants (Variant_Part (Comp_List)));
+ First := True;
+ while Present (Var) loop
+ if First then
+ Write_Eol;
+ First := False;
+ else
+ Write_Line (",");
+ end if;
+
+ Spaces (Indent);
+ Write_Line (" {");
+ Spaces (Indent);
+ Write_Str (" ""present"": ");
+ Write_Val (Present_Expr (Var));
+ Write_Line (",");
+ Spaces (Indent);
+ Write_Str (" ""record"": [");
+
+ List_Structural_Record_Layout (Ent, Var, Indent + 4);
+
+ Write_Eol;
+ Spaces (Indent);
+ Write_Line (" ]");
+ Spaces (Indent);
+ Write_Str (" }");
+ Next_Non_Pragma (Var);
+ end loop;
+ end List_Structural_Record_Layout;
+
-- Start of processing for List_Record_Info
begin
Blank_Line;
- List_Type_Info (Ent);
- Write_Str ("for ");
- List_Name (Ent);
- Write_Line (" use record");
+ if List_Representation_Info_To_JSON then
+ Write_Line ("{");
+ end if;
+
+ List_Type_Info (Ent);
-- First find out max line length and max starting position
-- length, for the purpose of lining things up nicely.
@@ -1220,13 +1593,32 @@ package body Repinfo is
-- Then do actual output based on those values
- List_Record_Layout (Ent);
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""record"": [");
+
+ List_Structural_Record_Layout (Ent);
+
+ Write_Eol;
+ Write_Str (" ]");
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Line (" use record");
+
+ List_Record_Layout (Ent);
- Write_Line ("end record;");
+ Write_Line ("end record;");
+ end if;
List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
List_Linker_Section (Ent);
+
+ if List_Representation_Info_To_JSON then
+ Write_Eol;
+ Write_Line ("}");
+ end if;
end List_Record_Info;
-------------------
@@ -1246,7 +1638,9 @@ package body Repinfo is
-- Normal case, list to standard output
- if not List_Representation_Info_To_File then
+ if not List_Representation_Info_To_File
+ and then not List_Representation_Info_To_JSON
+ then
Write_Eol;
Write_Str ("Representation information for unit ");
Write_Unit_Name (Unit_Name (U));
@@ -1294,9 +1688,14 @@ package body Repinfo is
procedure List_Attr (Attr_Name : String; Is_Reversed : Boolean) is
begin
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'" & Attr_Name & " use System.");
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" """ & Attr_Name & """: ""System.");
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'" & Attr_Name & " use System.");
+ end if;
if Bytes_Big_Endian xor Is_Reversed then
Write_Str ("High");
@@ -1304,7 +1703,12 @@ package body Repinfo is
Write_Str ("Low");
end if;
- Write_Line ("_Order_First;");
+ Write_Str ("_Order_First");
+ if List_Representation_Info_To_JSON then
+ Write_Str ("""");
+ else
+ Write_Line (";");
+ end if;
end List_Attr;
List_SSO : constant Boolean :=
@@ -1342,6 +1746,13 @@ package body Repinfo is
procedure List_Type_Info (Ent : Entity_Id) is
begin
+ if List_Representation_Info_To_JSON then
+ Write_Str (" ""name"": """);
+ List_Name (Ent);
+ Write_Line (""",");
+ List_Location (Ent);
+ end if;
+
-- Do not list size info for unconstrained arrays, not meaningful
if Is_Array_Type (Ent) and then not Is_Constrained (Ent) then
@@ -1352,34 +1763,56 @@ package body Repinfo is
-- case, which we may as well list in simple form.
if Esize (Ent) = RM_Size (Ent) then
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Size use ");
- Write_Val (Esize (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Str (" ""Size"": ");
+ Write_Val (Esize (Ent));
+ Write_Line (",");
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Size use ");
+ Write_Val (Esize (Ent));
+ Write_Line (";");
+ end if;
-- Otherwise list size values separately
else
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Object_Size use ");
- Write_Val (Esize (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Str (" ""Object_Size"": ");
+ Write_Val (Esize (Ent));
+ Write_Line (",");
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Value_Size use ");
- Write_Val (RM_Size (Ent));
- Write_Line (";");
+ Write_Str (" ""Value_Size"": ");
+ Write_Val (RM_Size (Ent));
+ Write_Line (",");
+
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Object_Size use ");
+ Write_Val (Esize (Ent));
+ Write_Line (";");
+
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Value_Size use ");
+ Write_Val (RM_Size (Ent));
+ Write_Line (";");
+ end if;
end if;
end if;
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Alignment use ");
- Write_Val (Alignment (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Str (" ""Alignment"": ");
+ Write_Val (Alignment (Ent));
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Alignment use ");
+ Write_Val (Alignment (Ent));
+ Write_Line (";");
+ end if;
-- Special stuff for fixed-point
@@ -1387,11 +1820,17 @@ package body Repinfo is
-- Write small (always a static constant)
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Small use ");
- UR_Write (Small_Value (Ent));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""Small"": ");
+ UR_Write (Small_Value (Ent));
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Small use ");
+ UR_Write (Small_Value (Ent));
+ Write_Line (";");
+ end if;
-- Write range if static
@@ -1403,13 +1842,22 @@ package body Repinfo is
and then
Nkind (High_Bound (R)) = N_Real_Literal
then
- Write_Str ("for ");
- List_Name (Ent);
- Write_Str ("'Range use ");
- UR_Write (Realval (Low_Bound (R)));
- Write_Str (" .. ");
- UR_Write (Realval (High_Bound (R)));
- Write_Line (";");
+ if List_Representation_Info_To_JSON then
+ Write_Line (",");
+ Write_Str (" ""Range"": [ ");
+ UR_Write (Realval (Low_Bound (R)));
+ Write_Str (", ");
+ UR_Write (Realval (High_Bound (R)));
+ Write_Str (" ]");
+ else
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Range use ");
+ UR_Write (Realval (Low_Bound (R)));
+ Write_Str (" .. ");
+ UR_Write (Realval (High_Bound (R)));
+ Write_Line (";");
+ end if;
end if;
end;
end if;
@@ -1695,7 +2143,11 @@ package body Repinfo is
procedure Write_Unknown_Val is
begin
- Write_Str ("??");
+ if List_Representation_Info_To_JSON then
+ Write_Str ("""??""");
+ else
+ Write_Str ("??");
+ end if;
end Write_Unknown_Val;
---------------
--- gcc/ada/repinfo.ads
+++ gcc/ada/repinfo.ads
@@ -141,48 +141,143 @@ package Repinfo is
-- tree.def. Only a subset of these tree codes can actually appear.
-- The names are the names from tree.def in Ada casing.
- -- name code description operands
-
- Cond_Expr : constant TCode := 1; -- conditional 3
- Plus_Expr : constant TCode := 2; -- addition 2
- Minus_Expr : constant TCode := 3; -- subtraction 2
- Mult_Expr : constant TCode := 4; -- multiplication 2
- Trunc_Div_Expr : constant TCode := 5; -- truncating division 2
- Ceil_Div_Expr : constant TCode := 6; -- division rounding up 2
- Floor_Div_Expr : constant TCode := 7; -- division rounding down 2
- Trunc_Mod_Expr : constant TCode := 8; -- mod for trunc_div 2
- Ceil_Mod_Expr : constant TCode := 9; -- mod for ceil_div 2
- Floor_Mod_Expr : constant TCode := 10; -- mod for floor_div 2
- Exact_Div_Expr : constant TCode := 11; -- exact division 2
- Negate_Expr : constant TCode := 12; -- negation 1
- Min_Expr : constant TCode := 13; -- minimum 2
- Max_Expr : constant TCode := 14; -- maximum 2
- Abs_Expr : constant TCode := 15; -- absolute value 1
- Truth_And_Expr : constant TCode := 16; -- boolean and 2
- Truth_Or_Expr : constant TCode := 17; -- boolean or 2
- Truth_Xor_Expr : constant TCode := 18; -- boolean xor 2
- Truth_Not_Expr : constant TCode := 19; -- boolean not 1
- Lt_Expr : constant TCode := 20; -- comparison < 2
- Le_Expr : constant TCode := 21; -- comparison <= 2
- Gt_Expr : constant TCode := 22; -- comparison > 2
- Ge_Expr : constant TCode := 23; -- comparison >= 2
- Eq_Expr : constant TCode := 24; -- comparison = 2
- Ne_Expr : constant TCode := 25; -- comparison /= 2
- Bit_And_Expr : constant TCode := 26; -- bitwise and 2
+ -- name code description operands symbol
+
+ Cond_Expr : constant TCode := 1; -- conditional 3 ?<>
+ Plus_Expr : constant TCode := 2; -- addition 2 +
+ Minus_Expr : constant TCode := 3; -- subtraction 2 -
+ Mult_Expr : constant TCode := 4; -- multiplication 2 *
+ Trunc_Div_Expr : constant TCode := 5; -- truncating div 2 /t
+ Ceil_Div_Expr : constant TCode := 6; -- div rounding up 2 /c
+ Floor_Div_Expr : constant TCode := 7; -- div rounding down 2 /f
+ Trunc_Mod_Expr : constant TCode := 8; -- mod for trunc_div 2 modt
+ Ceil_Mod_Expr : constant TCode := 9; -- mod for ceil_div 2 modc
+ Floor_Mod_Expr : constant TCode := 10; -- mod for floor_div 2 modf
+ Exact_Div_Expr : constant TCode := 11; -- exact div 2 /e
+ Negate_Expr : constant TCode := 12; -- negation 1 -
+ Min_Expr : constant TCode := 13; -- minimum 2 min
+ Max_Expr : constant TCode := 14; -- maximum 2 max
+ Abs_Expr : constant TCode := 15; -- absolute value 1 abs
+ Truth_And_Expr : constant TCode := 16; -- boolean and 2 and
+ Truth_Or_Expr : constant TCode := 17; -- boolean or 2 or
+ Truth_Xor_Expr : constant TCode := 18; -- boolean xor 2 xor
+ Truth_Not_Expr : constant TCode := 19; -- boolean not 1 not
+ Lt_Expr : constant TCode := 20; -- comparison < 2 <
+ Le_Expr : constant TCode := 21; -- comparison <= 2 <=
+ Gt_Expr : constant TCode := 22; -- comparison > 2 >
+ Ge_Expr : constant TCode := 23; -- comparison >= 2 >=
+ Eq_Expr : constant TCode := 24; -- comparison = 2 ==
+ Ne_Expr : constant TCode := 25; -- comparison /= 2 !=
+ Bit_And_Expr : constant TCode := 26; -- bitwise and 2 &
-- The following entry is used to represent a discriminant value in
-- the tree. It has a special tree code that does not correspond
-- directly to a GCC node. The single operand is the index number
-- of the discriminant in the record (1 = first discriminant).
- Discrim_Val : constant TCode := 0; -- discriminant value 1
+ Discrim_Val : constant TCode := 0; -- discriminant value 1 #
-- The following entry is used to represent a value not known at
-- compile time in the tree, other than a discriminant value. It
-- has a special tree code that does not correspond directly to
-- a GCC node. The single operand is an arbitrary index number.
- Dynamic_Val : constant TCode := 27; -- dynamic value 1
+ Dynamic_Val : constant TCode := 27; -- dynamic value 1 var
+
+ ----------------------------
+ -- The JSON output format --
+ ----------------------------
+
+ -- The representation information can be output to a file in the JSON
+ -- data interchange format specified by the ECMA-404 standard. In the
+ -- following description, the terminology is that of the JSON syntax
+ -- from the ECMA document and of the JSON grammar from www.json.org.
+
+ -- The output is a concatenation of entities
+
+ -- An entity is an object whose members are pairs taken from:
+
+ -- "name" : string
+ -- "location" : string
+ -- "record" : array of components
+ -- "variant" : array of variants
+ -- "formal" : array of formal parameters
+ -- "mechanism" : string
+ -- "Size" : numerical expression
+ -- "Object_Size" : numerical expression
+ -- "Value_Size" : numerical expression
+ -- "Component_Size" : numerical expression
+ -- "Range" : array of numbers
+ -- "Small" : number
+ -- "Alignment" : number
+ -- "Convention" : string
+ -- "Linker_Section" : string
+ -- "Bit_Order" : string
+ -- "Scalar_Storage_Order" : string
+
+ -- "name" and "location" are present for every entity and come from the
+ -- declaration of the associated Ada entity. The value of "name" is the
+ -- fully qualified Ada name. The value of "location" is the expanded
+ -- chain of instantiation locations that contains the entity.
+ -- "record" is present for every record type and its value is the list of
+ -- components. "variant" is present only if the record type has a variant
+ -- part and its value is the list of variants.
+ -- "formal" is present for every subprogram and entry, and its value is
+ -- the list of formal parameters. "mechanism" is present for functions
+ -- only and its value is the return mechanim.
+ -- The other pairs may be present when the eponymous aspect/attribute is
+ -- defined for the Ada entity, and their value is set by the language.
+
+ -- A component is an object whose members are pairs taken from:
+
+ -- "name" : string
+ -- "Position" : numerical expression
+ -- "First_Bit" : number
+ -- "Size" : numerical expression
+
+ -- The four pairs are present for every component. "name" comes from the
+ -- declaration of the component in the record type and its value is the
+ -- unqualified Ada name. The other three pairs come from the layout of
+ -- the type and their value is that of the eponymous attribute set by
+ -- the language.
+
+ -- A variant is an object whose members are pairs taken from:
+
+ -- "present" : numerical expression
+ -- "record" : array of components
+ -- "variant" : array of variants
+
+ -- "present" and "record" are present for every variant. The value of
+ -- "present" is a boolean expression that evaluates to true when the
+ -- components of the variant are contained in the record type and to
+ -- false when they are not. The value of "record" is the list of
+ -- components in the variant. "variant" is present only if the variant
+ -- itself has a variant part and its value is the list of (sub)variants.
+
+ -- A formal parameter is an object whose members are pairs taken from:
+
+ -- "name" : string
+ -- "mechanism" : string
+
+ -- The two pairs are present for every formal parameter. "name" comes
+ -- from the declaration of the parameter in the subprogram or entry
+ -- and its value is the unqualified Ada name. The value of "mechanism"
+ -- is the passing mechanism for the parameter set by the language.
+
+ -- A numerical expression is either a number or an object whose members
+ -- are pairs taken from:
+
+ -- "code" : string
+ -- "operands" : array of numerical expressions
+
+ -- The two pairs are present for every such object. The value of "code"
+ -- is a symbol taken from the table defining the TCode type above. The
+ -- number of elements of the value of "operands" is specified by the
+ -- operands column in the line associated with the symbol in the table.
+
+ -- As documented above, the full back annotation is only done in -gnatR3
+ -- or ASIS mode. In the other cases, if the numerical expression is not
+ -- a number, then it is replaced with the "??" string.
------------------------
-- The gigi Interface --
--- gcc/ada/switch-c.adb
+++ gcc/ada/switch-c.adb
@@ -1211,6 +1211,9 @@ package body Switch.C is
when 's' =>
List_Representation_Info_To_File := True;
+ when 'j' =>
+ List_Representation_Info_To_JSON := True;
+
when 'm' =>
List_Representation_Info_Mechanisms := True;
@@ -1224,6 +1227,14 @@ package body Switch.C is
Ptr := Ptr + 1;
end loop;
+ if List_Representation_Info_To_JSON then
+ if List_Representation_Info_To_File then
+ Osint.Fail ("-gnatRs is incompatible with -gnatRj");
+ elsif List_Representation_Info_Extended then
+ Osint.Fail ("-gnatRe is incompatible with -gnatRj");
+ end if;
+ end if;
+
-- -gnats (syntax check only)
when 's' =>
--- gcc/ada/usage.adb
+++ gcc/ada/usage.adb
@@ -405,6 +405,8 @@ begin
("List rep info (?=0/1/2/3/e/m for none/types/all/symbolic/ext/mech)");
Write_Switch_Char ("R?s");
Write_Line ("List rep info to file.rep instead of standard output");
+ Write_Switch_Char ("R?j");
+ Write_Line ("List rep info to file.json instead of standard output");
-- Line for -gnats switch
