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 317 additions and 164 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> 2017-09-08 Arnaud Charlet <charlet@adacore.com>
* sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect * sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect
......
gcc/ada/debug.adb
...@@ -357,7 +357,7 @@ package body Debug is ...@@ -357,7 +357,7 @@ package body Debug is
-- information for all internal type and object entities, as well -- information for all internal type and object entities, as well
-- as all user defined type and object entities including private -- as all user defined type and object entities including private
-- and incomplete types. This debug switch also automatically sets -- 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 -- dB Output debug encodings for types and variants. See Exp_Dbug for
-- exact form of the generated output. -- exact form of the generated output.
......
gcc/ada/errout.adb
...@@ -1434,10 +1434,6 @@ package body Errout is ...@@ -1434,10 +1434,6 @@ package body Errout is
if Errors.Table (E).Info then if Errors.Table (E).Info then
Warning_Info_Messages := Warning_Info_Messages - 1; Warning_Info_Messages := Warning_Info_Messages - 1;
end if; end if;
if Errors.Table (E).Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if;
end if; end if;
end Delete_Warning; end Delete_Warning;
......
gcc/ada/gnat1drv.adb
...@@ -540,7 +540,7 @@ procedure Gnat1drv is ...@@ -540,7 +540,7 @@ procedure Gnat1drv is
Configurable_Run_Time_Mode := True; Configurable_Run_Time_Mode := True;
end if; end if;
-- Set -gnatR3m mode if debug flag A set -- Set -gnatRm mode if debug flag A set
if Debug_Flag_AA then if Debug_Flag_AA then
Back_Annotate_Rep_Info := True; Back_Annotate_Rep_Info := True;
......
gcc/ada/opt.ads
...@@ -982,6 +982,11 @@ package Opt is ...@@ -982,6 +982,11 @@ package Opt is
-- Set true by -gnatRm switch. Causes information on mechanisms to be -- Set true by -gnatRm switch. Causes information on mechanisms to be
-- included in the representation output information. -- 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; List_Preprocessing_Symbols : Boolean := False;
-- GNAT, GNATPREP -- GNAT, GNATPREP
-- Set to True if symbols for preprocessing a source are to be listed -- Set to True if symbols for preprocessing a source are to be listed
......
gcc/ada/repinfo.adb
...@@ -854,212 +854,326 @@ package body Repinfo is ...@@ -854,212 +854,326 @@ package body Repinfo is
---------------------- ----------------------
procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
Comp : Entity_Id;
Cfbit : Uint;
Sunit : Uint;
Max_Name_Length : Natural; procedure Compute_Max_Length
Max_Suni_Length : Natural; (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 begin
Blank_Line; Comp := First_Component_Or_Discriminant (Ent);
List_Type_Info (Ent); while Present (Comp) loop
Write_Str ("for "); -- Skip discriminant in unchecked union (since it is not there!)
List_Name (Ent);
Write_Line (" use record");
-- First loop finds out max line length and max starting position if Ekind (Comp) = E_Discriminant
-- length, for the purpose of lining things up nicely. and then Is_Unchecked_Union (Ent)
then
goto Continue;
end if;
Max_Name_Length := 0; -- All other cases
Max_Suni_Length := 0;
Comp := First_Component_Or_Discriminant (Ent); declare
while Present (Comp) loop 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 -- If the record is not packed, then we know that all fields
and then Is_Unchecked_Union (Ent) -- whose position is not specified have starting normalized
then -- bit position of zero.
null;
-- 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 UI_Image_Length := 2; -- For "??" marker
Get_Decoded_Name_String (Chars (Comp)); else
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len); 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 Spos := Starting_Position + Npos;
-- whose position is not specified have a starting normalized Sbit := Starting_First_Bit + Fbit;
-- bit position of zero. if Sbit >= SSU then
Spos := Spos + 1;
Sbit := Sbit - SSU;
end if;
if Unknown_Normalized_First_Bit (Comp) -- If extended information is requested, recurse fully into
and then not Is_Packed (Ent) -- record components, i.e. skip the outer level.
then
Set_Normalized_First_Bit (Comp, Uint_0);
end if;
UI_Image_Length := 2; -- For "??" marker if List_Representation_Info_Extended
else and then Is_Record_Type (Ctyp)
-- Complete annotation in case not done then
Compute_Max_Length (Ctyp, Spos, Sbit, Name_Length + 1);
goto Continue;
end if;
if Unknown_Normalized_First_Bit (Comp) then UI_Image (Spos);
Set_Normalized_Position (Comp, Cfbit / SSU);
Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
end if; end if;
Sunit := Cfbit / SSU; Max_Name_Length := Natural'Max (Max_Name_Length, Name_Length);
UI_Image (Sunit); Max_Spos_Length :=
end if; Natural'Max (Max_Spos_Length, UI_Image_Length);
end;
Max_Suni_Length := Natural'Max (Max_Suni_Length, UI_Image_Length); <<Continue>>
end if; 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); begin
while Present (Comp) loop 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 if Ekind (Comp) = E_Discriminant
and then Is_Unchecked_Union (Ent) and then Is_Unchecked_Union (Ent)
then then
goto Continue; goto Continue;
end if; end if;
-- All other cases -- All other cases
declare declare
Esiz : constant Uint := Esize (Comp); Ctyp : constant Entity_Id := Underlying_Type (Etype (Comp));
Bofs : constant Uint := Component_Bit_Offset (Comp); Esiz : constant Uint := Esize (Comp);
Npos : constant Uint := Normalized_Position (Comp); Bofs : constant Uint := Component_Bit_Offset (Comp);
Fbit : constant Uint := Normalized_First_Bit (Comp); Npos : constant Uint := Normalized_Position (Comp);
Lbit : Uint; Fbit : constant Uint := Normalized_First_Bit (Comp);
Spos : Uint;
Sbit : Uint;
Lbit : Uint;
begin begin
Write_Str (" "); Get_Decoded_Name_String (Chars (Comp));
Get_Decoded_Name_String (Chars (Comp)); Set_Casing (Unit_Casing);
Set_Casing (Unit_Casing);
Write_Str (Name_Buffer (1 .. Name_Len));
for J in 1 .. Max_Name_Length - Name_Len loop -- If extended information is requested, recurse fully into
Write_Char (' '); -- record components, i.e. skip the outer level.
end loop;
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 Write_Str (" ");
UI_Image (Npos); Write_Str (Prefix);
Spaces (Max_Suni_Length - UI_Image_Length); Write_Str (Name_Buffer (1 .. Name_Len));
Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
elsif Known_Component_Bit_Offset (Comp) for J in 1 .. Max_Name_Length - Prefix'Length - Name_Len loop
and then List_Representation_Info = 3 Write_Char (' ');
then end loop;
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;
elsif Known_Normalized_Position (Comp) Write_Str (" at ");
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
Write_Val (Npos);
else if Known_Static_Normalized_Position (Comp) then
-- For the packed case, we don't know the bit positions if we Spos := Starting_Position + Npos;
-- don't know the starting position. 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 elsif Known_Component_Bit_Offset (Comp)
Write_Line ("?? range ? .. ??;"); 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; 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 else
Write_Str ("??"); -- For the packed case, we don't know the bit positions if
end if; -- we don't know the starting position.
end if;
Write_Str (" range "); if Is_Packed (Ent) then
UI_Write (Fbit); Write_Line ("?? range ? .. ??;");
Write_Str (" .. "); goto Continue;
-- Allowing Uint_0 here is an annoying special case. Really this -- Otherwise we can continue
-- 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)) else
and then Known_Static_Normalized_First_Bit (Comp) Write_Str ("??");
then end if;
Lbit := Fbit + Esiz - 1; end if;
if Lbit < 10 then Write_Str (" range ");
Write_Char (' '); Sbit := Starting_First_Bit + Fbit;
if Sbit >= SSU then
Sbit := Sbit - SSU;
end if; 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 if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
-- special case. Officially a value of zero for Esize means and then Known_Static_Normalized_First_Bit (Comp)
-- unknown, but here we use the fact that we know that gigi then
-- annotates Esize with No_Uint, not Uint_0. Really everyone Lbit := Sbit + Esiz - 1;
-- should use No_Uint???
elsif List_Representation_Info < 3 if Lbit < 10 then
or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp)) Write_Char (' ');
then end if;
Write_Str ("??");
-- List_Representation >= 3 and Known_Esize (Comp) UI_Write (Lbit);
else -- The test for Esize (Comp) not Uint_0 here is an annoying
Write_Val (Esiz, Paren => True); -- 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 elsif List_Representation_Info < 3
-- in storage units, so renormalize for output or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
then
Write_Str ("??");
if not Back_End_Layout then -- List_Representation >= 3 and Known_Esize (Comp)
Write_Str (" * ");
Write_Int (SSU);
end if;
-- Add appropriate first bit offset else
Write_Val (Esiz, Paren => True);
if Fbit = 0 then -- If in front end layout mode, then dynamic size is stored
Write_Str (" - 1"); -- in storage units, so renormalize for output
elsif Fbit = 1 then if not Back_End_Layout then
null; Write_Str (" * ");
Write_Int (SSU);
end if;
else -- Add appropriate first bit offset
Write_Str (" + ");
Write_Int (UI_To_Int (Fbit) - 1); 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;
end if;
Write_Line (";"); Write_Line (";");
end; end;
<<Continue>> <<Continue>>
Next_Component_Or_Discriminant (Comp); Next_Component_Or_Discriminant (Comp);
end loop; 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;"); Write_Line ("end record;");
......
gcc/ada/sem_prag.adb
...@@ -14393,9 +14393,13 @@ package body Sem_Prag is ...@@ -14393,9 +14393,13 @@ package body Sem_Prag is
-- Record the pool name (or null). Freeze.Freeze_Entity for an -- Record the pool name (or null). Freeze.Freeze_Entity for an
-- access type will use this information to set the appropriate -- 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.
Default_Pool := Pool; if not Inside_A_Generic then
Default_Pool := Pool;
end if;
end if; end if;
end Default_Storage_Pool; end Default_Storage_Pool;
gcc/ada/switch-c.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1143,19 +1143,24 @@ package body Switch.C is ...@@ -1143,19 +1143,24 @@ package body Switch.C is
while Ptr <= Max loop while Ptr <= Max loop
C := Switch_Chars (Ptr); C := Switch_Chars (Ptr);
if C in '1' .. '3' then case C is
when '0' .. '3' =>
List_Representation_Info := List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0'); Character'Pos (C) - Character'Pos ('0');
elsif Switch_Chars (Ptr) = 's' then when 's' =>
List_Representation_Info_To_File := True; List_Representation_Info_To_File := True;
elsif Switch_Chars (Ptr) = 'm' then when 'm' =>
List_Representation_Info_Mechanisms := True; List_Representation_Info_Mechanisms := True;
else when 'e' =>
List_Representation_Info_Extended := True;
when others =>
Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max)); Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
end if; end case;
Ptr := Ptr + 1; Ptr := Ptr + 1;
end loop; end loop;
......
gcc/ada/usage.adb
...@@ -392,7 +392,7 @@ begin ...@@ -392,7 +392,7 @@ begin
Write_Switch_Char ("R?"); Write_Switch_Char ("R?");
Write_Line 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_Switch_Char ("R?s");
Write_Line ("List rep info to file.rep instead of standard output"); 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