2009-04-22 Bob Duff <duff@adacore.com>

	* exp_pakd.adb: Minor comment fixes.

	* sinfo.ads, par-load.adb, sem_ch10.adb, lib-load.ads, lib-load.adb
	sem_ch12.adb: Change the meaning of the Library_Unit attribute to
	include units containing instantiations, as well as units that are
	generic instantiations.

	* sem.adb: Include dependents and corresponding specs/bodies in the
	unit walk.

	* gcc-interface/Make-lang.in:
	sem now depends on s-bitops, because of the packed array of Booleans.



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

10 files changed, 366 insertions, 85 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6074e3f439a..bcd2dd9c92e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2009-04-22  Bob Duff  <duff@adacore.com>
+
+	* exp_pakd.adb: Minor comment fixes.
+
+	* sinfo.ads, par-load.adb, sem_ch10.adb, lib-load.ads, lib-load.adb
+	sem_ch12.adb: Change the meaning of the Library_Unit attribute to
+	include units containing instantiations, as well as units that are
+	generic instantiations.
+
+	* sem.adb: Include dependents and corresponding specs/bodies in the
+	unit walk.
+
+	* gcc-interface/Make-lang.in:
+	sem now depends on s-bitops, because of the packed array of Booleans.
+
 2009-04-22  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/ada-tree.def: Fix formatting nits.
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index ad22ec1f5c9..ed7ac4b9e76 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -1824,7 +1824,7 @@ package body Exp_Pakd is
 
       --    Result : Ltype;
 
