===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 2001-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -1143,19 +1143,24 @@
while Ptr <= Max loop
C := Switch_Chars (Ptr);
- if C in '1' .. '3' then
+ case C is
+
+ when '0' .. '3' =>
List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0');
- elsif Switch_Chars (Ptr) = 's' then
+ when 's' =>
List_Representation_Info_To_File := True;
- elsif Switch_Chars (Ptr) = 'm' then
+ when 'm' =>
List_Representation_Info_Mechanisms := True;
- else
+ when 'e' =>
+ List_Representation_Info_Extended := True;
+
+ when others =>
Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
- end if;
+ end case;
Ptr := Ptr + 1;
end loop;
===================================================================
@@ -392,7 +392,7 @@
Write_Switch_Char ("R?");
Write_Line
- ("List rep info (?=0/1/2/3/m for none/types/all/variable/mechanisms)");
+ ("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");
===================================================================
@@ -357,7 +357,7 @@
-- information for all internal type and object entities, as well
-- as all user defined type and object entities including private
-- and incomplete types. This debug switch also automatically sets
- -- the equivalent of -gnatR3m.
+ -- the equivalent of -gnatRm.
-- dB Output debug encodings for types and variants. See Exp_Dbug for
-- exact form of the generated output.
===================================================================
@@ -540,7 +540,7 @@
Configurable_Run_Time_Mode := True;
end if;
- -- Set -gnatR3m mode if debug flag A set
+ -- Set -gnatRm mode if debug flag A set
if Debug_Flag_AA then
Back_Annotate_Rep_Info := True;
===================================================================
@@ -854,213 +854,327 @@
----------------------
procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
- Comp : Entity_Id;
- Cfbit : Uint;
- Sunit : Uint;
- Max_Name_Length : Natural;
- Max_Suni_Length : Natural;
+ procedure Compute_Max_Length
+ (Ent : Entity_Id;
+ Starting_Position : Uint := Uint_0;
+ Starting_First_Bit : Uint := Uint_0;
+ Prefix_Length : Natural := 0);
+ -- Internal recursive procedure to compute the max length
- begin
- Blank_Line;
- List_Type_Info (Ent);
+ procedure List_Record_Layout
+ (Ent : Entity_Id;
+ Starting_Position : Uint := Uint_0;
+ Starting_First_Bit : Uint := Uint_0;
+ Prefix : String := "");
+ -- Internal recursive procedure to display the layout
- Write_Str ("for ");
- List_Name (Ent);
- Write_Line (" use record");
+ Max_Name_Length : Natural := 0;
+ Max_Spos_Length : Natural := 0;
- -- First loop finds out max line length and max starting position
- -- length, for the purpose of lining things up nicely.
+ ------------------------
+ -- Compute_Max_Length --
+ ------------------------
- Max_Name_Length := 0;
- Max_Suni_Length := 0;
+ procedure Compute_Max_Length
+ (Ent : Entity_Id;
+ Starting_Position : Uint := Uint_0;
+ Starting_First_Bit : Uint := Uint_0;
+ Prefix_Length : Natural := 0)
+ is
+ Comp : Entity_Id;
- Comp := First_Component_Or_Discriminant (Ent);
- while Present (Comp) loop
+ begin
+ Comp := First_Component_Or_Discriminant (Ent);
+ while Present (Comp) loop
- -- Skip discriminant in unchecked union (since it is not there!)
+ -- Skip discriminant in unchecked union (since it is not there!)
- if Ekind (Comp) = E_Discriminant
- and then Is_Unchecked_Union (Ent)
- then
- null;
+ if Ekind (Comp) = E_Discriminant
+ and then Is_Unchecked_Union (Ent)
+ then
+ goto Continue;
+ end if;
- -- All other cases
+ -- All other cases
- else
- Get_Decoded_Name_String (Chars (Comp));
- Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
+ declare
+ Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
+ Bofs : constant Uint := Component_Bit_Offset (Comp);
+ Npos : Uint;
+ Fbit : Uint;
+ Spos : Uint;
+ Sbit : Uint;
+ Name_Length : Natural;
+ begin
+ Get_Decoded_Name_String (Chars (Comp));
+ Name_Length := Prefix_Length + Name_Len;
- Cfbit := Component_Bit_Offset (Comp);
+ if Rep_Not_Constant (Bofs) then
- if Rep_Not_Constant (Cfbit) then
+ -- If the record is not packed, then we know that all fields
+ -- whose position is not specified have starting normalized
+ -- bit position of zero.
- -- If the record is not packed, then we know that all fields
- -- whose position is not specified have a starting normalized
- -- bit position of zero.
+ if Unknown_Normalized_First_Bit (Comp)
+ and then not Is_Packed (Ent)
+ then
+ Set_Normalized_First_Bit (Comp, Uint_0);
+ end if;
- if Unknown_Normalized_First_Bit (Comp)
- and then not Is_Packed (Ent)
- then
- Set_Normalized_First_Bit (Comp, Uint_0);
- end if;
+ UI_Image_Length := 2; -- For "??" marker
+ else
+ Npos := Bofs / SSU;
+ Fbit := Bofs mod SSU;
- UI_Image_Length := 2; -- For "??" marker
- else
- -- Complete annotation in case not done
+ -- Complete annotation in case not done
- if Unknown_Normalized_First_Bit (Comp) then
- Set_Normalized_Position (Comp, Cfbit / SSU);
- Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
+ if Unknown_Normalized_First_Bit (Comp) then
+ Set_Normalized_Position (Comp, Npos);
+ Set_Normalized_First_Bit (Comp, Fbit);
+ end if;
+
+ Spos := Starting_Position + Npos;
+ Sbit := Starting_First_Bit + Fbit;
+ if Sbit >= SSU then
+ Spos := Spos + 1;
+ Sbit := Sbit - SSU;
+ end if;
+
+ -- 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)
+ then
+ Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
+ goto Continue;
+ end if;
+
+ UI_Image (Spos);
end if;
- Sunit := Cfbit / SSU;
- UI_Image (Sunit);
- end if;
+ Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
+ Max_Spos_Length :=
+ Natural'Max (Max_Spos_Length, UI_Image_Length);
+ end;
- Max_Suni_Length := Natural'Max (Max_Suni_Length, UI_Image_Length);
- end if;
+ <<Continue>>
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+ end Compute_Max_Length;
- Next_Component_Or_Discriminant (Comp);
- end loop;
+ ------------------------
+ -- List_Record_Layout --
+ ------------------------
- -- Second loop does actual output based on those values
+ procedure List_Record_Layout
+ (Ent : Entity_Id;
+ Starting_Position : Uint := Uint_0;
+ Starting_First_Bit : Uint := Uint_0;
+ Prefix : String := "")
+ is
+ Comp : Entity_Id;
- Comp := First_Component_Or_Discriminant (Ent);
- while Present (Comp) loop
+ begin
+ Comp := First_Component_Or_Discriminant (Ent);
+ while Present (Comp) loop
- -- Skip discriminant in unchecked union (since it is not there!)
+ -- 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;
+ if Ekind (Comp) = E_Discriminant
+ and then Is_Unchecked_Union (Ent)
+ then
+ goto Continue;
+ end if;
- -- All other cases
+ -- All other cases
- declare
- Esiz : constant Uint := Esize (Comp);
- Bofs : constant Uint := Component_Bit_Offset (Comp);
- Npos : constant Uint := Normalized_Position (Comp);
- Fbit : constant Uint := Normalized_First_Bit (Comp);
- Lbit : Uint;
+ declare
+ Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
+ Esiz : constant Uint := Esize (Comp);
+ Bofs : constant Uint := Component_Bit_Offset (Comp);
+ Npos : constant Uint := Normalized_Position (Comp);
+ Fbit : constant Uint := Normalized_First_Bit (Comp);
+ Spos : Uint;
+ Sbit : Uint;
+ Lbit : Uint;
- begin
- Write_Str (" ");
- Get_Decoded_Name_String (Chars (Comp));
- Set_Casing (Unit_Casing);
- Write_Str (Name_Buffer (1 .. Name_Len));
+ begin
+ Get_Decoded_Name_String (Chars (Comp));
+ Set_Casing (Unit_Casing);
- for J in 1 .. Max_Name_Length - Name_Len loop
- Write_Char (' ');
- end loop;
+ -- If extended information is requested, recurse fully into
+ -- record components, i.e. skip the outer level.
- Write_Str (" at ");
+ 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;
- if Known_Static_Normalized_Position (Comp) then
- UI_Image (Npos);
- Spaces (Max_Suni_Length - UI_Image_Length);
- Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
+ Write_Str (" ");
+ Write_Str (Prefix);
+ Write_Str (Name_Buffer (1 .. Name_Len));
- elsif Known_Component_Bit_Offset (Comp)
- and then List_Representation_Info = 3
- then
- Spaces (Max_Suni_Length - 2);
- Write_Str ("bit offset");
- Write_Val (Bofs, Paren => True);
- Write_Str (" size in bits = ");
- Write_Val (Esiz, Paren => True);
- Write_Eol;
- goto Continue;
+ for J in 1 .. Max_Name_Length - Prefix'Length - Name_Len loop
+ Write_Char (' ');
+ end loop;
- elsif Known_Normalized_Position (Comp)
- and then List_Representation_Info = 3
- then
- Spaces (Max_Suni_Length - 2);
- Write_Val (Npos);
+ Write_Str (" at ");
- else
- -- For the packed case, we don't know the bit positions if we
- -- don't know the starting position.
+ if Known_Static_Normalized_Position (Comp) then
+ Spos := Starting_Position + Npos;
+ Sbit := Starting_First_Bit + Fbit;
+ if Sbit >= SSU then
+ Spos := Spos + 1;
+ end if;
+ UI_Image (Spos);
+ Spaces (Max_Spos_Length - UI_Image_Length);
+ Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
- if Is_Packed (Ent) then
- Write_Line ("?? range ? .. ??;");
+ elsif Known_Component_Bit_Offset (Comp)
+ and then List_Representation_Info = 3
+ then
+ Spaces (Max_Spos_Length - 2);
+ Write_Str ("bit offset");
+ if Starting_Position /= Uint_0
+ or else Starting_First_Bit /= Uint_0
+ then
+ Write_Char (' ');
+ UI_Write (Starting_Position * SSU + Starting_First_Bit);
+ Write_Str (" +");
+ end if;
+ Write_Val (Bofs, Paren => True);
+ Write_Str (" size in bits = ");
+ Write_Val (Esiz, Paren => True);
+ Write_Eol;
goto Continue;
- -- Otherwise we can continue
+ elsif Known_Normalized_Position (Comp)
+ and then List_Representation_Info = 3
+ then
+ Spaces (Max_Spos_Length - 2);
+ if Starting_Position /= Uint_0 then
+ Write_Char (' ');
+ UI_Write (Starting_Position);
+ Write_Str (" +");
+ end if;
+ Write_Val (Npos);
else
- Write_Str ("??");
- end if;
- end if;
+ -- For the packed case, we don't know the bit positions if
+ -- we don't know the starting position.
- Write_Str (" range ");
- UI_Write (Fbit);
- Write_Str (" .. ");
+ if Is_Packed (Ent) then
+ Write_Line ("?? range ? .. ??;");
+ goto Continue;
- -- Allowing Uint_0 here is an annoying special case. Really this
- -- should be a fine Esize value but currently it means unknown,
- -- except that we know after gigi has back annotated that a size
- -- of zero is real, since otherwise gigi back annotates using
- -- No_Uint as the value to indicate unknown).
+ -- Otherwise we can continue
- if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
- and then Known_Static_Normalized_First_Bit (Comp)
- then
- Lbit := Fbit + Esiz - 1;
+ else
+ Write_Str ("??");
+ end if;
+ end if;
- if Lbit < 10 then
- Write_Char (' ');
+ Write_Str (" range ");
+ Sbit := Starting_First_Bit + Fbit;
+ if Sbit >= SSU then
+ Sbit := Sbit - SSU;
end if;
+ UI_Write (Sbit);
+ Write_Str (" .. ");
- UI_Write (Lbit);
+ -- Allowing Uint_0 here is an annoying special case. Really
+ -- this should be a fine Esize value but currently it means
+ -- unknown, except that we know after gigi has back annotated
+ -- that a size of zero is real, since otherwise gigi back
+ -- annotates using No_Uint as the value to indicate unknown).
- -- The test for Esize (Comp) 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???
+ if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
+ and then Known_Static_Normalized_First_Bit (Comp)
+ then
+ Lbit := Sbit + Esiz - 1;
- elsif List_Representation_Info < 3
- or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
- then
- Write_Str ("??");
+ if Lbit < 10 then
+ Write_Char (' ');
+ end if;
- -- List_Representation >= 3 and Known_Esize (Comp)
+ UI_Write (Lbit);
- else
- Write_Val (Esiz, Paren => True);
+ -- The test for Esize (Comp) 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???
- -- If in front end layout mode, then dynamic size is stored
- -- in storage units, so renormalize for output
+ elsif List_Representation_Info < 3
+ or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
+ then
+ Write_Str ("??");
- if not Back_End_Layout then
- Write_Str (" * ");
- Write_Int (SSU);
- end if;
+ -- List_Representation >= 3 and Known_Esize (Comp)
- -- Add appropriate first bit offset
+ else
+ Write_Val (Esiz, Paren => True);
- if Fbit = 0 then
- Write_Str (" - 1");
+ -- If in front end layout mode, then dynamic size is stored
+ -- in storage units, so renormalize for output
- elsif Fbit = 1 then
- null;
+ if not Back_End_Layout then
+ Write_Str (" * ");
+ Write_Int (SSU);
+ end if;
- else
- Write_Str (" + ");
- Write_Int (UI_To_Int (Fbit) - 1);
+ -- Add appropriate first bit offset
+
+ if Sbit = 0 then
+ Write_Str (" - 1");
+
+ elsif Sbit = 1 then
+ null;
+
+ else
+ Write_Str (" + ");
+ Write_Int (UI_To_Int (Sbit) - 1);
+ end if;
end if;
- end if;
- Write_Line (";");
- end;
+ Write_Line (";");
+ end;
- <<Continue>>
- Next_Component_Or_Discriminant (Comp);
- end loop;
+ <<Continue>>
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+ end List_Record_Layout;
+ begin
+ Blank_Line;
+ List_Type_Info (Ent);
+
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Line (" use record");
+
+ -- First find out max line length and max starting position
+ -- length, for the purpose of lining things up nicely.
+
+ Compute_Max_Length (Ent);
+
+ -- Then do actual output based on those values
+
+ List_Record_Layout (Ent);
+
Write_Line ("end record;");
List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
===================================================================
@@ -982,6 +982,11 @@
-- 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
This adds a -gnatRe variant to the -gnatR switch, which displays extended representation information for components of records that are themselves records by recursing on the layout of sub-components. This also makes the compiler accept -gnatR0, as documented in the User Guide. For the following package: pragma No_Component_Reordering; package P is type Int7 is mod 2 ** 7; for Int7'Size use 7; type Rec1 is record I1 : Integer; I2 : Int7; B1 : Boolean; B2 : Boolean; end record; pragma Pack (Rec1); type Rec2 is record B : Boolean; C : Character; R1 : Rec1; I : Integer; end record; pragma Pack (Rec2); type Rec3 is record B1 : Boolean; B2 : Boolean; R2 : Rec2; C : Character; end record; pragma Pack (Rec3); end P; the compiler must give the following information with -gnatRe: Representation information for unit P (spec) for Rec1'Object_Size use 48; for Rec1'Value_Size use 41; for Rec1'Alignment use 1; for Rec1 use record I1 at 0 range 0 .. 31; I2 at 4 range 0 .. 6; B1 at 4 range 7 .. 7; B2 at 5 range 0 .. 0; end record; for Rec2'Object_Size use 88; for Rec2'Value_Size use 82; for Rec2'Alignment use 1; for Rec2 use record B at 0 range 0 .. 0; C at 0 range 1 .. 8; R1.I1 at 1 range 1 .. 32; R1.I2 at 5 range 1 .. 7; R1.B1 at 6 range 0 .. 0; R1.B2 at 6 range 1 .. 1; I at 6 range 2 .. 33; end record; for Rec3'Object_Size use 96; for Rec3'Value_Size use 92; for Rec3'Alignment use 1; for Rec3 use record B1 at 0 range 0 .. 0; B2 at 0 range 1 .. 1; R2.B at 0 range 2 .. 2; R2.C at 0 range 3 .. 10; R2.R1.I1 at 1 range 3 .. 34; R2.R1.I2 at 5 range 3 .. 9; R2.R1.B1 at 6 range 2 .. 2; R2.R1.B2 at 6 range 3 .. 3; R2.I at 6 range 4 .. 35; C at 10 range 4 .. 11; end record; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-08 Eric Botcazou <ebotcazou@adacore.com> * debug.adb (dA): Adjust comment. * gnat1drv.adb (Gnat1drv): Likewise. * opt.ads (List_Representation_Info_Extended): New variable. * repinfo.adb (List_Record_Info): Split implementation into... (Compute_Max_Length): ...this. Recurse on records if requested. (List_Record_Layout): Likewise. * switch-c.adb (Scan_Front_End_Switches) <'R'>: Use case statement, accept '0' and set List_Representation_Info_Extended on 'e'. * usage.adb (Usage): Document new -gnatRe variant.