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> 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. * repinfo.adb (Write_Unknown_Val): New procedure.
(List_GCC_Expression): Call it. (List_GCC_Expression): Call it.
(List_Record_Layout): Likewise. (List_Record_Layout): Likewise.
......
gcc/ada/repinfo.adb
...@@ -891,6 +891,13 @@ package body Repinfo is ...@@ -891,6 +891,13 @@ package body Repinfo is
Prefix_Length : Natural := 0); Prefix_Length : Natural := 0);
-- Internal recursive procedure to compute the max length -- 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 procedure List_Record_Layout
(Ent : Entity_Id; (Ent : Entity_Id;
Starting_Position : Uint := Uint_0; Starting_Position : Uint := Uint_0;
...@@ -1002,84 +1009,31 @@ package body Repinfo is ...@@ -1002,84 +1009,31 @@ package body Repinfo is
end loop; end loop;
end Compute_Max_Length; end Compute_Max_Length;
------------------------ ---------------------------
-- List_Record_Layout -- -- List_Component_Layout --
------------------------ ---------------------------
procedure List_Record_Layout procedure List_Component_Layout
(Ent : Entity_Id; (Ent : Entity_Id;
Starting_Position : Uint := Uint_0; Starting_Position : Uint := Uint_0;
Starting_First_Bit : Uint := Uint_0; Starting_First_Bit : Uint := Uint_0;
Prefix : String := "") Prefix : String := "")
is is
Comp : Entity_Id; Esiz : constant Uint := Esize (Ent);
Npos : constant Uint := Normalized_Position (Ent);
begin Fbit : constant Uint := Normalized_First_Bit (Ent);
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);
Spos : Uint; Spos : Uint;
Sbit : Uint; Sbit : Uint;
Lbit : Uint; Lbit : Uint;
begin 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 (" ");
Write_Str (Prefix); Write_Str (Prefix);
Write_Str (Name_Buffer (1 .. Name_Len)); Write_Str (Name_Buffer (1 .. Name_Len));
Spaces (Max_Name_Length - Prefix'Length - Name_Len);
for J in 1 .. Max_Name_Length - Prefix'Length - Name_Len loop
Write_Char (' ');
end loop;
Write_Str (" at "); Write_Str (" at ");
if Known_Static_Normalized_Position (Comp) then if Known_Static_Normalized_Position (Ent) then
Spos := Starting_Position + Npos; Spos := Starting_Position + Npos;
Sbit := Starting_First_Bit + Fbit; Sbit := Starting_First_Bit + Fbit;
...@@ -1091,7 +1045,7 @@ package body Repinfo is ...@@ -1091,7 +1045,7 @@ package body Repinfo is
Spaces (Max_Spos_Length - UI_Image_Length); Spaces (Max_Spos_Length - UI_Image_Length);
Write_Str (UI_Image_Buffer (1 .. 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 and then List_Representation_Info = 3
then then
Spaces (Max_Spos_Length - 2); Spaces (Max_Spos_Length - 2);
...@@ -1104,19 +1058,8 @@ package body Repinfo is ...@@ -1104,19 +1058,8 @@ package body Repinfo is
Write_Val (Npos); Write_Val (Npos);
else 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; Write_Unknown_Val;
end if; end if;
end if;
Write_Str (" range "); Write_Str (" range ");
Sbit := Starting_First_Bit + Fbit; Sbit := Starting_First_Bit + Fbit;
...@@ -1134,8 +1077,8 @@ package body Repinfo is ...@@ -1134,8 +1077,8 @@ package body Repinfo is
-- that a size of zero is real, since otherwise gigi back -- that a size of zero is real, since otherwise gigi back
-- annotates using No_Uint as the value to indicate unknown. -- annotates using No_Uint as the value to indicate unknown.
if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp)) if (Esize (Ent) = Uint_0 or else Known_Static_Esize (Ent))
and then Known_Static_Normalized_First_Bit (Comp) and then Known_Static_Normalized_First_Bit (Ent)
then then
Lbit := Sbit + Esiz - 1; Lbit := Sbit + Esiz - 1;
...@@ -1145,18 +1088,18 @@ package body Repinfo is ...@@ -1145,18 +1088,18 @@ package body Repinfo is
UI_Write (Lbit); 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 -- special case. Officially a value of zero for Esize means
-- unknown, but here we use the fact that we know that gigi -- unknown, but here we use the fact that we know that gigi
-- annotates Esize with No_Uint, not Uint_0. Really everyone -- annotates Esize with No_Uint, not Uint_0. Really everyone
-- should use No_Uint??? -- should use No_Uint???
elsif List_Representation_Info < 3 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 then
Write_Unknown_Val; Write_Unknown_Val;
-- List_Representation >= 3 and Known_Esize (Comp) -- List_Representation >= 3 and Known_Esize (Ent)
else else
Write_Val (Esiz, Paren => True); Write_Val (Esiz, Paren => True);
...@@ -1184,6 +1127,75 @@ package body Repinfo is ...@@ -1184,6 +1127,75 @@ package body Repinfo is
end if; end if;
Write_Line (";"); 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; end;
<<Continue>> <<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