Skip to content

R
riscv-gcc-1
Commit 1c912574 by Arnaud Charlet
Options

[multiple changes] 

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.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case Default_Storage_Pool):
	Do not save the given entity in the global variable Default_Pool
	if the pragma appears within a generic unit.

2017-09-08  Bob Duff  <duff@adacore.com>

	* errout.adb (Delete_Warning): Do not
	decrement Warnings_Treated_As_Errors. This is called before
	Warnings_Treated_As_Errors has been incremented to account for
	this warning. Decrementing it here can lead to negative values
	of Warnings_Treated_As_Errors, raising Constraint_Error in
	checks-on builds, and causing the compiler to return an error
	code in checks-off builds.

From-SVN: r251873
parent f0478a53
Showing with 213 additions and 60 deletions
gcc/ada/ChangeLog
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.
2017-09-08 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Default_Storage_Pool):
Do not save the given entity in the global variable Default_Pool
if the pragma appears within a generic unit.
2017-09-08 Bob Duff <duff@adacore.com>
* errout.adb (Delete_Warning): Do not
decrement Warnings_Treated_As_Errors. This is called before
Warnings_Treated_As_Errors has been incremented to account for
this warning. Decrementing it here can lead to negative values
of Warnings_Treated_As_Errors, raising Constraint_Error in
checks-on builds, and causing the compiler to return an error
code in checks-off builds.
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect
......
gcc/ada/debug.adb
......@@ -357,7 +357,7 @@ package body Debug is
-- 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.
......
gcc/ada/errout.adb
......@@ -1434,10 +1434,6 @@ package body Errout is
if Errors.Table (E).Info then
Warning_Info_Messages := Warning_Info_Messages - 1;
end if;
if Errors.Table (E).Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if;
end if;
end Delete_Warning;
......
gcc/ada/gnat1drv.adb
......@@ -540,7 +540,7 @@ procedure Gnat1drv is
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;
......
gcc/ada/opt.ads
......@@ -982,6 +982,11 @@ package Opt is
-- 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
......
gcc/ada/repinfo.adb
......@@ -854,27 +854,37 @@ package body Repinfo is
----------------------
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;
begin
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
......@@ -883,20 +893,27 @@ package body Repinfo is
if Ekind (Comp) = E_Discriminant
and then Is_Unchecked_Union (Ent)
then
null;
goto Continue;
end if;
-- All other cases
else
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));
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
Name_Length := Prefix_Length + Name_Len;
Cfbit := Component_Bit_Offset (Comp);
if Rep_Not_Constant (Cfbit) then
if Rep_Not_Constant (Bofs) then
-- If the record is not packed, then we know that all fields
-- whose position is not specified have a starting normalized
-- whose position is not specified have starting normalized
-- bit position of zero.
if Unknown_Normalized_First_Bit (Comp)
......@@ -907,25 +924,59 @@ package body Repinfo is
UI_Image_Length := 2; -- For "??" marker
else
Npos := Bofs / SSU;
Fbit := Bofs mod SSU;
-- 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);
Set_Normalized_Position (Comp, Npos);
Set_Normalized_First_Bit (Comp, Fbit);
end if;
Sunit := Cfbit / SSU;
UI_Image (Sunit);
Spos := Starting_Position + Npos;
Sbit := Starting_First_Bit + Fbit;
if Sbit >= SSU then
Spos := Spos + 1;
Sbit := Sbit - SSU;
end if;
Max_Suni_Length := Natural'Max (Max_Suni_Length, UI_Image_Length);
-- 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;
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
Max_Spos_Length :=
Natural'Max (Max_Spos_Length, UI_Image_Length);
end;
<<Continue>>
Next_Component_Or_Discriminant (Comp);
end loop;
end Compute_Max_Length;
------------------------
-- 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;
begin
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
......@@ -940,34 +991,70 @@ package body Repinfo is
-- All other cases
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);
-- 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 - Name_Len loop
for J in 1 .. Max_Name_Length - Prefix'Length - Name_Len loop
Write_Char (' ');
end loop;
Write_Str (" at ");
if Known_Static_Normalized_Position (Comp) then
UI_Image (Npos);
Spaces (Max_Suni_Length - UI_Image_Length);
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));
elsif Known_Component_Bit_Offset (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
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);
......@@ -977,12 +1064,17 @@ package body Repinfo is
elsif Known_Normalized_Position (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
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
-- For the packed case, we don't know the bit positions if we
-- don't know the starting position.
-- 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 ? .. ??;");
......@@ -996,19 +1088,23 @@ package body Repinfo is
end if;
Write_Str (" range ");
UI_Write (Fbit);
Sbit := Starting_First_Bit + Fbit;
if Sbit >= SSU then
Sbit := Sbit - SSU;
end if;
UI_Write (Sbit);
Write_Str (" .. ");
-- 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).
-- 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).
if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
and then Known_Static_Normalized_First_Bit (Comp)
then
Lbit := Fbit + Esiz - 1;
Lbit := Sbit + Esiz - 1;
if Lbit < 10 then
Write_Char (' ');
......@@ -1042,15 +1138,15 @@ package body Repinfo is
-- Add appropriate first bit offset
if Fbit = 0 then
if Sbit = 0 then
Write_Str (" - 1");
elsif Fbit = 1 then
elsif Sbit = 1 then
null;
else
Write_Str (" + ");
Write_Int (UI_To_Int (Fbit) - 1);
Write_Int (UI_To_Int (Sbit) - 1);
end if;
end if;
......@@ -1060,6 +1156,24 @@ package body Repinfo is
<<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;");
......
gcc/ada/sem_prag.adb
......@@ -14393,10 +14393,14 @@ package body Sem_Prag is
-- Record the pool name (or null). Freeze.Freeze_Entity for an
-- access type will use this information to set the appropriate
-- attributes of the access type.
-- attributes of the access type. If the pragma appears in a
-- generic unit it is ignored, given that it may refer to a
-- local entity.
if not Inside_A_Generic then
Default_Pool := Pool;
end if;
end if;
end Default_Storage_Pool;
-------------
gcc/ada/switch-c.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2016, Free Software Foundation, Inc. --
-- 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 @@ package body Switch.C is
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;
......
gcc/ada/usage.adb
......@@ -392,7 +392,7 @@ begin
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");
......
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