From 1804faa419c5a5ce91e60a5d67acd1e28c318944 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 May 2017 10:55:03 +0200 Subject: [PATCH] [multiple changes] 2017-05-02 Ed Schonberg * exp_ch3.adb (Build_Initialization_Call): Generate a null statement if the initialization call is a null procedure, as can happen with a controlled type with no explicit Initialize procedure, or an array of such. * exp_ch7.adb (Process_Object_Declaration): For a type with controlled components that has a trivial Initialize procedure, insert declaration for finalization counter after object declaration itself. (Make_Deep_Array_Body, Build_Initialize_statements): Do not create finalization block and attendant declarations if component has a trivial Initialize procedure. (Make_Init_Call): Do not generate a call if controlled type has a trivial Initialize procedure. 2017-05-02 Eric Botcazou * g-forstr.ads (Data): Move Format component last. * g-forstr.adb ("+"): Adjust for above change. * g-rewdat.ads (Buffer): Move Buffer, Current, Pattern and Value last. * g-sechas.ads (Context): Move Key last. * g-socket.ads (Service_Entry_Type): Move Aliases last. * s-fileio.adb (Temp_File_Record): Move Name last. * s-regexp.adb (Regexp_Value): Move Case_Sensitive last. * xr_tabls.ads (Project_File): Move Src_Dir and Obj_Dir last. 2017-05-02 Jerome Lambourg * bindusg.adb, bindgen.adb, gnatbind.adb, opt.ads: Remove the -nognarl switch introduced recently. finally not needed. 2017-05-02 Hristian Kirtchev * sem_ch6.adb (Analyze_Null_Procedure): Set the Corresponding_Body link for a null procedure declaration. From-SVN: r247475 --- gcc/ada/ChangeLog | 37 +++++++++++++++++++++++++++++++++++++ gcc/ada/bindgen.adb | 4 +--- gcc/ada/bindusg.adb | 5 ----- gcc/ada/exp_ch3.adb | 9 +++++++++ gcc/ada/exp_ch7.adb | 36 +++++++++++++++++++++++++++++++++++- gcc/ada/g-forstr.adb | 6 +++--- gcc/ada/g-forstr.ads | 4 ++-- gcc/ada/g-rewdat.ads | 14 +++++++------- gcc/ada/g-sechas.ads | 8 ++++---- gcc/ada/g-socket.ads | 4 ++-- gcc/ada/gnatbind.adb | 3 --- gcc/ada/opt.ads | 4 ---- gcc/ada/s-fileio.adb | 2 +- gcc/ada/s-regexp.adb | 4 ++-- gcc/ada/sem_ch6.adb | 7 ++++++- gcc/ada/xr_tabls.ads | 11 +++++------ 16 files changed, 114 insertions(+), 44 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 499d6968b94..38b35fd7b02 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,40 @@ +2017-05-02 Ed Schonberg + + * exp_ch3.adb (Build_Initialization_Call): Generate a null + statement if the initialization call is a null procedure, as + can happen with a controlled type with no explicit Initialize + procedure, or an array of such. + * exp_ch7.adb (Process_Object_Declaration): For a type with + controlled components that has a trivial Initialize procedure, + insert declaration for finalization counter after object + declaration itself. + (Make_Deep_Array_Body, Build_Initialize_statements): Do not create + finalization block and attendant declarations if component has + a trivial Initialize procedure. + (Make_Init_Call): Do not generate a call if controlled type has + a trivial Initialize procedure. + +2017-05-02 Eric Botcazou + + * g-forstr.ads (Data): Move Format component last. + * g-forstr.adb ("+"): Adjust for above change. + * g-rewdat.ads (Buffer): Move Buffer, Current, Pattern and Value last. + * g-sechas.ads (Context): Move Key last. + * g-socket.ads (Service_Entry_Type): Move Aliases last. + * s-fileio.adb (Temp_File_Record): Move Name last. + * s-regexp.adb (Regexp_Value): Move Case_Sensitive last. + * xr_tabls.ads (Project_File): Move Src_Dir and Obj_Dir last. + +2017-05-02 Jerome Lambourg + + * bindusg.adb, bindgen.adb, gnatbind.adb, opt.ads: Remove the -nognarl + switch introduced recently. finally not needed. + +2017-05-02 Hristian Kirtchev + + * sem_ch6.adb (Analyze_Null_Procedure): Set the + Corresponding_Body link for a null procedure declaration. + 2017-05-02 Eric Botcazou * atree.h (Flag290): Add missing terminating parenthesis. diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 7e3e9811217..59b43e0c27e 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -2853,9 +2853,7 @@ package body Bindgen is -- used: System.OS_Interface should always be used by any tasking -- application. - if not Opt.No_Libgnarl then - Check_Package (With_GNARL, "system.os_interface%s"); - end if; + Check_Package (With_GNARL, "system.os_interface%s"); -- Ditto for the use of restricted tasking diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index ceaa264d622..6cf7710219e 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -178,11 +178,6 @@ package body Bindusg is Write_Line (" -n No Ada main program (foreign main routine)"); - -- Line for -nognarl - - Write_Line - (" -nognarl Don't use libgnarl when writing linker instructions"); - -- Line for -nostdinc Write_Line diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c1275238866..899accd3012 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1431,6 +1431,15 @@ package body Exp_Ch3 is if Is_Null_Init_Proc (Proc) and then not Init_Or_Norm_Scalars then return Empty_List; + + -- Nothing to do for an array of controlled components that have only + -- the inherited Initialize primitive. This is a useful optimization + -- for CodePeer. + + elsif Is_Trivial_Subprogram (Proc) + and then Is_Array_Type (Full_Init_Type) + then + return New_List (Make_Null_Statement (Loc)); end if; -- Use the [underlying] full view when dealing with a private type. This diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 4baca7cca3e..d25ad63f87a 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2945,6 +2945,14 @@ package body Exp_Ch7 is Find_Last_Init (Count_Ins, Body_Ins); end if; + -- If the Initialize function is null or trivial, the call will have + -- been replaced with a null statement, in which case place counter + -- declaration after object declaration itself. + + if No (Count_Ins) then + Count_Ins := Decl; + end if; + Insert_After (Count_Ins, Inc_Decl); Analyze (Inc_Decl); @@ -6144,7 +6152,12 @@ package body Exp_Ch7 is Init_Call := Build_Initialization_Call; - if Present (Init_Call) then + -- Only create finalization block if there is a non-trivial + -- call to initialization. + + if Present (Init_Call) + and then Nkind (Init_Call) /= N_Null_Statement + then Init_Loop := Make_Block_Statement (Loc, Handled_Statement_Sequence => @@ -6351,6 +6364,15 @@ package body Exp_Ch7 is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts))); + -- If there are no calls to component initialization, indicate that + -- the procedure is trivial, so prevent calls to it. + + if Is_Empty_List (Stmts) + or else Nkind (First (Stmts)) = N_Null_Statement + then + Set_Is_Trivial_Subprogram (Proc_Id); + end if; + return Proc_Id; end Make_Deep_Proc; @@ -8180,6 +8202,18 @@ package body Exp_Ch7 is Check_Visibly_Controlled (Initialize_Case, Typ, Proc, Ref); end if; + -- If initialization procedure for an array of controlled objects is + -- trivial, do not generate a useless call to it. + + if (Is_Array_Type (Utyp) and then Is_Trivial_Subprogram (Proc)) + or else + (not Comes_From_Source (Proc) + and then Present (Alias (Proc)) + and then Is_Trivial_Subprogram (Alias (Proc))) + then + return Make_Null_Statement (Loc); + end if; + -- The object reference may need another conversion depending on the -- type of the formal and that of the actual. diff --git a/gcc/ada/g-forstr.adb b/gcc/ada/g-forstr.adb index 5652c111791..21ed66ec6f5 100644 --- a/gcc/ada/g-forstr.adb +++ b/gcc/ada/g-forstr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2014-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2014-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- -- @@ -130,8 +130,8 @@ package body GNAT.Formatted_String is begin return Formatted_String' (Finalization.Controlled with - D => new Data'(Format'Length, 1, Format, 1, - Null_Unbounded_String, 0, 0, (0, 0))); + D => new Data'(Format'Length, 1, 1, + Null_Unbounded_String, 0, 0, (0, 0), Format)); end "+"; --------- diff --git a/gcc/ada/g-forstr.ads b/gcc/ada/g-forstr.ads index 88856a35b3a..165440c0e9c 100644 --- a/gcc/ada/g-forstr.ads +++ b/gcc/ada/g-forstr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2014-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2014-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- -- @@ -287,12 +287,12 @@ private type Data (Size : Natural) is record Ref_Count : Natural := 1; - Format : String (1 .. Size); -- the format string Index : Positive := 1; -- format index for next value Result : Unbounded_String; -- current value Current : Natural; -- the current format number Stored_Value : Natural := 0; -- number of stored values in Stack Stack : I_Vars; + Format : String (1 .. Size); -- the format string end record; type Data_Access is access Data; diff --git a/gcc/ada/g-rewdat.ads b/gcc/ada/g-rewdat.ads index b525192f28c..994b3eeae2e 100644 --- a/gcc/ada/g-rewdat.ads +++ b/gcc/ada/g-rewdat.ads @@ -5,7 +5,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2014-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- -- @@ -128,6 +128,12 @@ private type Buffer (Size, Size_Pattern, Size_Value : Stream_Element_Offset) is limited record + Pos_C : Stream_Element_Offset; -- last valid element in Current + Pos_B : Stream_Element_Offset; -- last valid element in Buffer + + Next : Buffer_Ref; + -- A link to another rewriter if any + Buffer : Stream_Element_Array (1 .. Size); -- Fully prepared/rewritten data waiting to be output @@ -141,12 +147,6 @@ private Value : Stream_Element_Array (1 .. Size_Value); -- The value the pattern is replaced by - - Pos_C : Stream_Element_Offset; -- last valid element in Current - Pos_B : Stream_Element_Offset; -- last valid element in Buffer - - Next : Buffer_Ref; - -- A link to another rewriter if any end record; end GNAT.Rewrite_Data; diff --git a/gcc/ada/g-sechas.ads b/gcc/ada/g-sechas.ads index 33e635ce544..99e48e6a6b6 100644 --- a/gcc/ada/g-sechas.ads +++ b/gcc/ada/g-sechas.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-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- -- @@ -208,14 +208,14 @@ package GNAT.Secure_Hashes is -- KL is 0 for a normal hash context, > 0 for HMAC type Context (KL : Key_Length := 0) is record - Key : Stream_Element_Array (1 .. KL); - -- HMAC key - H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State; -- Function-specific state M_State : Message_State (Block_Length); -- Function-independent state (block buffer) + + Key : Stream_Element_Array (1 .. KL); + -- HMAC key end record; Initial_Context : constant Context (KL => 0) := (others => <>); diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index d80f0ad2667..d16310a76d2 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2016, AdaCore -- +-- Copyright (C) 2001-2017, AdaCore -- -- -- -- 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- -- @@ -1268,9 +1268,9 @@ private type Service_Entry_Type (Aliases_Length : Natural) is record Official : Name_Type; - Aliases : Name_Array (1 .. Aliases_Length); Port : Port_Type; Protocol : Name_Type; + Aliases : Name_Array (1 .. Aliases_Length); end record; type Request_Flag_Type is mod 2 ** 8; diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index ed1138d3dcc..6c778bb597e 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -447,9 +447,6 @@ procedure Gnatbind is elsif Argv (2 .. Argv'Last) = "nostdinc" then Opt.No_Stdinc := True; - elsif Argv (2 .. Argv'Last) = "nognarl" then - Opt.No_Libgnarl := True; - -- -static elsif Argv (2 .. Argv'Last) = "static" then diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index c73b6222ae3..ee7b5551777 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1147,10 +1147,6 @@ package Opt is -- GNATMAKE, GNATBIND, GNATFIND, GNATXREF -- Set to True if no default library search dirs added to search list. - No_Libgnarl : Boolean := False; - -- GNATBIND - -- Set to True if libgnarl is not available in the runtime. - No_Strict_Aliasing : Boolean := False; -- GNAT -- Set True if pragma No_Strict_Aliasing with no parameters encountered. diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index bc98a9f87b3..6c449389fd8 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -63,8 +63,8 @@ package body System.File_IO is type Temp_File_Record is record File : AFCB_Ptr; - Name : String (1 .. max_path_len + 1); Next : aliased Temp_File_Record_Ptr; + Name : String (1 .. max_path_len + 1); end record; -- One of these is allocated for each temporary file created diff --git a/gcc/ada/s-regexp.adb b/gcc/ada/s-regexp.adb index 8324504168f..58a63a2a5c5 100644 --- a/gcc/ada/s-regexp.adb +++ b/gcc/ada/s-regexp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2016, AdaCore -- +-- Copyright (C) 1999-2017, AdaCore -- -- -- -- 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- -- @@ -68,9 +68,9 @@ package body System.Regexp is Num_States : State_Index) is record Map : Mapping; + Case_Sensitive : Boolean; States : Regexp_Array (1 .. Num_States, 0 .. Alphabet_Size); Is_Final : Boolean_Array (1 .. Num_States); - Case_Sensitive : Boolean; end record; -- Deterministic finite-state machine diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 61e4f86c6ca..760487ffb88 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1450,6 +1450,12 @@ package body Sem_Ch6 is Is_Completion := False; + -- Link the body to the null procedure spec + + if Nkind (N) = N_Subprogram_Declaration then + Set_Corresponding_Body (N, Defining_Entity (Null_Body)); + end if; + -- Null procedures are always inlined, but generic formal subprograms -- which appear as such in the internal instance of formal packages, -- need no completion and are not marked Inline. @@ -1457,7 +1463,6 @@ package body Sem_Ch6 is if Expander_Active and then Nkind (N) /= N_Formal_Concrete_Subprogram_Declaration then - Set_Corresponding_Body (N, Defining_Entity (Null_Body)); Set_Body_To_Inline (N, Null_Body); Set_Is_Inlined (Designator); end if; diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads index 03949ced0bf..71d2ce23ea1 100644 --- a/gcc/ada/xr_tabls.ads +++ b/gcc/ada/xr_tabls.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1998-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-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- -- @@ -292,12 +292,11 @@ package Xr_Tabls is private type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record - Src_Dir : String (1 .. Src_Dir_Length); - Src_Dir_Index : Integer; - - Obj_Dir : String (1 .. Obj_Dir_Length); + Src_Dir_Index : Integer; Obj_Dir_Index : Integer; Last_Obj_Dir_Start : Natural; + Src_Dir : String (1 .. Src_Dir_Length); + Obj_Dir : String (1 .. Obj_Dir_Length); end record; type Project_File_Ptr is access all Project_File; @@ -364,7 +363,6 @@ private type Declaration_Record (Symbol_Length : Natural) is record Key : Cst_String_Access; - Symbol : String (1 .. Symbol_Length); Decl : Reference; Is_Parameter : Boolean := False; -- True if entity is subprog param Decl_Type : Character; @@ -374,6 +372,7 @@ private Match : Boolean := False; Par_Symbol : Declaration_Reference := null; Next : Declaration_Reference := null; + Symbol : String (1 .. Symbol_Length); end record; -- The lists of referenced (Body_Ref, Ref_Ref and Modif_Ref) are -- kept unsorted until the results needs to be printed. This saves -- 2.30.2