From 1e7629b8a2f2b05194ab8bc3878f6f841666a289 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 29 May 2018 09:36:51 +0000 Subject: [PATCH] [Ada] Implement machine parsable format for -gnatR output 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. 2018-05-29 Eric Botcazou 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) : Deal with 'j'. * usage.adb (Usage): List -gnatRj. From-SVN: r260868 --- gcc/ada/ChangeLog | 29 + ...building_executable_programs_with_gnat.rst | 11 +- gcc/ada/gnat_ugn.texi | 11 +- gcc/ada/opt.ads | 6 + gcc/ada/osint-c.adb | 7 +- gcc/ada/repinfo.adb | 752 ++++++++++++++---- gcc/ada/repinfo.ads | 155 +++- gcc/ada/switch-c.adb | 11 + gcc/ada/usage.adb | 2 + 9 files changed, 798 insertions(+), 186 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fdc940eef21..cc6ae0e17eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2018-05-29 Eric Botcazou + + * 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) : Deal with 'j'. + * usage.adb (Usage): List -gnatRj. + 2018-05-29 Eric Botcazou * repinfo.adb (List_Component_Layout): New procedure extracted from... diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 8c76a74683e..bbcef082c5c 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/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``. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index ceadb57ef0b..3fb6af5ac12 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/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}. diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 2d57e1ca247..235ca3d4a62 100644 --- a/gcc/ada/opt.ads +++ b/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 diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 89532afea78..177c8dec836 100644 --- a/gcc/ada/osint-c.adb +++ b/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; --------------------------- diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 071abbb1830..83267c87943 100644 --- a/gcc/ada/repinfo.adb +++ b/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); + + <> + 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); + + <> + 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; --------------- diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index 6cbd482d721..477ac0ead29 100644 --- a/gcc/ada/repinfo.ads +++ b/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 -- diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 183d0efaf4f..be8fb61e50c 100644 --- a/gcc/ada/switch-c.adb +++ b/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' => diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 427c8a3697b..a07629e0e01 100644 --- a/gcc/ada/usage.adb +++ b/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 -- 2.30.2