From f6cf2339bbb9c65a76468a669224ab0407dc0f0d Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 18 Apr 2016 09:48:31 +0000 Subject: [PATCH] 2016-04-18 Arnaud Charlet * a-intsig.ads, a-intsig.adb: Removed, no longer used. * Makefile.rtl: update accordingly. 2016-04-18 Eric Botcazou * sem_type.adb (Disambiguate): Call Covers only when necessary for standard operators. 2016-04-18 Eric Botcazou * atree.ads (Num_Extension_Nodes): Add couple of figures to comment. * atree.adb: Add GNAT.Heap_Sort_G dependency. (Print_Statistics): New exported procedure to print statistics. 2016-04-18 Eric Botcazou * exp_ch3.adb (Build_Record_Init_Proc): Do not mark the procedure as to be inlined if the type needs finalization. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235106 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 22 +++++++++++ gcc/ada/Makefile.rtl | 1 - gcc/ada/a-intsig.adb | 46 ----------------------- gcc/ada/a-intsig.ads | 42 --------------------- gcc/ada/atree.adb | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/atree.ads | 4 ++ gcc/ada/exp_ch3.adb | 4 +- gcc/ada/sem_type.adb | 19 +++++----- 8 files changed, 140 insertions(+), 100 deletions(-) delete mode 100644 gcc/ada/a-intsig.adb delete mode 100644 gcc/ada/a-intsig.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4037a28b19a..35f45896584 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2016-04-18 Arnaud Charlet + + * a-intsig.ads, a-intsig.adb: Removed, no longer used. + * Makefile.rtl: update accordingly. + +2016-04-18 Eric Botcazou + + * sem_type.adb (Disambiguate): Call Covers only when necessary + for standard operators. + +2016-04-18 Eric Botcazou + + * atree.ads (Num_Extension_Nodes): Add couple of figures + to comment. + * atree.adb: Add GNAT.Heap_Sort_G dependency. + (Print_Statistics): New exported procedure to print statistics. + +2016-04-18 Eric Botcazou + + * exp_ch3.adb (Build_Record_Init_Proc): Do not mark the procedure + as to be inlined if the type needs finalization. + 2016-04-18 Jerome Lambourg * sigtramp-vxworks-target.inc: sigtramp-vxworks: force the stack diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 6bbf0d65487..5b492587356 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -28,7 +28,6 @@ GNATRTL_TASKING_OBJS= \ a-dispat$(objext) \ a-dynpri$(objext) \ a-interr$(objext) \ - a-intsig$(objext) \ a-intnam$(objext) \ a-reatim$(objext) \ a-retide$(objext) \ diff --git a/gcc/ada/a-intsig.adb b/gcc/ada/a-intsig.adb deleted file mode 100644 index 9470128b6ba..00000000000 --- a/gcc/ada/a-intsig.adb +++ /dev/null @@ -1,46 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- A D A . I N T E R R U P T S . S I G N A L -- --- -- --- B o d y -- --- -- --- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- --- -- --- GNARL 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - -with System.Interrupt_Management.Operations; - -package body Ada.Interrupts.Signal is - - ------------------------ - -- Generate_Interrupt -- - ------------------------ - - procedure Generate_Interrupt (Interrupt : Interrupt_ID) is - begin - System.Interrupt_Management.Operations.Interrupt_Self_Process - (System.Interrupt_Management.Interrupt_ID (Interrupt)); - end Generate_Interrupt; - -end Ada.Interrupts.Signal; diff --git a/gcc/ada/a-intsig.ads b/gcc/ada/a-intsig.ads deleted file mode 100644 index 9d98f9de371..00000000000 --- a/gcc/ada/a-intsig.ads +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- --- -- --- A D A . I N T E R R U P T S . S I G N A L -- --- -- --- S p e c -- --- -- --- Copyright (C) 2000-2009, Free Software Foundation, Inc. -- --- -- --- GNARL 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNARL was developed by the GNARL team at Florida State University. -- --- Extensive contributions were provided by Ada Core Technologies, Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package encapsulates the procedures for generating interrupts --- by user programs and avoids importing low level children of System --- (e.g. System.Interrupt_Management.Operations), or defining an interface --- to complex system calls. - -package Ada.Interrupts.Signal is - - procedure Generate_Interrupt (Interrupt : Interrupt_ID); - -- Generate interrupt at the process level - -end Ada.Interrupts.Signal; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 97f014eb9fb..67b55a91c9e 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -44,6 +44,8 @@ with Output; use Output; with Sinput; use Sinput; with Tree_IO; use Tree_IO; +with GNAT.Heap_Sort_G; + package body Atree is Reporting_Proc : Report_Proc := null; @@ -115,6 +117,10 @@ package body Atree is procedure Node_Debug_Output (Op : String; N : Node_Id); -- Common code for nnd and rrd, writes Op followed by information about N + procedure Print_Statistics; + pragma Export (Ada, Print_Statistics); + -- Print various statistics on the tables maintained by the package + ----------------------------- -- Local Objects and Types -- ----------------------------- @@ -1955,6 +1961,102 @@ package body Atree is Nodes.Table (OldN).Comes_From_Source; end Preserve_Comes_From_Source; + ---------------------- + -- Print_Statistics -- + ---------------------- + + procedure Print_Statistics is + N_Count : constant Natural := Natural (Nodes.Last - First_Node_Id + 1); + E_Count : Natural := 0; + + begin + Write_Str ("Maximum number of nodes per entity: "); + Write_Int (Int (Num_Extension_Nodes + 1)); + Write_Eol; + Write_Str ("Number of allocated nodes: "); + Write_Int (Int (N_Count)); + Write_Eol; + + Write_Str ("Number of entities: "); + Write_Eol; + + declare + function CP_Lt (Op1, Op2 : Natural) return Boolean; + -- Compare routine for Sort + + procedure CP_Move (From : Natural; To : Natural); + -- Move routine for Sort + + Kind_Count : array (Node_Kind) of Natural := (others => 0); + -- Array of occurrence count per node kind + + Kind_Max : constant Natural := Node_Kind'Pos (N_Unused_At_End) - 1; + -- The index of the largest (interesting) node kind + + Ranking : array (0 .. Kind_Max) of Node_Kind; + -- Ranking array for node kinds (index 0 is used for the temporary) + + package Sorting is new GNAT.Heap_Sort_G (CP_Move, CP_Lt); + + function CP_Lt (Op1, Op2 : Natural) return Boolean is + begin + return Kind_Count (Ranking (Op2)) < Kind_Count (Ranking (Op1)); + end CP_Lt; + + procedure CP_Move (From : Natural; To : Natural) is + begin + Ranking (To) := Ranking (From); + end CP_Move; + + begin + -- Count the number of occurrences of each node kind + + for I in First_Node_Id .. Nodes.Last loop + declare + Nkind : constant Node_Kind := Nodes.Table (I).Nkind; + begin + if not Nodes.Table (I).Is_Extension then + Kind_Count (Nkind) := Kind_Count (Nkind) + 1; + end if; + end; + end loop; + + -- Sort the node kinds by number of occurrences + + for N in 1 .. Kind_Max loop + Ranking (N) := Node_Kind'Val (N); + end loop; + + Sorting.Sort (Kind_Max); + + -- Print the list in descending order + + for N in 1 .. Kind_Max loop + declare + Count : constant Natural := Kind_Count (Ranking (N)); + begin + if Count > 0 then + Write_Str (" "); + Write_Str (Node_Kind'Image (Ranking (N))); + Write_Str (": "); + Write_Int (Int (Count)); + Write_Eol; + + E_Count := E_Count + Count; + end if; + end; + end loop; + end; + + Write_Str ("Total number of entities: "); + Write_Int (Int (E_Count)); + Write_Eol; + Write_Str ("Ratio allocated nodes/entities: "); + Write_Int (Int (N_Count * 100 / E_Count)); + Write_Str ("/100"); + Write_Eol; + end Print_Statistics; + ------------------- -- Relocate_Node -- ------------------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 8d02bb7d7cb..d94217d2322 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -76,6 +76,10 @@ package Atree is -- This value is increased by one if debug flag -gnatd.N is set. This is -- for testing performance impact of adding a new extension node. We make -- this of type Node_Id for easy reference in loops using this value. + -- Print_Statistics can be used to display statistics on entities & nodes. + -- Measurements conducted for the 5->6 bump showed an increase from 1.81 to + -- 2.01 for the nodes/entities ratio and a 2% increase in compilation time + -- on average for the GCC-based compiler at -O0 on a 32-bit x86 host. ---------------------------------------- -- Definitions of Fields in Tree Node -- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index af245ec637f..869220fdb59 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -3597,10 +3597,12 @@ package body Exp_Ch3 is -- The initialization of protected records is not worth inlining. -- In addition, when compiled for another unit for inlining purposes, -- it may make reference to entities that have not been elaborated - -- yet. Similar considerations apply to task types. + -- yet. Similar considerations apply to task types and types that + -- need finalization. if not Is_Concurrent_Type (Rec_Type) and then not Has_Task (Rec_Type) + and then not Needs_Finalization (Rec_Type) then Set_Is_Inlined (Proc_Id); end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index de8dbfb4c4c..131beb90079 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1751,17 +1751,16 @@ package body Sem_Type is begin Get_First_Interp (N, I, It); while Present (It.Typ) loop - if (Covers (Typ, It.Typ) or else Typ = Any_Type) - and then - (It.Typ = Universal_Integer + if (It.Typ = Universal_Integer or else It.Typ = Universal_Real) + and then (Typ = Any_Type or else Covers (Typ, It.Typ)) then return It; - elsif Covers (Typ, It.Typ) + elsif Is_Numeric_Type (It.Typ) and then Scope (It.Typ) = Standard_Standard and then Scope (It.Nam) = Standard_Standard - and then Is_Numeric_Type (It.Typ) + and then Covers (Typ, It.Typ) then Candidate := It; end if; @@ -3026,19 +3025,19 @@ package body Sem_Type is --------------------------- function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean is + New_First_F : constant Entity_Id := First_Formal (New_S); Op_Name : constant Name_Id := Chars (Op); T : constant Entity_Id := Etype (New_S); - New_First_F : constant Entity_Id := First_Formal (New_S); New_F : Entity_Id; - Old_F : Entity_Id; Num : Int; + Old_F : Entity_Id; T1 : Entity_Id; T2 : Entity_Id; begin - -- To verify that a predefined operator matches a given signature, - -- do a case analysis of the operator classes. Function can have one - -- or two formals and must have the proper result type. + -- To verify that a predefined operator matches a given signature, do a + -- case analysis of the operator classes. Function can have one or two + -- formals and must have the proper result type. New_F := New_First_F; Old_F := First_Formal (Op); -- 2.11.4.GIT