[multiple changes]

2009-04-20  Thomas Quinot  <quinot@adacore.com>

	* sem_type.adb, ali.adb, erroutc.adb: Minor code reorganization
	(no behaviour change): Use Append instead of Increment_Last followed
	by assignment.

2009-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Make_Predefined_Primitive_Specs): Do not generate the
	declarations of all primitives associated with dispatching asynchronous,
	conditional and timed selects when dispaching calls are forbidden and
	select statements are not allowed (such as in Ravenscar).
	(Predefined_Primitive_Bodies): Ditto for bodies.

	* exp_disp.ad (Make_DT): Do not create and populate the
	Select_Specific_Data of the dispatch table when dispatching calls are
	forbidden and select statements are not allowed (such as in Ravenscar).

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* a-tifiio.adb: Minor reformatting

2009-04-20  Thomas Quinot  <quinot@adacore.com>

	* g-socthi-vms.adb, g-socket.adb, g-socket.ads: inet_aton(3), unlike
	other C library functions, report *failure* with a zero status, and
	success with a non-zero status.

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

	* sem.ads, sem.adb (Walk_Library_Items): New generic procedure.
	(Semantics): After analyzing each unit, Append it to the
	Comp_Unit_List, if appropriate.

	* gnat1drv.adb (Check_Library_Items): New procedure for debugging
	purposes.
	(Gnat1drv): Correct comment regarding Back_End_Mode.

2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat_ugn.texi: Add documentation for -fno-inline-small-functions.

From-SVN: r146389

14 files changed, 361 insertions, 73 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 541c367..ebc1ea0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,47 @@
 2009-04-20  Thomas Quinot  <quinot@adacore.com>
 
+	* sem_type.adb, ali.adb, erroutc.adb: Minor code reorganization
+	(no behaviour change): Use Append instead of Increment_Last followed
+	by assignment.
+
+2009-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Make_Predefined_Primitive_Specs): Do not generate the
+	declarations of all primitives associated with dispatching asynchronous,
+	conditional and timed selects when dispaching calls are forbidden and
+	select statements are not allowed (such as in Ravenscar).
+	(Predefined_Primitive_Bodies): Ditto for bodies.
+
+	* exp_disp.ad (Make_DT): Do not create and populate the
+	Select_Specific_Data of the dispatch table when dispatching calls are
+	forbidden and select statements are not allowed (such as in Ravenscar).
+
+2009-04-20  Robert Dewar  <dewar@adacore.com>
+
+	* a-tifiio.adb: Minor reformatting
+
+2009-04-20  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socthi-vms.adb, g-socket.adb, g-socket.ads: inet_aton(3), unlike
+	other C library functions, report *failure* with a zero status, and
+	success with a non-zero status.
+
+2009-04-20  Bob Duff  <duff@adacore.com>
+
+	* sem.ads, sem.adb (Walk_Library_Items): New generic procedure.
+	(Semantics): After analyzing each unit, Append it to the
+	Comp_Unit_List, if appropriate.
+
+	* gnat1drv.adb (Check_Library_Items): New procedure for debugging
+	purposes.
+	(Gnat1drv): Correct comment regarding Back_End_Mode.
+
+2009-04-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat_ugn.texi: Add documentation for -fno-inline-small-functions.
+
+2009-04-20  Thomas Quinot  <quinot@adacore.com>
+
 	* s-taprop-irix.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
 	output.adb, output.ads, s-taprop-hpux-dce.adb,
 	s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-posix.adb: Minor
diff --git a/gcc/ada/a-tifiio.adb b/gcc/ada/a-tifiio.adb
index 22926f8..720fcac 100644
--- a/gcc/ada/a-tifiio.adb
+++ b/gcc/ada/a-tifiio.adb
@@ -290,11 +290,11 @@ package body Ada.Text_IO.Fixed_IO is
                    and then Num'Small * 10.0**Scale < 10.0);
 
    Exact : constant Boolean :=
-                Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
-            or Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small)
-            or Num'Small >= 10.0**Max_Digits;
+            Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
+             or Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small)
+             or Num'Small >= 10.0**Max_Digits;
    --  True iff a numerator and denominator can be calculated such that
-   --  their ratio exactly represents the small of Num
+   --  their ratio exactly represents the small of Num.
 
    procedure Put
      (To   : out String;
@@ -315,10 +315,8 @@ package body Ada.Text_IO.Fixed_IO is
       Width : Field := 0)
    is
       pragma Unsuppress (Range_Check);
