Commit 7b47778e by Arnaud Charlet

[multiple changes]

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.

From-SVN: r235106
parent 6e9ecd1f
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
......
......@@ -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) \
......
------------------------------------------------------------------------------
-- --
-- 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;
------------------------------------------------------------------------------
-- --
-- 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;
......@@ -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 --
-------------------
......
......@@ -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 --
......
......@@ -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;
......
......@@ -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);
......
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