-      --    System.Bitops.Bit_And/Or/Xor
+      --    System.Bit_Ops.Bit_And/Or/Xor
       --     (Left'Address,
       --      Ltype'Length * Ltype'Component_Size;
       --      Right'Address,
@@ -2183,7 +2183,7 @@ package body Exp_Pakd is
 
       --    Result : Typ;
 
-      --    System.Bitops.Bit_Not
+      --    System.Bit_Ops.Bit_Not
       --     (Opnd'Address,
       --      Typ'Length * Typ'Component_Size;
       --      Result'Address);
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in
index bbc8e8123ae..5973262f20c 100644
--- a/gcc/ada/gcc-interface/Make-lang.in
+++ b/gcc/ada/gcc-interface/Make-lang.in
@@ -1,6 +1,6 @@
 # Top level -*- makefile -*- fragment for GNU Ada (GNAT).
 #   Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-#   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+#   2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 #This file is part of GCC.
 
@@ -118,7 +118,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
 
 # Object files from Ada sources that are used by gnat1
 
-GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
+GNAT_ADA_OBJS = ada/s-bitops.o ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
  ada/a-elchha.o ada/a-ioexce.o \
  ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
  ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/ali.o \
@@ -2406,15 +2406,15 @@ ada/gnat1drv.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/sem_type.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
    ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \
    ada/sprint.ads ada/stand.ads ada/stringt.ads ada/system.ads \
-   ada/s-assert.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
-   ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
-   ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
-   ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
-   ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
-   ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads ada/treepr.ads \
-   ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
-   ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/usage.ads \
-   ada/widechar.ads 
+   ada/s-assert.ads ada/s-bitops.ads ada/s-exctab.ads ada/s-htable.ads \
+   ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+   ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+   ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+   ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+   ada/table.adb ada/targparm.ads ada/tree_gen.ads ada/tree_io.ads \
+   ada/treepr.ads ada/ttypes.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
+   ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
+   ada/usage.ads ada/widechar.ads 
 
 ada/gnatbind.o : ada/ada.ads ada/a-comlin.ads ada/a-clrefi.ads \
    ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads ada/ali.ads \
@@ -2871,6 +2871,10 @@ ada/s-assert.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
    ada/s-stoele.adb ada/s-traent.ads 
 
+ada/s-bitops.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
+   ada/system.ads ada/s-bitops.ads ada/s-bitops.adb ada/s-parame.ads \
+   ada/s-stalib.ads ada/s-traent.ads ada/s-unstyp.ads 
+
 ada/s-carun8.o : ada/ada.ads ada/a-unccon.ads ada/system.ads \
    ada/s-addope.ads ada/s-addope.adb ada/s-carun8.ads ada/s-carun8.adb 
 
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 508b2e871ad..c582e1e5841 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -766,17 +766,27 @@ package body Lib.Load is
    --  declaration has been attached to a new compilation unit node, and
    --  code will have to be generated for it.
 
-   procedure Make_Instance_Unit (N : Node_Id) is
+   procedure Make_Instance_Unit (N : Node_Id; In_Main : Boolean) is
       Sind : constant Source_File_Index := Source_Index (Main_Unit);
    begin
       Units.Increment_Last;
-      Units.Table (Units.Last)               := Units.Table (Main_Unit);
-      Units.Table (Units.Last).Cunit         := Library_Unit (N);
-      Units.Table (Units.Last).Generate_Code := True;
-      Units.Table (Main_Unit).Cunit          := N;
-      Units.Table (Main_Unit).Unit_Name      :=
-        Get_Body_Name (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
-      Units.Table (Main_Unit).Version        := Source_Checksum (Sind);
+
+      if In_Main then
+         Units.Table (Units.Last)               := Units.Table (Main_Unit);
+         Units.Table (Units.Last).Cunit         := Library_Unit (N);
+         Units.Table (Units.Last).Generate_Code := True;
+         Units.Table (Main_Unit).Cunit          := N;
+         Units.Table (Main_Unit).Unit_Name      :=
+           Get_Body_Name
+             (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
+         Units.Table (Main_Unit).Version        := Source_Checksum (Sind);
+
+      else
+         --  Duplicate information from instance unit, for the body.
+         Units.Table (Units.Last) :=
+           Units.Table (Get_Cunit_Unit_Number (Library_Unit (N)));
+         Units.Table (Units.Last).Cunit := N;
+      end if;
    end Make_Instance_Unit;
 
    ------------------------
diff --git a/gcc/ada/lib-load.ads b/gcc/ada/lib-load.ads
index cc2be76bc8f..088cc382499 100644
--- a/gcc/ada/lib-load.ads
+++ b/gcc/ada/lib-load.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -169,13 +169,20 @@ package Lib.Load is
    --  creates a dummy package unit so that compilation can continue without
    --  blowing up when the missing unit is referenced.
 
-   procedure Make_Instance_Unit (N : Node_Id);
+   procedure Make_Instance_Unit (N : Node_Id; In_Main : Boolean);
    --  When a compilation unit is an instantiation, it contains both the
    --  declaration and the body of the instance, each of which can have its
    --  own elaboration routine. The file itself corresponds to the declaration.
    --  We create an additional entry for the body, so that the binder can
    --  generate the proper elaboration calls to both. The argument N is the
    --  compilation unit node created for the body.
+   --  If the instance is not the main program, we still generate the instance
+   --  body even though we do not generate code for it. In that case we still
+   --  generate a compilation unit node for it, and we need to make an entry
+   --  for it in the units table, so as to maintain a one-to-one mapping
+   --  between table and nodes. The table entry is used among other things to
+   --  provide a canonical traversal order for context units for Inspector.
+   --  The flag In_Main indicates whether the instance is the main unit.
 
    procedure Version_Update (U : Node_Id; From : Node_Id);
    --  This routine is called when unit U is found to be semantically
diff --git a/gcc/ada/par-load.adb b/gcc/ada/par-load.adb
index 4f77f7d32b9..544998b623e 100644
--- a/gcc/ada/par-load.adb
+++ b/gcc/ada/par-load.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -266,12 +266,13 @@ begin
            Error_Node => Curunit,
            Corr_Body  => Cur_Unum);
 
-      --  If we successfully load the unit, then set the spec pointer. Once
-      --  again note that if the loaded unit has a fatal error, Load will
-      --  have set our Fatal_Error flag to propagate this condition.
+      --  If we successfully load the unit, then set the spec/body
+      --  pointers. Once again note that if the loaded unit has a fatal error,
+      --  Load will have set our Fatal_Error flag to propagate this condition.
 
       if Unum /= No_Unit then
          Set_Library_Unit (Curunit, Cunit (Unum));
+         Set_Library_Unit (Cunit (Unum), Curunit);
 
          --  If this is a separate spec for the main unit, then we reset
          --  Main_Unit_Entity to point to the entity for this separate spec
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 402e17edd75..4c35ab9fc00 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -77,15 +77,28 @@ package body Sem is
    --  No_Elist, because it's too early to call New_Elmt_List; we will set it
    --  to New_Elmt_List on first use.
 
-   Ignore_Comp_Units : Boolean := False;
-   --  If True, we suppress appending compilation units onto the
-   --  Comp_Unit_List.
+   generic
+      with procedure Action (Withed_Unit : Node_Id);
+   procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean);
+   --  Walk all the with clauses of CU, and call Action for the with'ed
+   --  unit. Ignore limited withs, unless Include_Limited is True.
+   --  CU must be an N_Compilation_Unit.
+
+   generic
+      with procedure Action (Withed_Unit : Node_Id);
+   procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean);
+   --  Same as Walk_Withs_Immediate, but also include with clauses on subunits
+   --  of this unit, since they count as dependences on their parent library
+   --  item. CU must be an N_Compilation_Unit whose Unit is not an N_Subunit.
 
    procedure Write_Unit_Info
      (Unit_Num : Unit_Number_Type;
       Item     : Node_Id;
-      Prefix   : String := "");
-   --  Print out debugging information about the unit
+      Prefix   : String := "";
+      Withs    : Boolean := False);
+   --  Print out debugging information about the unit. Prefix precedes the rest
+   --  of the printout. If Withs is True, we print out units with'ed by this
+   --  unit (not counting limited withs).
 
    -------------
    -- Analyze --