-
    begin
       Aux.Get (File, Long_Long_Float (Item), Width);
-
    exception
       when Constraint_Error => raise Data_Error;
    end Get;
@@ -328,10 +326,8 @@ package body Ada.Text_IO.Fixed_IO is
       Width : Field := 0)
    is
       pragma Unsuppress (Range_Check);
-
    begin
       Aux.Get (Current_In, Long_Long_Float (Item), Width);
-
    exception
       when Constraint_Error => raise Data_Error;
    end Get;
@@ -342,10 +338,8 @@ package body Ada.Text_IO.Fixed_IO is
       Last : out Positive)
    is
       pragma Unsuppress (Range_Check);
-
    begin
       Aux.Gets (From, Long_Long_Float (Item), Last);
-
    exception
       when Constraint_Error => raise Data_Error;
    end Get;
@@ -387,11 +381,13 @@ package body Ada.Text_IO.Fixed_IO is
       Aft  : Field := Default_Aft;
       Exp  : Field := Default_Exp)
    is
-      Fore : constant Integer := To'Length
-                                - 1                      -- Decimal point
-                                - Field'Max (1, Aft)     -- Decimal part
-                                - Boolean'Pos (Exp /= 0) -- Exponent indicator
-                                - Exp;                   -- Exponent
+      Fore : constant Integer :=
+               To'Length
+                 - 1                      -- Decimal point
+                 - Field'Max (1, Aft)     -- Decimal part
+                 - Boolean'Pos (Exp /= 0) -- Exponent indicator
+                 - Exp;                   -- Exponent
+
       Last : Natural;
 
    begin
@@ -426,13 +422,13 @@ package body Ada.Text_IO.Fixed_IO is
       --  Add C to the output string To, updating Last
 
       procedure Put_Digit (X : Digit);
-      --  Add digit X to the output string (going from left to right),
-      --  updating Last and Pos, and inserting the sign, leading zeros
-      --  or a decimal point when necessary. After outputting the first
-      --  digit, Pos must not be changed outside Put_Digit anymore
+      --  Add digit X to the output string (going from left to right), updating
+      --  Last and Pos, and inserting the sign, leading zeros or a decimal
+      --  point when necessary. After outputting the first digit, Pos must not
+      --  be changed outside Put_Digit anymore.
 
       procedure Put_Int64 (X : Int64; Scale : Integer);
