From: Eric Botcazou <ebotca...@adacore.com>
This implements the new (sub)switch -gnatRh to display holes in the layout
of record types, which are mostly present to fulfill alignment requirements.
gcc/ada/ChangeLog:
* doc/gnat_ugn/building_executable_programs_with_gnat.rst (List of
all switches): Add -gnatRh subswitch.
(Debugging Control): Document -gnatRh subswitch.
* opt.ads (List_Representation_Info_Holes): New boolean variable.
* repinfo.adb: Add with clause for GNAT.Heap_Sort_G.
(List_Common_Type_Info): Relax assertion.
(List_Object_Info): Replace assertion with additional test.
(List_Record_Layout): If -gnatRh is specified, make sure that the
components are ordered by increasing offsets. Output a comment
line giving the number of unused bits if there is a hole between
consecutive components. Streamline the control flow of the loop.
(List_Record_Info): Use the original record type giving the layout
of components, if any, to display the layout of the record.
* switch-c.adb (Scan_Front_End_Switches) <-gnatR>: Add support for
-gnatRh subswitch.
* usage.adb (Usage): Document -gnatRh subswitch.
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
...building_executable_programs_with_gnat.rst | 12 +-
gcc/ada/gnat_ugn.texi | 12 +-
gcc/ada/opt.ads | 25 +-
gcc/ada/repinfo.adb | 299 ++++++++++++++----
gcc/ada/switch-c.adb | 21 +-
gcc/ada/usage.adb | 2 +-
6 files changed, 280 insertions(+), 91 deletions(-)
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 f5a9b021c4e..94e38efadfd 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
@@ -2112,7 +2112,7 @@ Alphabetical List of All Switches
.. index:: -gnatR (gcc)
-:switch:`-gnatR[0|1|2|3|4][e][j][m][s]`
+:switch:`-gnatR[0|1|2|3|4][e][h][m][j][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
@@ -6090,7 +6090,7 @@ Debugging Control
.. index:: -gnatR (gcc)
-:switch:`-gnatR[0|1|2|3|4][e][j][m][s]`
+:switch:`-gnatR[0|1|2|3|4][e][h][m][j][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
@@ -6118,17 +6118,21 @@ Debugging Control
extended representation information for record sub-components of records
is included.
+ If the switch is followed by a ``h`` (e.g. :switch:`-gnatR3h`), then
+ the components of records are sorted by increasing offsets and holes
+ between consecutive components are flagged.
+
If the switch is followed by an ``m`` (e.g. :switch:`-gnatRm`), then
subprogram conventions and parameter passing mechanisms for all the
subprograms are included.
- If the switch is followed by a ``j`` (e.g., :switch:`-gnatRj`), then
+ If the switch is followed by a ``j`` (e.g. :switch:`-gnatRj`), then
the output is in 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.
- If the switch is followed by an ``s`` (e.g., :switch:`-gnatR3s`), then
+ If the switch is followed by an ``s`` (e.g. :switch:`-gnatR3s`), then
the output is to a file with the name :file:`file.rep` where ``file`` is
the name of the corresponding source file, except if ``j`` is also
specified, in which case the file name is :file:`file.json`.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 9d541db6e27..ad47780fdd4 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -9850,7 +9850,7 @@ Treat pragma Restrictions as Restriction_Warnings.
@table @asis
-@item @code{-gnatR[0|1|2|3|4][e][j][m][s]}
+@item @code{-gnatR[0|1|2|3|4][e][h][m][j][s]}
Output representation information for declared types, objects and
subprograms. Note that this switch is not allowed if a previous
@@ -15286,7 +15286,7 @@ restriction warnings rather than restrictions.
@table @asis
-@item @code{-gnatR[0|1|2|3|4][e][j][m][s]}
+@item @code{-gnatR[0|1|2|3|4][e][h][m][j][s]}
This switch controls output from the compiler of a listing showing
representation information for declared types, objects and subprograms.
@@ -15315,17 +15315,21 @@ If the switch is followed by an @code{e} (e.g.
@code{-gnatR2e}), then
extended representation information for record sub-components of records
is included.
+If the switch is followed by a @code{h} (e.g. @code{-gnatR3h}), then
+the components of records are sorted by increasing offsets and holes
+between consecutive components are flagged.
+
If the switch is followed by an @code{m} (e.g. @code{-gnatRm}), then
subprogram conventions and parameter passing mechanisms for all the
subprograms are included.
-If the switch is followed by a @code{j} (e.g., @code{-gnatRj}), then
+If the switch is followed by a @code{j} (e.g. @code{-gnatRj}), then
the output is in 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.
-If the switch is followed by an @code{s} (e.g., @code{-gnatR3s}), then
+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 @code{file} is
the name of the corresponding source file, except if @code{j} is also
specified, in which case the file name is @code{file.json}.
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index cbe470105fd..e595b084119 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -943,6 +943,21 @@ package Opt is
-- WARNING: There is a matching C declaration of this variable in fe.h
+ List_Representation_Info_Extended : Boolean := False;
+ -- GNAT
+ -- Set true by -gnatRe switch. Causes extended information for record types
+ -- to be included in the representation output information.
+
+ List_Representation_Info_Holes : Boolean := False;
+ -- GNAT
+ -- Set true by -gnatRh switch. Causes information for holes between record
+ -- components to be included in the representation output information.
+
+ List_Representation_Info_Mechanisms : Boolean := False;
+ -- GNAT
+ -- Set true by -gnatRm switch. Causes information on mechanisms to be
+ -- included in the representation output information.
+
List_Representation_Info_To_File : Boolean := False;
-- GNAT
-- Set true by -gnatRs switch. Causes information from -gnatR[1-4]m to be
@@ -955,16 +970,6 @@ package Opt is
-- Set true by -gnatRj switch. Causes information from -gnatR[1-4]m to be
-- output in the JSON data interchange format.
- List_Representation_Info_Mechanisms : Boolean := False;
- -- GNAT
- -- Set true by -gnatRm switch. Causes information on mechanisms to be
- -- included in the representation output information.
-
- List_Representation_Info_Extended : Boolean := False;
- -- GNAT
- -- Set true by -gnatRe switch. Causes extended information for record types
- -- to be included in the representation output information.
-
List_Preprocessing_Symbols : Boolean := False;
-- GNAT, GNATPREP
-- Set to True if symbols for preprocessing a source are to be listed
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index a6dff7cc743..ddbb58e7e0b 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -30,6 +30,7 @@ with Debug; use Debug;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
+with GNAT.Heap_Sort_G;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
@@ -413,9 +414,9 @@ package body Repinfo is
Write_Line (";");
end if;
- -- Alignment is not always set for task, protected, and class-wide
- -- types, or when doing semantic analysis only. Representation aspects
- -- are not computed for types in a generic unit.
+ -- Alignment is not always set for concurrent types, class-wide types,
+ -- cloned subtypes, or when doing semantic analysis only. Representation
+ -- aspects are not computed for types declared in a generic unit.
else
-- Add unknown alignment entry in JSON format to ensure the format is
@@ -426,11 +427,13 @@ package body Repinfo is
Write_Unknown_Val;
end if;
- pragma Assert
- (not Expander_Active or else
- Is_Concurrent_Type (Ent) or else
- Is_Class_Wide_Type (Ent) or else
- Sem_Util.In_Generic_Scope (Ent));
+ pragma Assert (not Expander_Active
+ or else Is_Concurrent_Type (Ent)
+ or else Is_Class_Wide_Type (Ent)
+ or else (Ekind (Ent) = E_Record_Subtype
+ and then Present (Cloned_Subtype (Ent))
+ and then Has_Delayed_Freeze (Cloned_Subtype (Ent)))
+ or else Sem_Util.In_Generic_Scope (Ent));
end if;
end List_Common_Type_Info;
@@ -856,8 +859,7 @@ package body Repinfo is
-- generic unit, or if the back end is not being run), don't try to
-- print them.
- pragma Assert (Known_Esize (Ent) = Known_Alignment (Ent));
- if not Known_Alignment (Ent) then
+ if not Known_Esize (Ent) or else not Known_Alignment (Ent) then
return;
end if;
@@ -882,6 +884,7 @@ package body Repinfo is
Write_Eol;
Write_Line ("}");
+
else
Write_Str ("for ");
List_Name (Ent);
@@ -1223,11 +1226,135 @@ package body Repinfo is
Starting_First_Bit : Uint := Uint_0;
Prefix : String := "")
is
- Comp : Entity_Id;
- First : Boolean := True;
+ function First_Comp_Or_Discr (Ent : Entity_Id) return Entity_Id;
+ -- Like First_Component_Or_Discriminant, but reorder the components
+ -- according to their bit offset if need be.
+
+ -------------------------
+ -- First_Comp_Or_Discr --
+ -------------------------
+
+ function First_Comp_Or_Discr (Ent : Entity_Id) return Entity_Id is
+
+ function Is_Placed_Before (C1, C2 : Entity_Id) return Boolean;
+ -- Return True if component C1 is placed before component C2
+
+ ----------------------
+ -- Is_Placed_Before --
+ ----------------------
+
+ function Is_Placed_Before (C1, C2 : Entity_Id) return Boolean is
+ begin
+ return Known_Static_Component_Bit_Offset (C1)
+ and then Known_Static_Component_Bit_Offset (C2)
+ and then
+ Component_Bit_Offset (C1) < Component_Bit_Offset (C2);
+ end Is_Placed_Before;
+
+ -- Local variables
+
+ Comp : Entity_Id;
+ N_Comp : Natural := 0;
+ Prev : Entity_Id;
+ Reorder : Boolean := False;
+
+ -- Start of processing for First_Comp_Or_Discr
+
+ begin
+ -- Reordering is needed only for -gnatRh
+
+ if not List_Representation_Info_Holes then
+ return First_Component_Or_Discriminant (Ent);
+ end if;
+
+ -- Count the number of components and whether reordering is needed
+
+ Comp := First_Component_Or_Discriminant (Ent);
+ Prev := Comp;
+
+ while Present (Comp) loop
+ N_Comp := N_Comp + 1;
+
+ if not Reorder then
+ Reorder := Is_Placed_Before (Comp, Prev);
+ end if;
+
+ Prev := Comp;
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+
+ -- Reorder the components, if need be, by directly reshuffling the
+ -- list of entities between First_Entity and Last_Entity, which is
+ -- safe because we are invoked after compilation is finished.
+
+ if Reorder then
+ declare
+ Comps : array (Natural range 0 .. N_Comp) of Entity_Id;
+ -- Support array for the heapsort
+
+ function Lt (Op1, Op2 : Natural) return Boolean is
+ (Is_Placed_Before (Comps (Op1), Comps (Op2)));
+ -- Compare function for the heapsort
+
+ procedure Move (From : Natural; To : Natural);
+ pragma Inline (Move);
+ -- Move procedure for the heapsort
+
+ ----------
+ -- Move --
+ ----------
+
+ procedure Move (From : Natural; To : Natural) is
+ begin
+ Comps (To) := Comps (From);
+ end Move;
+
+ package HS is new GNAT.Heap_Sort_G (Lt => Lt, Move => Move);
+ -- The heapsort for record components
+
+ begin
+ -- Pack the components into the array
+
+ N_Comp := 0;
+ Comp := First_Component_Or_Discriminant (Ent);
+
+ while Present (Comp) loop
+ N_Comp := N_Comp + 1;
+ Comps (N_Comp) := Comp;
+
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+
+ -- Sort the array
+
+ HS.Sort (N_Comp);
+
+ -- Unpack the component into the list of entities
+
+ Set_First_Entity (Ent, Comps (1));
+ Set_Prev_Entity (Comps (1), Empty);
+ for J in 1 .. N_Comp - 1 loop
+ Set_Next_Entity (Comps (J), Comps (J + 1));
+ Set_Prev_Entity (Comps (J + 1), Comps (J));
+ end loop;
+ Set_Next_Entity (Comps (N_Comp), Empty);
+ Set_Last_Entity (Ent, Comps (N_Comp));
+ end;
+ end if;
+
+ return First_Component_Or_Discriminant (Ent);
+ end First_Comp_Or_Discr;
+
+ -- Local variables
+
+ Bit_Offset : Uint := Uint_0;
+ Comp : Entity_Id;
+ First : Boolean := True;
+
+ -- Start of processing for List_Record_Layout
begin
- Comp := First_Component_Or_Discriminant (Ent);
+ Comp := First_Comp_Or_Discr (Ent);
while Present (Comp) loop
-- Skip a completely hidden discriminant or a discriminant in an
@@ -1237,69 +1364,98 @@ package body Repinfo is
and then (Is_Completely_Hidden (Comp)
or else Is_Unchecked_Union (Ent))
then
- goto Continue;
- end if;
+ null;
-- Skip _Parent component in extension (to avoid overlap)
- if Chars (Comp) = Name_uParent then
- goto Continue;
- end if;
+ elsif Chars (Comp) = Name_uParent then
+ null;
-- All other cases
- declare
- Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
- Npos : constant Uint := Normalized_Position (Comp);
- Fbit : constant Uint := Normalized_First_Bit (Comp);
- Spos : Uint;
- Sbit : Uint;
+ else
+ declare
+ C : constant Entity_Id :=
+ (if Known_Normalized_Position (Comp)
+ then Comp
+ else Original_Record_Component (Comp));
+ -- The Parent_Subtype in an extension is not back-annotated
+ -- but its layout is the same as that of the parent type.
- begin
- Get_Decoded_Name_String (Chars (Comp));
- Set_Casing (Unit_Casing);
+ Ctyp : constant Entity_Id := Underlying_Type (Etype (C));
- -- If extended information is requested, recurse fully into
- -- record components, i.e. skip the outer level.
+ begin
+ Get_Decoded_Name_String (Chars (C));
+ Set_Casing (Unit_Casing);
- if List_Representation_Info_Extended
- and then Is_Record_Type (Ctyp)
- and then Known_Static_Normalized_Position (Comp)
- and then Known_Static_Normalized_First_Bit (Comp)
- then
- Spos := Starting_Position + Npos;
- Sbit := Starting_First_Bit + Fbit;
+ -- If extended information is requested, recurse fully into
+ -- record components, i.e. skip the outer level.
- if Sbit >= SSU then
- Spos := Spos + 1;
- Sbit := Sbit - SSU;
- end if;
+ if List_Representation_Info_Extended
+ and then Is_Record_Type (Ctyp)
+ and then Known_Static_Normalized_Position (C)
+ and then Known_Static_Normalized_First_Bit (C)
+ then
+ declare
+ Npos : constant Uint := Normalized_Position (C);
+ Fbit : constant Uint := Normalized_First_Bit (C);
+ Pref : constant String :=
+ Prefix & Name_Buffer (1 .. Name_Len) & ".";
- List_Record_Layout (Ctyp,
- Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
+ Spos : Uint;
+ Sbit : Uint;
- goto Continue;
- end if;
+ begin
+ Spos := Starting_Position + Npos;
+ Sbit := Starting_First_Bit + Fbit;
+
+ if Sbit >= SSU then
+ Spos := Spos + 1;
+ Sbit := Sbit - SSU;
+ end if;
+
+ List_Record_Layout (Ctyp, Spos, Sbit, Pref);
+ end;
- if List_Representation_Info_To_JSON then
- if First then
- Write_Eol;
- First := False;
else
- Write_Line (",");
+ if List_Representation_Info_To_JSON then
+ if First then
+ Write_Eol;
+ First := False;
+ else
+ Write_Line (",");
+ end if;
+ end if;
+
+ -- If information about holes is requested, update the
+ -- current bit offset and report any (static) gap.
+
+ if List_Representation_Info_Holes
+ and then Known_Static_Component_Bit_Offset (C)
+ then
+ declare
+ Gap : constant Uint :=
+ Component_Bit_Offset (C) - Bit_Offset;
+ begin
+ if Gap > Uint_0 then
+ Write_Str (" -- ");
+ UI_Write (Gap, Decimal);
+ Write_Line (" bits unused --");
+ end if;
+
+ if Known_Static_Esize (C) then
+ Bit_Offset :=
+ Component_Bit_Offset (C) + Esize (C);
+ end if;
+ end;
+ end if;
+
+ List_Component_Layout
+ (C, Starting_Position, Starting_First_Bit, Prefix);
end if;
- end if;
+ end;
+ end if;
- -- The Parent_Subtype in an extension is not back-annotated
-
- List_Component_Layout (
- (if Known_Normalized_Position (Comp)
- then Comp
- else Original_Record_Component (Comp)),
- Starting_Position, Starting_First_Bit, Prefix);
- end;
-
- <<Continue>>
Next_Component_Or_Discriminant (Comp);
end loop;
end List_Record_Layout;
@@ -1610,6 +1766,17 @@ package body Repinfo is
end loop;
end List_Structural_Record_Layout;
+ -- Use the original record type giving the layout of components
+ -- to avoid repeated reordering when -gnatRh is specified.
+
+ Rec : constant Entity_Id :=
+ (if Ekind (Ent) = E_Record_Subtype
+ and then Present (Cloned_Subtype (Ent))
+ then (if Is_Private_Type (Cloned_Subtype (Ent))
+ then Full_View (Cloned_Subtype (Ent))
+ else Cloned_Subtype (Ent))
+ else Ent);
+
-- Start of processing for List_Record_Info
begin
@@ -1624,7 +1791,7 @@ package body Repinfo is
-- First find out max line length and max starting position
-- length, for the purpose of lining things up nicely.
- Compute_Max_Length (Ent);
+ Compute_Max_Length (Rec);
-- Then do actual output based on those values
@@ -1636,21 +1803,21 @@ package body Repinfo is
-- declared in the extended main source unit for the time being,
-- because otherwise declarations might not be processed at all.
- if Is_Base_Type (Ent) then
+ if Is_Base_Type (Rec) then
begin
- List_Structural_Record_Layout (Ent, Ent);
+ List_Structural_Record_Layout (Rec, Rec);
exception
when Incomplete_Layout
| Not_In_Extended_Main
=>
- List_Record_Layout (Ent);
+ List_Record_Layout (Rec);
when others =>
raise Program_Error;
end;
else
- List_Record_Layout (Ent);
+ List_Record_Layout (Rec);
end if;
Write_Eol;
@@ -1660,7 +1827,7 @@ package body Repinfo is
List_Name (Ent);
Write_Line (" use record");
- List_Record_Layout (Ent);
+ List_Record_Layout (Rec);
Write_Line ("end record;");
end if;
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 1e54340d520..efad12c9c40 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -1220,17 +1220,20 @@ package body Switch.C is
List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0');
- when 's' =>
- List_Representation_Info_To_File := True;
+ when 'e' =>
+ List_Representation_Info_Extended := True;
- when 'j' =>
- List_Representation_Info_To_JSON := True;
+ when 'h' =>
+ List_Representation_Info_Holes := True;
when 'm' =>
List_Representation_Info_Mechanisms := True;
- when 'e' =>
- List_Representation_Info_Extended := True;
+ when 'j' =>
+ List_Representation_Info_To_JSON := True;
+
+ when 's' =>
+ List_Representation_Info_To_File := True;
when others =>
Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
@@ -1245,6 +1248,12 @@ package body Switch.C is
Osint.Fail ("-gnatRe is incompatible with -gnatRj");
end if;
+ if List_Representation_Info_To_JSON
+ and then List_Representation_Info_Holes
+ then
+ Osint.Fail ("-gnatRh is incompatible with -gnatRj");
+ end if;
+
-- -gnats (syntax check only)
when 's' =>
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 3f6cd69b639..5b87bb54dca 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -402,7 +402,7 @@ begin
Write_Switch_Char ("R?");
Write_Line
- ("List rep info (?=0/1/2/3/4/e/m for none/types/all/sym/cg/ext/mech)");
+ ("List rep info (?=1/2/3/4/e/h/m for types/all/sym/cg/ext/holes/mech)");
Write_Switch_Char ("R?j");
Write_Line ("List rep info in the JSON data interchange format");
Write_Switch_Char ("R?s");
--
2.43.0
