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)



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161183 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 89 insertions, 58 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0dd0ed344c1..cf49abfa38e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 3d846fe063f..4912644575b 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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.
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e754a2e2b62..e6dc68c5207 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -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)
-                  then
-                     null;
+                  --  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.
 
-                  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);
+                  --  Why do we skip imported primitives???
 
-                        Prim_Table (UI_To_Int (DT_Position (Prim))) := E;
-                     end if;
+                  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
+                     pragma Assert
+                       (UI_To_Int (DT_Position (Prim)) <= Nb_Prim);
+
+                     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;
 
diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb
index 2dd07c05e9a..171f7a18e7d 100644
--- a/gcc/ada/fmap.adb
+++ b/gcc/ada/fmap.adb
@@ -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;
 
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 9319f2dcc42..66af7cd425d 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -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
 
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index bbce9198784..75995e3fca4 100644
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -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;
 
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index 08d074a406f..4c55a3b5a7c 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -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);
diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads
index 0f121786e12..ddc395448d3 100644
--- a/gcc/ada/output.ads
+++ b/gcc/ada/output.ads
@@ -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;
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 383d8847272..d4005b47989 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -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
 
diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb
index 3c7a882e559..aebdcacdd12 100644
--- a/gcc/ada/sinput-c.adb
+++ b/gcc/ada/sinput-c.adb
@@ -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
 
diff --git a/gcc/ada/switch-m.ads b/gcc/ada/switch-m.ads
index 9ae4860021e..de7ccaf5d5d 100644
--- a/gcc/ada/switch-m.ads
+++ b/gcc/ada/switch-m.ads
@@ -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;
 
diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads
index f70c92f6b27..0cb17fed26f 100644
--- a/gcc/ada/tree_io.ads
+++ b/gcc/ada/tree_io.ads
@@ -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