@@ -1429,18 +1442,13 @@ package body Sem is
 
          Do_Analyze;
 
-         if Ignore_Comp_Units then
-            null;
-
-         elsif Present (Comp_Unit)
+         if Present (Comp_Unit)
            and then Nkind (Unit (Comp_Unit)) in N_Proper_Body
            and then not In_Extended_Main_Source_Unit (Comp_Unit)
          then
             null;
 
          else
-            pragma Assert (not Ignore_Comp_Units);
-
             --  Initialize if first time
 
             if No (Comp_Unit_List) then
@@ -1454,12 +1462,6 @@ package body Sem is
                Write_Unit_Info
                  (Get_Cunit_Unit_Number (Comp_Unit), Unit (Comp_Unit));
             end if;
-
-            --  Ignore all units after main unit
-
-            if Comp_Unit = Cunit (Main_Unit) then
-               Ignore_Comp_Units := True;
-            end if;
          end if;
       end if;
 
@@ -1501,11 +1503,21 @@ package body Sem is
 
    procedure Walk_Library_Items is
       type Unit_Number_Set is array (Main_Unit .. Last_Unit) of Boolean;
-      Seen : Unit_Number_Set := (others => False);
+      pragma Pack (Unit_Number_Set);
+      Seen, Done : Unit_Number_Set := (others => False);
+      --  Seen (X) is True after we have seen unit X in the walk. This is used
+      --  to prevent processing the same unit more than once. Done (X) is True
+      --  after we have fully processed X, and is used only for debugging
+      --  printouts and assertions.
 
       procedure Do_Action (CU : Node_Id; Item : Node_Id);
       --  Calls Action, with some validity checks
 
+      procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id);
+      --  Calls Do_Action, first on the units with'ed by this one, then on this
+      --  unit. If it's an instance body, do the spec first. If it's an
+      --  instance spec, do the body last.
+
       ---------------
       -- Do_Action --
       ---------------
@@ -1557,23 +1569,66 @@ package body Sem is
             pragma Assert (Item = Unit (CU));
 
             declare
-               Unit_Num : constant Unit_Number_Type :=
-                            Get_Cunit_Unit_Number (CU);
+               Unit_Num     : constant Unit_Number_Type :=
+                                Get_Cunit_Unit_Number (CU);
+
+               procedure Assert_Done (Withed_Unit : Node_Id);
+               --  Assert Withed_Unit is already Done
+
+               procedure Assert_Done (Withed_Unit : Node_Id) is
+               begin
+                  if not Done
+                       (Get_Cunit_Unit_Number
+                        (Withed_Unit))
+                  then
+                     Write_Unit_Name
+                       (Unit_Name
+                        (Get_Cunit_Unit_Number
+                         (Withed_Unit)));
+                     Write_Str (" not yet walked!");
+                     Write_Eol;
+                  end if;
+
+                  if False then
+                     --  This assertion is disabled because it fails in the
+                     --  presence of subunits.
+                     pragma Assert  --  ???
+                       (Done
+                          (Get_Cunit_Unit_Number (Withed_Unit)));
+                     null;
+                  end if;
+               end Assert_Done;
+
+               procedure Assert_Withed_Units_Done is
+                  new Walk_Withs (Assert_Done);
             begin
                if Debug_Unit_Walk then
                   Write_Unit_Info (Unit_Num, Item);
                end if;
 
