+2016-04-18 Arnaud Charlet <charlet@adacore.com>
+
+ * a-intsig.ads, a-intsig.adb: Removed, no longer used.
+ * Makefile.rtl: update accordingly.
+
+2016-04-18 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_type.adb (Disambiguate): Call Covers only when necessary
+ for standard operators.
+
+2016-04-18 Eric Botcazou <ebotcazou@adacore.com>
+
+ * 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 <ebotcazou@adacore.com>
+
+ * 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 <lambourg@adacore.com>
* sigtramp-vxworks-target.inc: sigtramp-vxworks: force the stack
a-dispat$(objext) \
a-dynpri$(objext) \
a-interr$(objext) \
- a-intsig$(objext) \
a-intnam$(objext) \
a-reatim$(objext) \
a-retide$(objext) \
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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 --
--- <http://www.gnu.org/licenses/>. --
--- --
--- 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;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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 --
--- <http://www.gnu.org/licenses/>. --
--- --
--- 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;
with Sinput; use Sinput;
with Tree_IO; use Tree_IO;
+with GNAT.Heap_Sort_G;
+
package body Atree is
Reporting_Proc : Report_Proc := null;
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 --
-----------------------------
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 --
-------------------
-- 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 --
-- 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;
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;
---------------------------
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);
projects / gcc.git / commitdiff