----------------------
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
+
+ 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
+
+ Max_Name_Length : Natural := 0;
+ Max_Spos_Length : Natural := 0;
+
+ ------------------------
+ -- Compute_Max_Length --
+ ------------------------
+
+ 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;
- begin
- Blank_Line;
- List_Type_Info (Ent);
+ begin
+ Comp := First_Component_Or_Discriminant (Ent);
+ while Present (Comp) loop
- Write_Str ("for ");
- List_Name (Ent);
- Write_Line (" use record");
+ -- Skip discriminant in unchecked union (since it is not there!)
- -- First loop finds out max line length and max starting position
- -- length, for the purpose of lining things up nicely.
+ if Ekind (Comp) = E_Discriminant
+ and then Is_Unchecked_Union (Ent)
+ then
+ goto Continue;
+ end if;
- Max_Name_Length := 0;
- Max_Suni_Length := 0;
+ -- All other cases
- Comp := First_Component_Or_Discriminant (Ent);
- while Present (Comp) loop
+ 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;
- -- Skip discriminant in unchecked union (since it is not there!)
+ if Rep_Not_Constant (Bofs) then
- if Ekind (Comp) = E_Discriminant
- and then Is_Unchecked_Union (Ent)
- then
- null;
+ -- If the record is not packed, then we know that all fields
+ -- whose position is not specified have starting normalized
+ -- bit position of zero.
- -- All other cases
+ if Unknown_Normalized_First_Bit (Comp)
+ and then not Is_Packed (Ent)
+ then
+ Set_Normalized_First_Bit (Comp, Uint_0);
+ end if;
- else
- Get_Decoded_Name_String (Chars (Comp));
- Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
+ UI_Image_Length := 2; -- For "??" marker
+ else
+ Npos := Bofs / SSU;
+ Fbit := Bofs mod SSU;
- Cfbit := Component_Bit_Offset (Comp);
+ -- Complete annotation in case not done
- if Rep_Not_Constant (Cfbit) then
+ if Unknown_Normalized_First_Bit (Comp) then
+ Set_Normalized_Position (Comp, Npos);
+ Set_Normalized_First_Bit (Comp, Fbit);
+ end if;
- -- 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.
+ Spos := Starting_Position + Npos;
+ Sbit := Starting_First_Bit + Fbit;
+ if Sbit >= SSU then
+ Spos := Spos + 1;
+ Sbit := Sbit - SSU;
+ end if;
- if Unknown_Normalized_First_Bit (Comp)
- and then not Is_Packed (Ent)
- then
- Set_Normalized_First_Bit (Comp, Uint_0);
- end if;
+ -- If extended information is requested, recurse fully into
+ -- record components, i.e. skip the outer level.
- UI_Image_Length := 2; -- For "??" marker
- else
- -- Complete annotation in case not done
+ 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;
- if Unknown_Normalized_First_Bit (Comp) then
- Set_Normalized_Position (Comp, Cfbit / SSU);
- Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
+ 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;");
projects / gcc.git / commitdiff