-               --  This assertion is commented out because it fails in some
-               --  circumstances related to library-level generic
-               --  instantiations. We need to investigate why.
-               --  ???pragma Assert (not Seen (Unit_Num));
+               --  Main unit should come last
+
+               if Done (Main_Unit) then
+                  Write_Line ("Main unit is done!");
+               end if;
+               if False then  --  ???
+                  --  This assertion is disabled because it fails in the
+                  --  presence of subunits.
+                  pragma Assert (not Done (Main_Unit));
+                  null;
+               end if;
+
+               --  We shouldn't do the same thing twice
+
+               pragma Assert (not Done (Unit_Num));
+
+               --  Everything we depend upon should already be done
 
-               Seen (Unit_Num) := True;
+               Assert_Withed_Units_Done (CU, Include_Limited => False);
             end;
 
          else
-            --  Must be Standard
+            --  Must be Standard, which has no entry in the units table
 
             pragma Assert (Item = Stand.Standard_Package_Node);
 
@@ -1585,6 +1640,68 @@ package body Sem is
          Action (Item);
       end Do_Action;
 
+      ----------------------------
+      -- Do_Unit_And_Dependents --
+      ----------------------------
+
+      procedure Do_Unit_And_Dependents (CU : Node_Id; Item : Node_Id) is
+         Unit_Num     : constant Unit_Number_Type :=
+                          Get_Cunit_Unit_Number (CU);
+
+         procedure Do_Withed_Unit (Withed_Unit : Node_Id);
+         --  Pass the buck to Do_Unit_And_Dependents
+
+         procedure Do_Withed_Unit (Withed_Unit : Node_Id) is
+         begin
+            Do_Unit_And_Dependents (Withed_Unit, Unit (Withed_Unit));
+         end Do_Withed_Unit;
+
+         procedure Do_Withed_Units is new Walk_Withs (Do_Withed_Unit);
+      begin
+         if Seen (Unit_Num) then
+            return;
+         end if;
+
+         Seen (Unit_Num) := True;
+
+         --  Process corresponding spec of body first
+
+         if Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
+            declare
+               Spec_Unit : constant Node_Id := Library_Unit (CU);
+            begin
+               Do_Unit_And_Dependents (Spec_Unit, Unit (Spec_Unit));
+            end;
+         end if;
+
+         --  Process the with clauses
+
+         Do_Withed_Units (CU, Include_Limited => False);
+
+         --  Process the unit itself
+
+         if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body)
+           or else CU = Cunit (Main_Unit)
+         then
+
+            Do_Action (CU, Item);
+
+            Done (Unit_Num) := True;
+         end if;
+
+         --  Process the corresponding body last
+
+         if not Nkind_In (Item, N_Package_Body, N_Subprogram_Body) then
+            declare
+               Body_Unit : constant Node_Id := Library_Unit (CU);
+            begin
+               if Present (Body_Unit) then
+                  Do_Unit_And_Dependents (Body_Unit, Unit (Body_Unit));
+               end if;
+            end;
+         end if;
+      end Do_Unit_And_Dependents;
+
       --  Local Declarations
 
       Cur : Elmt_Id := First_Elmt (Comp_Unit_List);
@@ -1638,24 +1755,20 @@ package body Sem is
                         declare
                            Spec_Unit : constant Node_Id := Library_Unit (CU);
                         begin
-                           Do_Action (Spec_Unit, Unit (Spec_Unit));
+                           Do_Unit_And_Dependents
+                             (Spec_Unit, Unit (Spec_Unit));
                         end;
                      end if;
                   end;
 
                   if CU = Cunit (Main_Unit) then
-
-                     --  Must come last
-
-                     pragma Assert (No (Next_Elmt (Cur)));
-
-                     Do_Action (CU, N);
+                     Do_Unit_And_Dependents (CU, N);
                   end if;
 
                --  It's a spec, so just do it
 
                when others =>
-                  Do_Action (CU, N);
+                  Do_Unit_And_Dependents (CU, N);
             end case;
          end;
 
@@ -1663,14 +1776,14 @@ package body Sem is
       end loop;
 
       if Debug_Unit_Walk then
-         if Seen /= (Seen'Range => True) then
+         if Done /= (Done'Range => True) then
             Write_Eol;
             Write_Line ("Ignored units:");
 
             Indent;
 
-            for Unit_Num in Seen'Range loop
-               if not Seen (Unit_Num) then
+            for Unit_Num in Done'Range loop
+               if not Done (Unit_Num) then
                   Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num)));
                end if;
             end loop;
