Commit 9e9df9da by Arnaud Charlet

[multiple changes]

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
parent fa5aa835
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> 2010-06-22 Emmanuel Briot <briot@adacore.com>
* fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads, * fmap.adb, scng.adb, switch-m.ads, sinput-c.adb, opt.ads, output.ads,
......
...@@ -2477,7 +2477,7 @@ package Einfo is ...@@ -2477,7 +2477,7 @@ package Einfo is
-- Applicable to all entities, true if the entity denotes a private -- Applicable to all entities, true if the entity denotes a private
-- component of a protected type. -- component of a protected type.
-- Is_Protected_Interface (Synthesized) -- Is_Protected_Interface (synthesized)
-- Present in types that are interfaces. True if interface is declared -- Present in types that are interfaces. True if interface is declared
-- protected, or is derived from protected interfaces. -- protected, or is derived from protected interfaces.
...@@ -2598,7 +2598,7 @@ package Einfo is ...@@ -2598,7 +2598,7 @@ package Einfo is
-- Is_Tagged_Type (Flag55) -- Is_Tagged_Type (Flag55)
-- Present in all entities. Set for an entity for a tagged type. -- 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 -- Present in types that are interfaces. True if interface is declared as
-- a task interface, or if it is derived from task interfaces. -- a task interface, or if it is derived from task interfaces.
......
...@@ -1474,10 +1474,15 @@ package body Exp_Disp is ...@@ -1474,10 +1474,15 @@ package body Exp_Disp is
Thunk_Id := Empty; Thunk_Id := Empty;
Thunk_Code := 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 -- In case of primitives that are functions without formals and a
-- controlling result there is no need to build the thunk. -- 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 pragma Assert (Ekind (Target) = E_Function
and then Has_Controlling_Result (Target)); and then Has_Controlling_Result (Target));
return; return;
...@@ -3689,6 +3694,7 @@ package body Exp_Disp is ...@@ -3689,6 +3694,7 @@ package body Exp_Disp is
if Is_Predefined_Dispatching_Operation (Prim) if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim) and then not Is_Abstract_Subprogram (Prim)
and then not Is_Eliminated (Prim)
and then not Present (Prim_Table and then not Present (Prim_Table
(UI_To_Int (DT_Position (Prim)))) (UI_To_Int (DT_Position (Prim))))
then then
...@@ -3979,10 +3985,17 @@ package body Exp_Disp is ...@@ -3979,10 +3985,17 @@ package body Exp_Disp is
while Present (Prim_Elmt) loop while Present (Prim_Elmt) loop
Prim := Node (Prim_Elmt); 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) if not Is_Predefined_Dispatching_Operation (Prim)
and then Present (Interface_Alias (Prim)) and then Present (Interface_Alias (Prim))
and then not Is_Abstract_Subprogram (Alias (Prim)) and then not Is_Abstract_Subprogram (Alias (Prim))
and then not Is_Imported (Alias (Prim)) and then not Is_Imported (Alias (Prim))
and then not Is_Eliminated (Alias (Prim))
and then Find_Dispatching_Type and then Find_Dispatching_Type
(Interface_Alias (Prim)) = Iface (Interface_Alias (Prim)) = Iface
...@@ -5379,6 +5392,7 @@ package body Exp_Disp is ...@@ -5379,6 +5392,7 @@ package body Exp_Disp is
if Is_Predefined_Dispatching_Operation (Prim) if Is_Predefined_Dispatching_Operation (Prim)
and then not Is_Abstract_Subprogram (Prim) and then not Is_Abstract_Subprogram (Prim)
and then not Is_Eliminated (Prim)
and then not Present (Prim_Table and then not Present (Prim_Table
(UI_To_Int (DT_Position (Prim)))) (UI_To_Int (DT_Position (Prim))))
then then
...@@ -5525,23 +5539,25 @@ package body Exp_Disp is ...@@ -5525,23 +5539,25 @@ package body Exp_Disp is
E := Ultimate_Alias (Prim); E := Ultimate_Alias (Prim);
if Is_Imported (Prim) -- Do not reference predefined primitives because they are
or else Present (Interface_Alias (Prim)) -- located in a separate dispatch table; skip entities with
or else Is_Predefined_Dispatching_Operation (Prim) -- attribute Interface_Alias because they are only required
or else Is_Eliminated (E) -- to build secondary dispatch tables; skip also abstract
then -- and eliminated primitives.
null;
else -- Why do we skip imported primitives???
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; if not Is_Predefined_Dispatching_Operation (Prim)
end if; 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
pragma Assert
(UI_To_Int (DT_Position (Prim)) <= Nb_Prim);
Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
end if; end if;
Next_Elmt (Prim_Elmt); Next_Elmt (Prim_Elmt);
...@@ -6741,7 +6757,11 @@ package body Exp_Disp is ...@@ -6741,7 +6757,11 @@ package body Exp_Disp is
begin begin
pragma Assert (not Restriction_Active (No_Dispatching_Calls)); 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; return L;
end if; end if;
......
...@@ -23,17 +23,16 @@ ...@@ -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 Opt; use Opt;
with Osint; use Osint; with Osint; use Osint;
with Output; use Output; with Output; use Output;
with Table; with Table;
with Types; use Types; with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with Unchecked_Conversion; with Unchecked_Conversion;
......
...@@ -38,15 +38,14 @@ ...@@ -38,15 +38,14 @@
-- use the Project Manager. These tools include gnatmake, gnatname, the gnat -- use the Project Manager. These tools include gnatmake, gnatname, the gnat
-- driver, gnatclean, gprbuild and gprclean. -- 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 Hostparm; use Hostparm;
with Types; use Types; with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.Strings; use System.Strings; with System.Strings; use System.Strings;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
pragma Warnings (On);
package Opt is package Opt is
......
...@@ -23,10 +23,6 @@ ...@@ -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 Alloc;
with Debug; with Debug;
with Fmap; use Fmap; with Fmap; use Fmap;
...@@ -40,7 +36,10 @@ with Targparm; use Targparm; ...@@ -40,7 +36,10 @@ with Targparm; use Targparm;
with Unchecked_Conversion; with Unchecked_Conversion;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.Case_Util; use System.Case_Util; with System.Case_Util; use System.Case_Util;
pragma Warnings (On);
with GNAT.HTable; with GNAT.HTable;
......
...@@ -26,15 +26,16 @@ ...@@ -26,15 +26,16 @@
-- This package contains the low level, operating system routines used in the -- This package contains the low level, operating system routines used in the
-- compiler and binder for command line processing and file input output. -- 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 Namet; use Namet;
with Types; use Types; with Types; use Types;
with System; use System; with System; use System;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with System.Storage_Elements; with System.Storage_Elements;
pragma Elaborate_All (System.OS_Lib); pragma Elaborate_All (System.OS_Lib);
......
...@@ -33,14 +33,13 @@ ...@@ -33,14 +33,13 @@
-- writing error messages and informational output. It is also used by the -- writing error messages and informational output. It is also used by the
-- debug source file output routines (see Sprint.Print_Debug_Line). -- 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 Hostparm; use Hostparm;
with Types; use Types; with Types; use Types;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package Output is package Output is
pragma Elaborate_Body; pragma Elaborate_Body;
......
...@@ -23,11 +23,6 @@ ...@@ -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 Csets; use Csets;
with Err_Vars; use Err_Vars; with Err_Vars; use Err_Vars;
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
...@@ -42,9 +37,12 @@ with Uintp; use Uintp; ...@@ -42,9 +37,12 @@ with Uintp; use Uintp;
with Urealp; use Urealp; with Urealp; use Urealp;
with Widechar; use Widechar; with Widechar; use Widechar;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.CRC32; with System.CRC32;
with System.UTF_32; use System.UTF_32; with System.UTF_32; use System.UTF_32;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
pragma Warnings (On);
package body Scng is package body Scng is
......
...@@ -23,16 +23,15 @@ ...@@ -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 Opt; use Opt;
with System; use System; with System; use System;
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
pragma Warnings (Off);
-- This package is used also by gnatcoll
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package body Sinput.C is package body Sinput.C is
......
...@@ -29,11 +29,10 @@ ...@@ -29,11 +29,10 @@
-- switches that are recognized. In addition, package Debug documents -- switches that are recognized. In addition, package Debug documents
-- the otherwise undocumented debug switches that are also recognized. -- the otherwise undocumented debug switches that are also recognized.
-- This unit is used by gnatcoll pragma Warnings (Off);
pragma Warnings (Off, "*is an internal GNAT unit"); -- This package is used also by gnatcoll
pragma Warnings (Off, "*use * instead");
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
with Prj.Tree; with Prj.Tree;
......
...@@ -34,14 +34,13 @@ ...@@ -34,14 +34,13 @@
-- create and close routines are elsewhere (in Osint in the compiler, and in -- create and close routines are elsewhere (in Osint in the compiler, and in
-- the tree read driver for the tree read interface). -- the tree read driver for the tree read interface).
-- This unit is used by gnatcoll with Types; use Types;
pragma Warnings (Off, "*is an internal GNAT unit"); with System; use System;
pragma Warnings (Off, "*use * instead");
with Types; use Types; pragma Warnings (Off);
-- This package is used also by gnatcoll
with System; use System;
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
pragma Warnings (On);
package Tree_IO is package Tree_IO is
......
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