-      --  Output the decimal number abs X * 10**Scale.
+      --  Output the decimal number abs X * 10**Scale
 
       procedure Put_Scaled
         (X, Y, Z : Int64;
@@ -469,6 +465,7 @@ package body Ada.Text_IO.Fixed_IO is
       begin
          if Last = To'First - 1 then
             if X /= 0 or Pos <= 0 then
+
                --  Before outputting first digit, include leading space,
                --  possible minus sign and, if the first digit is fractional,
                --  decimal seperator and leading zeros.
@@ -541,6 +538,7 @@ package body Ada.Text_IO.Fixed_IO is
          --  If and only if more than one digit is output before the decimal
          --  point, pos will be unequal to scale when outputting the first
          --  digit.
+
          pragma Assert (Pos = Scale or else Last = To'First - 1);
 
          Pos := Scale;
@@ -560,15 +558,15 @@ package body Ada.Text_IO.Fixed_IO is
          pragma Assert (E >= -Max_Digits);
          AA : constant Field := E + A;
          N  : constant Natural := (AA + Max_Digits - 1) / Max_Digits + 1;
+
          Q  : array (0 .. N - 1) of Int64 := (others => 0);
-         --  Each element of Q has Max_Digits decimal digits, except
-         --  the last, which has eAA rem Max_Digits. Only Q (Q'First)
-         --  may have an absolute value equal to or larger than 10**Max_Digits.
-         --  Only the absolute value of the elements is not significant, not
-         --  the sign.
+         --  Each element of Q has Max_Digits decimal digits, except the
+         --  last, which has eAA rem Max_Digits. Only Q (Q'First) may have an
+         --  absolute value equal to or larger than 10**Max_Digits. Only the
+         --  absolute value of the elements is not significant, not the sign.
 
-         XX    : Int64 := X;
-         YY    : Int64 := Y;
+         XX : Int64 := X;
+         YY : Int64 := Y;
 
       begin
          for J in Q'Range loop
@@ -584,9 +582,9 @@ package body Ada.Text_IO.Fixed_IO is
          if -E > A then
             pragma Assert (N = 1);
 
-            Discard_Extra_Digits :
-            declare
+            Discard_Extra_Digits : declare
                Factor : constant Int64 := 10**(-E - A);
+
             begin
                --  The scaling factors were such that the first division
                --  produced more digits than requested. So divide away extra
@@ -602,8 +600,9 @@ package body Ada.Text_IO.Fixed_IO is
             end Discard_Extra_Digits;
          end if;
 
-         --  At this point XX is a remainder and we need to determine if
-         --  the quotient in Q must be rounded away from zero.
+         --  At this point XX is a remainder and we need to determine if the
+         --  quotient in Q must be rounded away from zero.
+
          --  As XX is less than the divisor, it is safe to take its absolute
          --  without chance of overflow. The check to see if XX is at least
          --  half the absolute value of the divisor must be done carefully to
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index efc0ac2..5e5c660 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -482,8 +482,7 @@ package body ALI is
          end if;
 
          loop
-            Name_Len := Name_Len + 1;
-            Name_Buffer (Name_Len) := Getc;
+            Add_Char_To_Name_Buffer (Getc);
 
             exit when At_End_Of_Field and not Ignore_Spaces;
 
@@ -936,8 +935,7 @@ package body ALI is
 
             Name_Len := 0;
             while not At_Eol loop
-               Name_Len := Name_Len + 1;
-               Name_Buffer (Name_Len) := Getc;
+               Add_Char_To_Name_Buffer (Getc);
             end loop;
 
             --  If -fstack-check, record that it occurred
@@ -2000,8 +1998,7 @@ package body ALI is
                if Nextc not in '0' .. '9' then
                   Name_Len := 0;
                   while not At_End_Of_Field loop
-                     Name_Len := Name_Len + 1;
-                     Name_Buffer (Name_Len) := Getc;
+                     Add_Char_To_Name_Buffer (Getc);
                   end loop;
 
                   --  Set the subunit name. Note that we use Name_Find rather
@@ -2022,8 +2019,7 @@ package body ALI is
                   Name_Len := 0;
 
                   while not At_End_Of_Field loop
-                     Name_Len := Name_Len + 1;
-                     Name_Buffer (Name_Len) := Getc;
+                     Add_Char_To_Name_Buffer (Getc);
                   end loop;
 
                   Sdep.Table (Sdep.Last).Rfile := Name_Enter;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 6e9153f..23386b8 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -926,8 +926,7 @@ package body Erroutc is
       Name_Len := 0;
 
       while J <= Text'Last and then Text (J) in 'A' .. 'Z' loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := Text (J);
+         Add_Char_To_Name_Buffer (Text (J));
          J := J + 1;
       end loop;
 
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 4442a78..629bcad 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7818,12 +7818,13 @@ package body Exp_Ch3 is
       --    Disp_Timed_Select
 
       --  These operations cannot be implemented on VM targets, so we simply
-      --  disable their generation in this case. We also disable generation
-      --  of these bodies if No_Dispatching_Calls is active.
+      --  disable their generation in this case. Disable the generation of
+      --  these bodies if No_Dispatching_Calls or Ravenscar is active.
 
       if Ada_Version >= Ada_05
         and then VM_Target = No_VM
-        and then RTE_Available (RE_Select_Specific_Data)
+        and then not Restriction_Active (No_Dispatching_Calls)
+        and then not Restriction_Active (No_Select_Statements)
       then
          --  These primitives are defined abstract in interface types
 
@@ -8311,19 +8312,19 @@ package body Exp_Ch3 is
       --  The interface versions will have null bodies
 
       --  These operations cannot be implemented on VM targets, so we simply
-      --  disable their generation in this case. We also disable generation
-      --  of these bodies if No_Dispatching_Calls is active.
+      --  disable their generation in this case. Disable the generation of
+      --  these bodies if No_Dispatching_Calls or Ravenscar is active.
 
       if Ada_Version >= Ada_05
         and then VM_Target = No_VM
-        and then not Restriction_Active (No_Dispatching_Calls)
         and then not Is_Interface (Tag_Typ)
         and then
           ((Is_Interface (Etype (Tag_Typ))
               and then Is_Limited_Record (Etype (Tag_Typ)))
            or else (Is_Concurrent_Record_Type (Tag_Typ)
-                     and then Has_Interfaces (Tag_Typ)))
-        and then RTE_Available (RE_Select_Specific_Data)
+                      and then Has_Interfaces (Tag_Typ)))
+        and then not Restriction_Active (No_Dispatching_Calls)
+        and then not Restriction_Active (No_Select_Statements)
       then
          Append_To (Res, Make_Disp_Asynchronous_Select_Body (Tag_Typ));
          Append_To (Res, Make_Disp_Conditional_Select_Body  (Tag_Typ));
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 2a6f347..54a823a 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4749,6 +4749,7 @@ package body Exp_Disp is
            and then not Is_Abstract_Type (Typ)
            and then not Is_Controlled (Typ)
            and then not Restriction_Active (No_Dispatching_Calls)
+           and then not Restriction_Active (No_Select_Statements)
          then
             Append_To (Result,
               Make_Object_Declaration (Loc,
@@ -5545,13 +5546,16 @@ package body Exp_Disp is
          Append_List_To (Result, Elab_Code);
       end if;
 
-      --  Populate the two auxiliary tables used for dispatching
-      --  asynchronous, conditional and timed selects for synchronized
-      --  types that implement a limited interface.
+      --  Populate the two auxiliary tables used for dispatching asynchronous,
+      --  conditional and timed selects for synchronized types that implement
+      --  a limited interface. Skip this step in Ravenscar profile or when
+      --  general dispatching is forbidden.
 
       if Ada_Version >= Ada_05
         and then Is_Concurrent_Record_Type (Typ)
         and then Has_Interfaces (Typ)
+        and then not Restriction_Active (No_Dispatching_Calls)
+        and then not Restriction_Active (No_Select_Statements)
       then
          Append_List_To (Result,
            Make_Select_Specific_Data_Table (Typ));
diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index f5b5d47..962a8fb 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -179,6 +179,10 @@ package body GNAT.Sockets is
    --  Reconstruct a Duration value from a Timeval record (seconds and
    --  microseconds).
 
+   procedure Raise_Socket_Error (Error : Integer);
+   --  Raise Socket_Error with an exception message describing the error code
+   --  from errno.
+
    procedure Raise_Host_Error (H_Error : Integer);
    --  Raise Host_Error exception with message describing error code (note
    --  hstrerror seems to be obsolete) from h_errno.
@@ -1288,7 +1292,7 @@ package body GNAT.Sockets is
 
       Res := Inet_Aton (To_Chars_Ptr (Img'Unchecked_Access), Addr'Address);
 
-      if Res = Failure then
+      if Res = 0 then
          Raise_Socket_Error (SOSC.EINVAL);
       end if;
 
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index 1b3ee63..3680d75 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -1108,10 +1108,6 @@ package GNAT.Sockets is
 
 private
 
-   procedure Raise_Socket_Error (Error : Integer);
-   --  Raise Socket_Error with an exception message describing the error code
-   --  from errno.
-
    type Socket_Type is new Integer;
    No_Socket : constant Socket_Type := -1;
 
diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb
index 8a143c1..d065f99 100644
--- a/gcc/ada/g-socthi-vms.adb
+++ b/gcc/ada/g-socthi-vms.adb
@@ -358,7 +358,8 @@ package body GNAT.Sockets.Thin is
    ---------------
 
    --  VMS does not support inet_aton(3), so emulate it here in terms of
-   --  inet_addr(3).
+   --  inet_addr(3). Note: unlike other C functions, inet_aton reports
+   --  failure with a 0 return, and success with a non-zero return.
 
    function Inet_Aton
      (Cp  : C.Strings.chars_ptr;
@@ -373,7 +374,7 @@ package body GNAT.Sockets.Thin is
       pragma Import (C, C_Inet_Addr, "DECC$INET_ADDR");
    begin
       if Cp = Null_Ptr or else Inp = Null_Address then
-         Raise_Socket_Error (SOSC.EINVAL);
+         return 0;
       end if;
 
       --  Special case for the all-ones broadcast address: this address has the
@@ -382,16 +383,16 @@ package body GNAT.Sockets.Thin is
 
       if String'(Value (Cp)) = "255.255.255.255" then
          Conv.To_Pointer (Inp).all := -1;
-         return 0;
+         return 1;
       end if;
 
       Res := C_Inet_Addr (Cp);
       if Res = -1 then
-         return Res;
+         return 0;
       end if;
 
       Conv.To_Pointer (Inp).all := Res;
-      return 0;
+      return 1;
    end Inet_Aton;
 
    ----------------
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 3d495ce..53b789e 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -90,6 +90,9 @@ procedure Gnat1drv is
    --  Called when we are not generating code, to check if -gnatR was requested
    --  and if so, explain that we will not be honoring the request.
 
+   procedure Check_Library_Items;
+   --  For debugging -- checks the behavior of Walk_Library_Items
+
    --------------------
    -- Check_Bad_Body --
    --------------------
@@ -251,6 +254,29 @@ procedure Gnat1drv is
       end if;
    end Check_Rep_Info;
 
+   -------------------------
+   -- Check_Library_Items --
+   -------------------------
+
+   procedure Check_Library_Items is
+      --  Walk_Library_Items has plenty of assertions, so all we need to do is
+      --  call it.
+
+      procedure Action (Item : Node_Id);
+      --  Action passed to Walk_Library_Items to do nothing
+
+      procedure Action (Item : Node_Id) is
+      begin
+         null;
+      end Action;
+
+      procedure Walk is new Sem.Walk_Library_Items (Action);
+
+      --  Start of processing for Check_Library_Items
+   begin
+      Walk;
+   end Check_Library_Items;
+
 --  Start of processing for Gnat1drv
 
 begin
@@ -578,9 +604,9 @@ begin
          Back_End_Mode := Skip;
       end if;
 
-      --  At this stage Call_Back_End is set to indicate if the backend should
-      --  be called to generate code. If it is not set, then code generation
-      --  has been turned off, even though code was requested by the original
+      --  At this stage Back_End_Mode is set to indicate if the backend should
+      --  be called to generate code. If it is Skip, then code generation has
+      --  been turned off, even though code was requested by the original
       --  command. This is not an error from the user point of view, but it is
       --  an error from the point of view of the gcc driver, so we must exit
       --  with an error status.
@@ -706,6 +732,8 @@ begin
       Namet.Lock;
       Stringt.Lock;
 
+      Check_Library_Items;  --  For debugging
+
       --  Here we call the back end to generate the output code
 
       Generating_Code := True;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 14ef446..7d573f7 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -3802,9 +3802,14 @@ effect if this switch is present.
 
 @item -fno-inline-functions
 @cindex @option{-fno-inline-functions} (@command{gcc})
-Suppresses automatic inlining of small subprograms, which is enabled
+Suppresses automatic inlining of simple subprograms, which is enabled
 if @option{-O3} is used.
 
+@item -fno-inline-small-functions
+@cindex @option{-fno-inline-small-functions} (@command{gcc})
+Suppresses automatic inlining of small subprograms, which is enabled
+if @option{-O2} is used.
+
 @item -fno-inline-functions-called-once
 @cindex @option{-fno-inline-functions-called-once} (@command{gcc})
 Suppresses inlining of subprograms local to the unit and called once
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 82be60b..c6c2c00 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -27,6 +27,7 @@
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Debug_A;  use Debug_A;
+with Elists;   use Elists;
 with Errout;   use Errout;
 with Expander; use Expander;
 with Fname;    use Fname;
@@ -34,6 +35,7 @@ with HLO;      use HLO;
 with Lib;      use Lib;
 with Lib.Load; use Lib.Load;
 with Nlists;   use Nlists;
+with Output;   use Output;
 with Sem_Attr; use Sem_Attr;
 with Sem_Ch2;  use Sem_Ch2;
 with Sem_Ch3;  use Sem_Ch3;
@@ -52,6 +54,7 @@ with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Uintp;    use Uintp;
+with Uname;    use Uname;
 
 with Unchecked_Deallocation;
 
@@ -65,6 +68,16 @@ package body Sem is
    --  generic context, it is empty. At the moment, it is only used
    --  for avoiding freezing of external references in generics.
 
+   Comp_Unit_List : Elist_Id := No_Elist;
+   --  Used by Walk_Library_Items. This is a list of N_Compilation_Unit nodes
+   --  processed by Semantics, in an appropriate order. Initialized to
+   --  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.
+
    -------------
    -- Analyze --
    -------------
@@ -1384,7 +1397,44 @@ package body Sem is
             New_Nodes_OK := 0;
          end if;
 
-         Do_Analyze;
+         --  Do analysis, and then append the compilation unit onto the
+         --  Comp_Unit_List, if appropriate. This is done after analysis, so if
+         --  this unit depends on some others, they have already been
+         --  appended. We ignore bodies, except for the main unit itself, and
+         --  everything those bodies depend upon.
+
+         if Ignore_Comp_Units then
+            Do_Analyze;
+            pragma Assert (Ignore_Comp_Units);  --  still
+
+         elsif Nkind (Unit (Comp_Unit)) in N_Proper_Body
+           and then not In_Extended_Main_Source_Unit (Comp_Unit)
+         then
+            Ignore_Comp_Units := True;
+            Do_Analyze;
+            pragma Assert (Ignore_Comp_Units);
+            Ignore_Comp_Units := False;
+
+         else
+            Do_Analyze;
+            --  pragma Assert (not Ignore_Comp_Units);
+            --  The above assertion is *almost* true. It fails only when a
+            --  subunit with's its parent procedure body, which has no explicit
+            --  spec.
+
+            if No (Comp_Unit_List) then  --  Initialize if first time
+               Comp_Unit_List := New_Elmt_List;
+            end if;
+            if not Ignore_Comp_Units then  --  See above commented-out Assert
+               Append_Elmt (Comp_Unit, Comp_Unit_List);
+            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;
 
       --  Save indication of dynamic elaboration checks for ALI file
@@ -1405,4 +1455,154 @@ package body Sem is
       Restore_Opt_Config_Switches (Save_Config_Switches);
       Expander_Mode_Restore;
    end Semantics;
+
+   ------------------------
+   -- Walk_Library_Items --
+   ------------------------
+
+   procedure Walk_Library_Items is
+      Enable_Output : constant Boolean := False;
+      --  Set to True to print out the items as we go (for debugging)
+
+      procedure Do_Action (CU : Node_Id; Item : Node_Id);
+      --  Calls Action, with some validity checks
+
+      ---------------
+      -- Do_Action --
+      ---------------
+
+      procedure Do_Action (CU : Node_Id; Item : Node_Id) is
+      begin
+         --  This calls Action at the end. All the preceding code is just
+         --  assertions and debugging output.
+
+         case Nkind (Item) is
+            when N_Generic_Subprogram_Declaration |
+              N_Generic_Package_Declaration |
+              N_Package_Declaration |
+              N_Subprogram_Declaration |
+              N_Subprogram_Renaming_Declaration |
+              N_Package_Renaming_Declaration |
+              N_Generic_Function_Renaming_Declaration |
+              N_Generic_Package_Renaming_Declaration |
+              N_Generic_Procedure_Renaming_Declaration =>
+               null;  --  Specs are OK
+
+            when N_Package_Body | N_Subprogram_Body =>
+               --  A body must be the main unit
+
+               pragma Assert (CU = Cunit (Main_Unit));
+               null;
+
+            --  All other cases cannot happen
+
+            when N_Function_Instantiation |
+              N_Procedure_Instantiation |
+              N_Package_Instantiation =>
+               pragma Assert (False, "instantiation");
+               null;
+
+            when N_Subunit =>
+               pragma Assert (False, "subunit");
+               null;
+
+            when others =>
+               pragma Assert (False);
+               null;
+         end case;
+
+         if Present (CU) then
+            pragma Assert (Item /= Stand.Standard_Package_Node);
+
+            if Enable_Output then
+               Write_Unit_Name (Unit_Name (Get_Cunit_Unit_Number (CU)));
+               Write_Str (", Unit_Number = ");
+               Write_Int (Int (Get_Cunit_Unit_Number (CU)));
+               Write_Str (", ");
+               Write_Str (Node_Kind'Image (Nkind (Item)));
+               if Item /= Original_Node (Item) then
+                  Write_Str (", orig = ");
+                  Write_Str (Node_Kind'Image (Nkind (Original_Node (Item))));
+               end if;
+               Write_Eol;
+            end if;
+
+         else  --  Must be Standard
+            pragma Assert (Item = Stand.Standard_Package_Node);
+            if Enable_Output then
+               Write_Line ("Standard");
+            end if;
+         end if;
+
+         Action (Item);
+      end Do_Action;
+
+      Cur : Elmt_Id := First_Elmt (Comp_Unit_List);
+
+      --  Start of processing for Walk_Library_Items
+
+   begin
+      if Enable_Output then
+         Write_Line ("Walk_Library_Items:");
+         Indent;
+      end if;
+
+      --  Do Standard first, then walk the Comp_Unit_List
+
+      Do_Action (Empty, Standard_Package_Node);
+
+      while Present (Cur) loop
+         declare
+            CU : constant Node_Id := Node (Cur);
+            N  : constant Node_Id := Unit (CU);
+         begin
+            pragma Assert (Nkind (CU) = N_Compilation_Unit);
+
+            case Nkind (N) is
+               --  If it's a body, then ignore it, unless it's an instance (in
+               --  which case we do the spec), or it's the main unit (in which
+               --  case we do it). Note that it could be both.
+
+               when N_Package_Body | N_Subprogram_Body =>
+                  declare
+                     Entity : Node_Id := N;
+                  begin
+                     if Nkind (N) = N_Subprogram_Body then
+                        Entity := Specification (Entity);
+                     end if;
+                     Entity := Defining_Unit_Name (Entity);
+                     if Nkind (Entity) not in N_Entity then
+                        --  Must be N_Defining_Program_Unit_Name
+                        Entity := Defining_Identifier (Entity);
+                     end if;
+
+                     if Is_Generic_Instance (Entity) then
+                        Do_Action (CU, Unit (Library_Unit (CU)));
+                     end if;
+                  end;
+
+                  if CU = Cunit (Main_Unit) then
+                     --  Must come last
+
+                     pragma Assert (No (Next_Elmt (Cur)));
+
+                     Do_Action (CU, N);
+                  end if;
+
+               --  It's a spec, so just do it
+
+               when others =>
+                  Do_Action (CU, N);
+            end case;
+         end;
+
+         Next_Elmt (Cur);
+      end loop;
+
+      if Enable_Output then
+         Outdent;
+         Write_Line ("end Walk_Library_Items.");
+      end if;
+   end Walk_Library_Items;
+
 end Sem;
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index f6aabfb..544178b 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -640,4 +640,20 @@ package Sem is
    --  is False, then the status of the check can be determined simply by
    --  examining Scope_Checks (C), so this routine is not called in that case.
 
+   generic
+      with procedure Action (Item : Node_Id);
+   procedure Walk_Library_Items;
+   --  Primarily for use by SofCheck Inspector. Must be called after semantic
+   --  analysis (and expansion) are complete. Walks each relevant library item,
+   --  calling Action for each, in an order such that one will not run across
+   --  forward references. Each Item passed to Action is the declaration or
+   --  body of a library unit, including generics and renamings. The first item
+   --  is the N_Package_Declaration node for package Standard. Bodies are not
+   --  included, except for the main unit itself, which always comes last.
+   --
+   --  Item is never a subunit.
+   --
+   --  Item is never an instantiation. Instead, the instance declaration is
+   --  passed, and (if the instantiation is the main unit), the instance body.
+
 end Sem;
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 47bc662..4e03642 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -312,8 +312,7 @@ package body Sem_Type is
          end loop;
 
          All_Interp.Table (All_Interp.Last) := (Name, Typ, Abstr_Op);
-         All_Interp.Increment_Last;
-         All_Interp.Table (All_Interp.Last) := No_Interp;
+         All_Interp.Append (No_Interp);
       end Add_Entry;
 
       ----------------------------
@@ -634,8 +633,7 @@ package body Sem_Type is
                      then
                         All_Interp.Table (All_Interp.Last) :=
                           (H, Etype (H), Empty);
-                        All_Interp.Increment_Last;
-                        All_Interp.Table (All_Interp.Last) := No_Interp;
+                        All_Interp.Append (No_Interp);
                         goto Next_Homograph;
 
                      elsif Scope (H) /= Standard_Standard then
@@ -2625,8 +2623,7 @@ package body Sem_Type is
       Map_Ptr : Int;
 
    begin
-      All_Interp.Increment_Last;
-      All_Interp.Table (All_Interp.Last) := No_Interp;
+      All_Interp.Append (No_Interp);
 
       Map_Ptr := Headers (Hash (N));