@@ -1679,12 +1792,93 @@ package body Sem is
          end if;
       end if;
 
+      pragma Assert (Done (Main_Unit));
+
       if Debug_Unit_Walk then
          Outdent;
          Write_Line ("end Walk_Library_Items.");
       end if;
    end Walk_Library_Items;
 
+   ----------------
+   -- Walk_Withs --
+   ----------------
+
+   procedure Walk_Withs (CU : Node_Id; Include_Limited : Boolean) is
+      pragma Assert (Nkind (CU) = N_Compilation_Unit);
+      pragma Assert (Nkind (Unit (CU)) /= N_Subunit);
+
+      procedure Walk_Immediate is new Walk_Withs_Immediate (Action);
+   begin
+      --  First walk the withs immediately on the library item
+
+      Walk_Immediate (CU, Include_Limited);
+
+      --  For a body, we must also check for any subunits which belong to
+      --  it and which have context clauses of their own, since these
+      --  with'ed units are part of its own dependencies.
+
+      if Nkind (Unit (CU)) in N_Unit_Body then
+         for S in Main_Unit .. Last_Unit loop
+
+            --  We are only interested in subunits.  For preproc. data and
+            --  def. files, Cunit is Empty, so we need to test that first.
+
+            if Cunit (S) /= Empty
+              and then Nkind (Unit (Cunit (S))) = N_Subunit
+            then
+               declare
+                  Pnode : Node_Id;
+               begin
+                  Pnode := Library_Unit (Cunit (S));
+
+                  --  In -gnatc mode, the errors in the subunits will not
+                  --  have been recorded, but the analysis of the subunit
+                  --  may have failed, so just quit.
+
+                  if No (Pnode) then
+                     exit;
+                  end if;
+
+                  --  Find ultimate parent of the subunit
+
+                  while Nkind (Unit (Pnode)) = N_Subunit loop
+                     Pnode := Library_Unit (Pnode);
+                  end loop;
+
+                  --  See if it belongs to current unit, and if so, include its
+                  --  with_clauses.
+
+                  if Pnode = CU then
+                     Walk_Immediate (Cunit (S), Include_Limited);
+                  end if;
+               end;
+            end if;
+         end loop;
+      end if;
+   end Walk_Withs;
+
+   --------------------------
+   -- Walk_Withs_Immediate --
+   --------------------------
+
+   procedure Walk_Withs_Immediate (CU : Node_Id; Include_Limited : Boolean) is
+      pragma Assert (Nkind (CU) = N_Compilation_Unit);
+
+      Context_Item : Node_Id := First (Context_Items (CU));
+   begin
+      while Present (Context_Item) loop
+         if Nkind (Context_Item) = N_With_Clause
+           and then (Include_Limited
+                     or else not Limited_Present (Context_Item))
+         then
+            Action (Library_Unit (Context_Item));
+         end if;
+
+         Context_Item := Next (Context_Item);
+      end loop;
+   end Walk_Withs_Immediate;
+
    ---------------------
    -- Write_Unit_Info --
    ---------------------
@@ -1692,7 +1886,8 @@ package body Sem is
    procedure Write_Unit_Info
      (Unit_Num : Unit_Number_Type;
       Item     : Node_Id;
-      Prefix   : String := "")
+      Prefix   : String := "";
+      Withs    : Boolean := False)
    is
    begin
       Write_Str (Prefix);
@@ -1712,6 +1907,50 @@ package body Sem is
       end if;
 
       Write_Eol;
