From: Arnaud Charlet Date: Fri, 8 Sep 2017 09:25:01 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1c912574373f58b64bb0eb53560695aaf489bf43;p=gcc.git [multiple changes] 2017-09-08 Eric Botcazou * 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 * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 471a5da8c1b..53f380a2945 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2017-09-08 Eric Botcazou + + * 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 + + * 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 + + * 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 * sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 03820fd1528..3dbe1f9ae87 100644 --- a/gcc/ada/debug.adb +++ b/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. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a83d0c9225e..a04df945be8 100644 --- a/gcc/ada/errout.adb +++ b/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; diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index b1bbea90b74..e6fc897de55 100644 --- a/gcc/ada/gnat1drv.adb +++ b/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; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 8f6820a0dbf..aef84edcfac 100644 --- a/gcc/ada/opt.ads +++ b/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 diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index c42de8c1ac6..a6d60cbf1d3 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -854,212 +854,326 @@ 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 + + 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; + <> + 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; - <> - Next_Component_Or_Discriminant (Comp); - end loop; + <> + 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;"); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c9a02437e70..7bfb53e79c4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14393,9 +14393,13 @@ 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. - Default_Pool := Pool; + if not Inside_A_Generic then + Default_Pool := Pool; + end if; end if; end Default_Storage_Pool; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 176dbe46a8e..a087dd20558 100644 --- a/gcc/ada/switch-c.adb +++ b/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; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 7ffb424f1d2..1c50c7d7c7f 100644 --- a/gcc/ada/usage.adb +++ b/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");