Skip to content

R
riscv-gcc-1
Commit 7883c42e by Eric Botcazou Committed by Pierre-Marie de Rodat
Options

[Ada] Factor out worker procedure for -gnatR 

This extracts a worker procedure for printing the layout of a single component
from List_Record_Layout so as to make the next change more readable.

2018-05-29  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* repinfo.adb (List_Component_Layout): New procedure extracted from...
	(List_Record_Layout): ...here.  Invoke it.

From-SVN: r260867
parent 76b382d9
Showing with 96 additions and 79 deletions
gcc/ada/ChangeLog
2018-05-29 Eric Botcazou <ebotcazou@adacore.com>
* repinfo.adb (List_Component_Layout): New procedure extracted from...
(List_Record_Layout): ...here. Invoke it.
2018-05-29 Eric Botcazou <ebotcazou@adacore.com>
* repinfo.adb (Write_Unknown_Val): New procedure.
(List_GCC_Expression): Call it.
(List_Record_Layout): Likewise.
......
gcc/ada/repinfo.adb
......@@ -891,6 +891,13 @@ package body Repinfo is
Prefix_Length : Natural := 0);
-- Internal recursive procedure to compute the max length
procedure List_Component_Layout
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0;
Prefix : String := "");
-- Procedure to display the layout of a single component
procedure List_Record_Layout
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
......@@ -1002,84 +1009,31 @@ package body Repinfo is
end loop;
end Compute_Max_Length;
------------------------
-- List_Record_Layout --
------------------------
---------------------------
-- List_Component_Layout --
---------------------------
procedure List_Record_Layout
procedure List_Component_Layout
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0;
Prefix : String := "")
is
Comp : Entity_Id;
begin
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
-- Skip discriminant in unchecked union (since it is not there!)
if Ekind (Comp) = E_Discriminant
and then Is_Unchecked_Union (Ent)
then
goto Continue;
end if;
-- Skip _Parent component in extension (to avoid overlap)
if Chars (Comp) = Name_uParent then
goto Continue;
end if;
-- All other cases
declare
Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
Esiz : constant Uint := Esize (Comp);
Npos : constant Uint := Normalized_Position (Comp);
Fbit : constant Uint := Normalized_First_Bit (Comp);
Esiz : constant Uint := Esize (Ent);
Npos : constant Uint := Normalized_Position (Ent);
Fbit : constant Uint := Normalized_First_Bit (Ent);
Spos : Uint;
Sbit : Uint;
Lbit : Uint;
begin
Get_Decoded_Name_String (Chars (Comp));
Set_Casing (Unit_Casing);
-- If extended information is requested, recurse fully into
-- record components, i.e. skip the outer level.
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 Sbit >= SSU then
Spos := Spos + 1;
Sbit := Sbit - SSU;
end if;
List_Record_Layout (Ctyp,
Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
goto Continue;
end if;
Write_Str (" ");
Write_Str (Prefix);
Write_Str (Name_Buffer (1 .. Name_Len));
for J in 1 .. Max_Name_Length - Prefix'Length - Name_Len loop
Write_Char (' ');
end loop;
Spaces (Max_Name_Length - Prefix'Length - Name_Len);
Write_Str (" at ");
if Known_Static_Normalized_Position (Comp) then
if Known_Static_Normalized_Position (Ent) then
Spos := Starting_Position + Npos;
Sbit := Starting_First_Bit + Fbit;
......@@ -1091,7 +1045,7 @@ package body Repinfo is
Spaces (Max_Spos_Length - UI_Image_Length);
Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
elsif Known_Normalized_Position (Comp)
elsif Known_Normalized_Position (Ent)
and then List_Representation_Info = 3
then
Spaces (Max_Spos_Length - 2);
......@@ -1104,19 +1058,8 @@ package body Repinfo is
Write_Val (Npos);
else
-- For the packed case, we don't know the bit positions if
-- we don't know the starting position.
if Is_Packed (Ent) then
Write_Line ("?? range ? .. ??;");
goto Continue;
-- Otherwise we can continue
else
Write_Unknown_Val;
end if;
end if;
Write_Str (" range ");
Sbit := Starting_First_Bit + Fbit;
......@@ -1134,8 +1077,8 @@ package body Repinfo is
-- that a size of zero is real, since otherwise gigi back
-- annotates using No_Uint as the value to indicate unknown.
if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
and then Known_Static_Normalized_First_Bit (Comp)
if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent))
and then Known_Static_Normalized_First_Bit (Ent)
then
Lbit := Sbit + Esiz - 1;
......@@ -1145,18 +1088,18 @@ package body Repinfo is
UI_Write (Lbit);
-- The test for Esize (Comp) not Uint_0 here is an annoying
-- The test for Esize (Ent) not Uint_0 here is an annoying
-- special case. Officially a value of zero for Esize means
-- unknown, but here we use the fact that we know that gigi
-- annotates Esize with No_Uint, not Uint_0. Really everyone
-- should use No_Uint???
elsif List_Representation_Info < 3
or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
or else (Esize (Ent) /= Uint_0 and then Unknown_Esize (Ent))
then
Write_Unknown_Val;
-- List_Representation >= 3 and Known_Esize (Comp)
-- List_Representation >= 3 and Known_Esize (Ent)
else
Write_Val (Esiz, Paren => True);
......@@ -1184,6 +1127,75 @@ package body Repinfo is
end if;
Write_Line (";");
end List_Component_Layout;
------------------------
-- List_Record_Layout --
------------------------
procedure List_Record_Layout
(Ent : Entity_Id;
Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0;
Prefix : String := "")
is
Comp : Entity_Id;
begin
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
-- Skip discriminant in unchecked union (since it is not there!)
if Ekind (Comp) = E_Discriminant
and then Is_Unchecked_Union (Ent)
then
goto Continue;
end if;
-- Skip _Parent component in extension (to avoid overlap)
if Chars (Comp) = Name_uParent then
goto Continue;
end if;
-- 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;
begin
Get_Decoded_Name_String (Chars (Comp));
Set_Casing (Unit_Casing);
-- If extended information is requested, recurse fully into
-- record components, i.e. skip the outer level.
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 Sbit >= SSU then
Spos := Spos + 1;
Sbit := Sbit - SSU;
end if;
List_Record_Layout (Ctyp,
Spos, Sbit, Prefix & Name_Buffer (1 .. Name_Len) & ".");
goto Continue;
end if;
List_Component_Layout (Comp,
Starting_Position, Starting_First_Bit, Prefix);
end;
<<Continue>>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment