mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 02:20:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-06-22  Arnaud Charlet  <charlet@adacore.com>

	* fmap.adb, opt.ads, osint.adb, osint.ads, output.ads, scng.adb,
	sinput-c.adb, switch-m.ads, tree_io.ads: Use simpler form of
	Warnings Off/On.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* einfo.ads: Minor reformatting.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Thunk): Do not generate thunk of
	eliminated primitives.
	(Make_DT): Avoid referencing eliminated primitives.
	(Register_Primitive): Do not register eliminated primitives in the
	dispatch table. Required to add this functionality when the program is
	compiled without static dispatch tables (-gnatd.t)

From-SVN: r161183
This commit is contained in:
Arnaud Charlet 2010-06-22 15:26:32 +02:00
parent fa5aa83538
commit 9e9df9da7b
12 changed files with 89 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2010-06-22 Arnaud Charlet <charlet@adacore.com>
* fmap.adb, opt.ads, osint.adb, osint.ads, output.ads, scng.adb,
sinput-c.adb, switch-m.ads, tree_io.ads: Use simpler form of
Warnings Off/On.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* einfo.ads: Minor reformatting.
2010-06-22 Javier Miranda <miranda@adacore.com>
* exp_disp.adb (Expand_Interface_Thunk): Do not generate thunk of
eliminated primitives.
(Make_DT): Avoid referencing eliminated primitives.
(Register_Primitive): Do not register eliminated primitives in the
dispatch table. Required to add this functionality when the program is
compiled without static dispatch tables (-gnatd.t)
2010-06-22 Emmanuel Briot <briot@adacore.com>
* fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads,

4
gcc/ada/einfo.ads
View File

@ -2477,7 +2477,7 @@ package Einfo is
-- Applicable to all entities, true if the entity denotes a private
-- component of a protected type.
-- Is_Protected_Interface (Synthesized)
-- Is_Protected_Interface (synthesized)
-- Present in types that are interfaces. True if interface is declared
-- protected, or is derived from protected interfaces.
@ -2598,7 +2598,7 @@ package Einfo is
-- Is_Tagged_Type (Flag55)
-- Present in all entities. Set for an entity for a tagged type.
-- Is_Task_Interface (Synthesized)
-- Is_Task_Interface (synthesized)
-- Present in types that are interfaces. True if interface is declared as
-- a task interface, or if it is derived from task interfaces.

54
gcc/ada/exp_disp.adb
View File

@ -1474,10 +1474,15 @@ package body Exp_Disp is
Thunk_Id := Empty;
Thunk_Code := Empty;
-- No thunk needed if the primitive has been eliminated
if Is_Eliminated (Ultimate_Alias (Prim)) then
return;
-- In case of primitives that are functions without formals and a
-- controlling result there is no need to build the thunk.
if not Present (First_Formal (Target)) then
elsif not Present (First_Formal (Target)) then
pragma Assert (Ekind (Target) = E_Function
and then Has_Controlling_Result (Target));
return;
@ -3689,6 +3694,7 @@ package body Exp_Disp is
if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim)
and then not Is_Eliminated (Prim)
and then not Present (Prim_Table
(UI_To_Int (DT_Position (Prim))))
then
@ -3979,10 +3985,17 @@ package body Exp_Disp is
while Present (Prim_Elmt) loop
Prim := Node (Prim_Elmt);
-- Do not reference predefined primitives because they
-- are located in a separate dispatch table; skip also
-- abstract and eliminated primitives.
-- Why do we skip imported primitives???
if not Is_Predefined_Dispatching_Operation (Prim)
and then Present (Interface_Alias (Prim))
and then not Is_Abstract_Subprogram (Alias (Prim))
and then not Is_Imported (Alias (Prim))
and then not Is_Eliminated (Alias (Prim))
and then Find_Dispatching_Type
(Interface_Alias (Prim)) = Iface
@ -5379,6 +5392,7 @@ package body Exp_Disp is
if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim)
and then not Is_Eliminated (Prim)
and then not Present (Prim_Table
(UI_To_Int (DT_Position (Prim))))
then
@ -5525,23 +5539,25 @@ package body Exp_Disp is
E := Ultimate_Alias (Prim);
if Is_Imported (Prim)
or else Present (Interface_Alias (Prim))
or else Is_Predefined_Dispatching_Operation (Prim)
or else Is_Eliminated (E)
-- Do not reference predefined primitives because they are
-- located in a separate dispatch table; skip entities with
-- attribute Interface_Alias because they are only required
-- to build secondary dispatch tables; skip also abstract
-- and eliminated primitives.
-- Why do we skip imported primitives???
if not Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Predefined_Dispatching_Operation (E)
and then not Present (Interface_Alias (Prim))
and then not Is_Abstract_Subprogram (E)
and then not Is_Imported (E)
and then not Is_Eliminated (E)
then
null;
pragma Assert
(UI_To_Int (DT_Position (Prim)) <= Nb_Prim);
else
if not Is_Predefined_Dispatching_Operation (E)
and then not Is_Abstract_Subprogram (E)
and then not Present (Interface_Alias (E))
then
pragma Assert
(UI_To_Int (DT_Position (Prim)) <= Nb_Prim);
Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
end if;
Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
end if;
Next_Elmt (Prim_Elmt);
@ -6741,7 +6757,11 @@ package body Exp_Disp is
begin
pragma Assert (not Restriction_Active (No_Dispatching_Calls));
if not RTE_Available (RE_Tag) then
-- Do not register in the dispatch table eliminated primitives
if not RTE_Available (RE_Tag)
or else Is_Eliminated (Ultimate_Alias (Prim))
then
return L;
end if;

7
gcc/ada/fmap.adb
View File

@ -23,17 +23,16 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Table;
with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with Unchecked_Conversion;

7
gcc/ada/opt.ads
View File

@ -38,15 +38,14 @@
-- use the Project Manager. These tools include gnatmake, gnatname, the gnat
-- driver, gnatclean, gprbuild and gprclean.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Hostparm; use Hostparm;
with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.Strings; use System.Strings;
with System.WCh_Con; use System.WCh_Con;
pragma Warnings (On);
package Opt is

7
gcc/ada/osint.adb
View File

@ -23,10 +23,6 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Alloc;
with Debug;
with Fmap; use Fmap;
@ -40,7 +36,10 @@ with Targparm; use Targparm;
with Unchecked_Conversion;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.Case_Util; use System.Case_Util;
pragma Warnings (On);
with GNAT.HTable;

9
gcc/ada/osint.ads
View File

@ -26,15 +26,16 @@
-- This package contains the low level, operating system routines used in the
-- compiler and binder for command line processing and file input output.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Namet; use Namet;
with Types; use Types;
with System; use System;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with System.Storage_Elements;
pragma Elaborate_All (System.OS_Lib);

7
gcc/ada/output.ads
View File

@ -33,14 +33,13 @@
-- writing error messages and informational output. It is also used by the
-- debug source file output routines (see Sprint.Print_Debug_Line).
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Hostparm; use Hostparm;
with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package Output is
pragma Elaborate_Body;

8
gcc/ada/scng.adb
View File

@ -23,11 +23,6 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use of this unit is non-portable*");
pragma Warnings (Off, "*use * instead");
with Csets; use Csets;
with Err_Vars; use Err_Vars;
with Hostparm; use Hostparm;
@ -42,9 +37,12 @@ with Uintp; use Uintp;
with Urealp; use Urealp;
with Widechar; use Widechar;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.CRC32;
with System.UTF_32; use System.UTF_32;
with System.WCh_Con; use System.WCh_Con;
pragma Warnings (On);
package body Scng is

7
gcc/ada/sinput-c.adb
View File

@ -23,16 +23,15 @@
-- --
------------------------------------------------------------------------------
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Opt; use Opt;
with System; use System;
with Ada.Unchecked_Conversion;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package body Sinput.C is

7
gcc/ada/switch-m.ads
View File

@ -29,11 +29,10 @@
-- switches that are recognized. In addition, package Debug documents
-- the otherwise undocumented debug switches that are also recognized.
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with Prj.Tree;

11
gcc/ada/tree_io.ads
View File

@ -34,14 +34,13 @@
-- create and close routines are elsewhere (in Osint in the compiler, and in
-- the tree read driver for the tree read interface).
-- This unit is used by gnatcoll
pragma Warnings (Off, "*is an internal GNAT unit");
pragma Warnings (Off, "*use * instead");
with Types; use Types;
with System; use System;
with Types; use Types;
with System; use System;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package Tree_IO is