+
+      --  Skip the rest if we're not supposed to print the withs
+
+      if False and then not Withs then -- ???
+         return;
+      end if;
+
+      declare
+         Context_Item : Node_Id := First (Context_Items (Cunit (Unit_Num)));
+      begin
+         while Present (Context_Item)
+           and then (Nkind (Context_Item) /= N_With_Clause
+                     or else Limited_Present (Context_Item))
+         loop
+            Context_Item := Next (Context_Item);
+         end loop;
+
+         if Present (Context_Item) then
+            Indent;
+            Write_Line ("withs:");
+            Indent;
+
+            while Present (Context_Item) loop
+               if Nkind (Context_Item) = N_With_Clause
+                 and then not Limited_Present (Context_Item)
+               then
+                  pragma Assert (Present (Library_Unit (Context_Item)));
+                  Write_Unit_Name
+                    (Unit_Name
+                     (Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
+                  if Implicit_With (Context_Item) then
+                     Write_Str (" -- implicit");
+                  end if;
+                  Write_Eol;
+               end if;
+
+               Context_Item := Next (Context_Item);
+            end loop;
+
+            Outdent;
+            Write_Line ("end withs");
+            Outdent;
+         end if;
+      end;
    end Write_Unit_Info;
 
 end Sem;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index cd713c84f77..791601d77b1 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -3283,7 +3283,7 @@ package body Sem_Ch10 is
                     and then Renamed_Entity (E) = WEnt
                   then
                      --  The unlimited view is visible through use clause and
-                     --  renamings. There is not need to generate the error
+                     --  renamings. There is no need to generate the error
                      --  message here because Is_Visible_Through_Renamings
                      --  takes care of generating the precise error message.
 
@@ -4322,7 +4322,7 @@ package body Sem_Ch10 is
                      then
                         --  Generate the error message only if the current unit
                         --  is a package declaration; in case of subprogram
-                        --  bodies and package bodies we just return true to
+                        --  bodies and package bodies we just return True to
                         --  indicate that the limited view must not be
                         --  installed.
 
@@ -4348,7 +4348,13 @@ package body Sem_Ch10 is
                Next (Item);
             end loop;
 
-            if Present (Library_Unit (Aux_Unit)) then
+            --  If it's a body not acting as spec, follow pointer to
+            --  corresponding spec, otherwise follow pointer to parent spec.
+
+            if Present (Library_Unit (Aux_Unit))
+              and then Nkind_In (Unit (Aux_Unit),
+                                 N_Package_Body, N_Subprogram_Body)
+            then
                if Aux_Unit = Library_Unit (Aux_Unit) then
 
                   --  Aux_Unit is a body that acts as a spec. Clause has
@@ -4359,6 +4365,7 @@ package body Sem_Ch10 is
                else
                   Aux_Unit := Library_Unit (Aux_Unit);
                end if;
+
             else
                Aux_Unit := Parent_Spec (Unit (Aux_Unit));
             end if;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 8902d0d546b..5139e50cba2 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -4393,6 +4393,7 @@ package body Sem_Ch12 is
       --  and elaboration entity are not relevant to the compilation.
 
       if Parent (N) /= Cunit (Main_Unit) then
+         Make_Instance_Unit (Body_Cunit, In_Main => False);
          return;
       end if;
 
@@ -4423,7 +4424,7 @@ package body Sem_Ch12 is
       --  Make entry in Units table, so that binder can generate call to
       --  elaboration procedure for body, if any.
 
-      Make_Instance_Unit (Body_Cunit);
+      Make_Instance_Unit (Body_Cunit, In_Main => True);
       Main_Unit_Entity := New_Main;
       Set_Cunit_Entity (Main_Unit, Main_Unit_Entity);
 
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7343a95f982..df677a44473 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1287,19 +1287,16 @@ package Sinfo is
    --
    --    In a compilation unit node, the usage depends on the unit type:
    --
-   --     For a subprogram body, Library_Unit points to the compilation unit
-   --     node of the corresponding spec, unless Acts_As_Spec is set, in which
-   --     case it points to itself.
+   --     For a library unit body, Library_Unit points to the compilation unit
+   --     node of the corresponding spec, unless it's a subprogram body with
+   --     Acts_As_Spec set, in which case it points to itself.
    --
-   --     For a package body, Library_Unit points to the compilation unit of
-   --     the corresponding package spec.
-   --
-   --     For a subprogram spec to which pragma Inline applies, Library_Unit
-   --     points to the compilation unit node of the corresponding body, if
-   --     inlining is active.
-   --
-   --     For a generic declaration, Library_Unit points to the compilation
-   --     unit node of the corresponding generic body.
+   --     For a spec, Library_Unit points to the compilation unit node of the
+   --     corresponding body, if present. The body will be present if the spec
+   --     is or contains generics that we needed to instantiate. Similarly, the
+   --     body will be present if we needed it for inlining purposes. Thus, if
+   --     we have a spec/body pair, both of which are present, they point to
+   --     each other via Library_Unit.
    --
    --     For a subunit, Library_Unit points to the compilation unit node of
    --     the parent body.