obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 904 insertions, 0 deletions

diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
new file mode 100755
index 000000000..e9a47a3bf
--- /dev/null
+++ b/gcc/ada/sem_aux.adb
@@ -0,0 +1,904 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                              S E M _ A U X                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2010, 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Atree;  use Atree;
+with Einfo;  use Einfo;
+with Namet;  use Namet;
+with Sinfo;  use Sinfo;
+with Snames; use Snames;
+with Stand;  use Stand;
+
+package body Sem_Aux is
+
+   ----------------------
+   -- Ancestor_Subtype --
+   ----------------------
+
+   function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id is
+   begin
+      --  If this is first subtype, or is a base type, then there is no
+      --  ancestor subtype, so we return Empty to indicate this fact.
+
+      if Is_First_Subtype (Typ) or else Is_Base_Type (Typ) then
+         return Empty;
+      end if;
+
+      declare
+         D : constant Node_Id := Declaration_Node (Typ);
+
+      begin
+         --  If we have a subtype declaration, get the ancestor subtype
+
+         if Nkind (D) = N_Subtype_Declaration then
+            if Nkind (Subtype_Indication (D)) = N_Subtype_Indication then
+               return Entity (Subtype_Mark (Subtype_Indication (D)));
+            else
+               return Entity (Subtype_Indication (D));
+            end if;
+
+         --  If not, then no subtype indication is available
+
+         else
+            return Empty;
+         end if;
+      end;
+   end Ancestor_Subtype;
+
+   --------------------
+   -- Available_View --
+   --------------------
+
+   function Available_View (Typ : Entity_Id) return Entity_Id is
+   begin
+      if Is_Incomplete_Type (Typ)
+        and then Present (Non_Limited_View (Typ))
+      then
+         --  The non-limited view may itself be an incomplete type, in which
+         --  case get its full view.
+
+         return Get_Full_View (Non_Limited_View (Typ));
+
+      elsif Is_Class_Wide_Type (Typ)
+        and then Is_Incomplete_Type (Etype (Typ))
+        and then Present (Non_Limited_View (Etype (Typ)))
+      then
+         return Class_Wide_Type (Non_Limited_View (Etype (Typ)));
+
+      else
+         return Typ;
+      end if;
+   end Available_View;
+
+   --------------------
+   -- Constant_Value --
+   --------------------
+
+   function Constant_Value (Ent : Entity_Id) return Node_Id is
+      D      : constant Node_Id := Declaration_Node (Ent);
+      Full_D : Node_Id;
+
+   begin
+      --  If we have no declaration node, then return no constant value. Not
+      --  clear how this can happen, but it does sometimes and this is the
+      --  safest approach.
+
+      if No (D) then
+         return Empty;
+
+      --  Normal case where a declaration node is present
+
+      elsif Nkind (D) = N_Object_Renaming_Declaration then
+         return Renamed_Object (Ent);
+
+      --  If this is a component declaration whose entity is a constant, it is
+      --  a prival within a protected function (and so has no constant value).
+
+      elsif Nkind (D) = N_Component_Declaration then
+         return Empty;
+
+      --  If there is an expression, return it
+
+      elsif Present (Expression (D)) then
+         return (Expression (D));
+
+      --  For a constant, see if we have a full view
+
+      elsif Ekind (Ent) = E_Constant
+        and then Present (Full_View (Ent))
+      then
+         Full_D := Parent (Full_View (Ent));
+
+         --  The full view may have been rewritten as an object renaming
+
+         if Nkind (Full_D) = N_Object_Renaming_Declaration then
+            return Name (Full_D);
+         else
+            return Expression (Full_D);
+         end if;
+
+      --  Otherwise we have no expression to return
+
+      else
+         return Empty;
+      end if;
+   end Constant_Value;
+
+   -----------------------------
+   -- Enclosing_Dynamic_Scope --
+   -----------------------------
+
+   function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id is
+      S : Entity_Id;
+
+   begin
+      --  The following test is an error defense against some syntax errors
+      --  that can leave scopes very messed up.
+
+      if Ent = Standard_Standard then
+         return Ent;
+      end if;
+
+      --  Normal case, search enclosing scopes
+
+      --  Note: the test for Present (S) should not be required, it defends
+      --  against an ill-formed tree.
+
+      S := Scope (Ent);
+      loop
+         --  If we somehow got an empty value for Scope, the tree must be
+         --  malformed. Rather than blow up we return Standard in this case.
+
+         if No (S) then
+            return Standard_Standard;
+
+         --  Quit if we get to standard or a dynamic scope
+
+         elsif S = Standard_Standard
+           or else Is_Dynamic_Scope (S)
+         then
+            return S;
+
+         --  Otherwise keep climbing
+
+         else
+            S := Scope (S);
+         end if;
+      end loop;
+   end Enclosing_Dynamic_Scope;
+
+   ------------------------
+   -- First_Discriminant --
+   ------------------------
+
+   function First_Discriminant (Typ : Entity_Id) return Entity_Id is
+      Ent : Entity_Id;
+
+   begin
+      pragma Assert
+        (Has_Discriminants (Typ) or else Has_Unknown_Discriminants (Typ));
+
+      Ent := First_Entity (Typ);
+
+      --  The discriminants are not necessarily contiguous, because access
+      --  discriminants will generate itypes. They are not the first entities
+      --  either, because tag and controller record must be ahead of them.
+
+      if Chars (Ent) = Name_uTag then
+         Ent := Next_Entity (Ent);
+      end if;
+
+      if Chars (Ent) = Name_uController then
+         Ent := Next_Entity (Ent);
+      end if;
+
+      --  Skip all hidden stored discriminants if any
+
+      while Present (Ent) loop
+         exit when Ekind (Ent) = E_Discriminant
+           and then not Is_Completely_Hidden (Ent);
+
+         Ent := Next_Entity (Ent);
+      end loop;
+
+      pragma Assert (Ekind (Ent) = E_Discriminant);
+
+      return Ent;
+   end First_Discriminant;
+
+   -------------------------------
+   -- First_Stored_Discriminant --
+   -------------------------------
+
+   function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id is
+      Ent : Entity_Id;
+
+      function Has_Completely_Hidden_Discriminant
+        (Typ : Entity_Id) return Boolean;
+      --  Scans the Discriminants to see whether any are Completely_Hidden
+      --  (the mechanism for describing non-specified stored discriminants)
+
+      ----------------------------------------
+      -- Has_Completely_Hidden_Discriminant --
+      ----------------------------------------
+
+      function Has_Completely_Hidden_Discriminant
+        (Typ : Entity_Id) return Boolean
+      is
+         Ent : Entity_Id;
+
+      begin
+         pragma Assert (Ekind (Typ) = E_Discriminant);
+
+         Ent := Typ;
+         while Present (Ent) and then Ekind (Ent) = E_Discriminant loop
+            if Is_Completely_Hidden (Ent) then
+               return True;
+            end if;
+
+            Ent := Next_Entity (Ent);
+         end loop;
+
+         return False;
+      end Has_Completely_Hidden_Discriminant;
+
+   --  Start of processing for First_Stored_Discriminant
+
+   begin
+      pragma Assert
+        (Has_Discriminants (Typ)
+          or else Has_Unknown_Discriminants (Typ));
+
+      Ent := First_Entity (Typ);
+
+      if Chars (Ent) = Name_uTag then
+         Ent := Next_Entity (Ent);
+      end if;
+
+      if Chars (Ent) = Name_uController then
+         Ent := Next_Entity (Ent);
+      end if;
+
+      if Has_Completely_Hidden_Discriminant (Ent) then
+
+         while Present (Ent) loop
+            exit when Is_Completely_Hidden (Ent);
+            Ent := Next_Entity (Ent);
+         end loop;
+
+      end if;
+
+      pragma Assert (Ekind (Ent) = E_Discriminant);
+
+      return Ent;
+   end First_Stored_Discriminant;
+
+   -------------------
+   -- First_Subtype --
+   -------------------
+
+   function First_Subtype (Typ : Entity_Id) return Entity_Id is
+      B   : constant Entity_Id := Base_Type (Typ);
+      F   : constant Node_Id   := Freeze_Node (B);
+      Ent : Entity_Id;
+
+   begin
+      --  If the base type has no freeze node, it is a type in Standard, and
+      --  always acts as its own first subtype, except where it is one of the
+      --  predefined integer types. If the type is formal, it is also a first
+      --  subtype, and its base type has no freeze node. On the other hand, a
+      --  subtype of a generic formal is not its own first subtype. Its base
+      --  type, if anonymous, is attached to the formal type decl. from which
+      --  the first subtype is obtained.
+
+      if No (F) then
+         if B = Base_Type (Standard_Integer) then
+            return Standard_Integer;
+
+         elsif B = Base_Type (Standard_Long_Integer) then
+            return Standard_Long_Integer;
+
+         elsif B = Base_Type (Standard_Short_Short_Integer) then
+            return Standard_Short_Short_Integer;
+
+         elsif B = Base_Type (Standard_Short_Integer) then
+            return Standard_Short_Integer;
+
+         elsif B = Base_Type (Standard_Long_Long_Integer) then
+            return Standard_Long_Long_Integer;
+
+         elsif Is_Generic_Type (Typ) then
+            if Present (Parent (B)) then
+               return Defining_Identifier (Parent (B));
+            else
+               return Defining_Identifier (Associated_Node_For_Itype (B));
+            end if;
+
+         else
+            return B;
+         end if;
+
+      --  Otherwise we check the freeze node, if it has a First_Subtype_Link
+      --  then we use that link, otherwise (happens with some Itypes), we use
+      --  the base type itself.
+
+      else
+         Ent := First_Subtype_Link (F);
+
+         if Present (Ent) then
+            return Ent;
+         else
+            return B;
+         end if;
+      end if;
+   end First_Subtype;
+
+   -------------------------
+   -- First_Tag_Component --
+   -------------------------
+
+   function First_Tag_Component (Typ : Entity_Id) return Entity_Id is
+      Comp : Entity_Id;
+      Ctyp : Entity_Id;
+
+   begin
+      Ctyp := Typ;
+      pragma Assert (Is_Tagged_Type (Ctyp));
+
+      if Is_Class_Wide_Type (Ctyp) then
+         Ctyp := Root_Type (Ctyp);
+      end if;
+
+      if Is_Private_Type (Ctyp) then
+         Ctyp := Underlying_Type (Ctyp);
+
+         --  If the underlying type is missing then the source program has
+         --  errors and there is nothing else to do (the full-type declaration
+         --  associated with the private type declaration is missing).
+
+         if No (Ctyp) then
+            return Empty;
+         end if;
+      end if;
+
+      Comp := First_Entity (Ctyp);
+      while Present (Comp) loop
+         if Is_Tag (Comp) then
+            return Comp;
+         end if;
+
+         Comp := Next_Entity (Comp);
+      end loop;
+
+      --  No tag component found
+
+      return Empty;
+   end First_Tag_Component;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Obsolescent_Warnings.Init;
+   end Initialize;
+
+   ---------------------
+   -- Is_By_Copy_Type --
+   ---------------------
+
+   function Is_By_Copy_Type (Ent : Entity_Id) return Boolean is
+   begin
+      --  If Id is a private type whose full declaration has not been seen,
+      --  we assume for now that it is not a By_Copy type. Clearly this
+      --  attribute should not be used before the type is frozen, but it is
+      --  needed to build the associated record of a protected type. Another
+      --  place where some lookahead for a full view is needed ???
+
+      return
+        Is_Elementary_Type (Ent)
+          or else (Is_Private_Type (Ent)
+                     and then Present (Underlying_Type (Ent))
+                     and then Is_Elementary_Type (Underlying_Type (Ent)));
+   end Is_By_Copy_Type;
+
+   --------------------------
+   -- Is_By_Reference_Type --
+   --------------------------
+
+   function Is_By_Reference_Type (Ent : Entity_Id) return Boolean is
+      Btype : constant Entity_Id := Base_Type (Ent);
+
+   begin
+      if Error_Posted (Ent)
+        or else Error_Posted (Btype)
+      then
+         return False;
+
+      elsif Is_Private_Type (Btype) then
+         declare
+            Utyp : constant Entity_Id := Underlying_Type (Btype);
+         begin
+            if No (Utyp) then
+               return False;
+            else
+               return Is_By_Reference_Type (Utyp);
+            end if;
+         end;
+
+      elsif Is_Incomplete_Type (Btype) then
+         declare
+            Ftyp : constant Entity_Id := Full_View (Btype);
+         begin
+            if No (Ftyp) then
+               return False;
+            else
+               return Is_By_Reference_Type (Ftyp);
+            end if;
+         end;
+
+      elsif Is_Concurrent_Type (Btype) then
+         return True;
+
+      elsif Is_Record_Type (Btype) then
+         if Is_Limited_Record (Btype)
+           or else Is_Tagged_Type (Btype)
+           or else Is_Volatile (Btype)
+         then
+            return True;
+
+         else
+            declare
+               C : Entity_Id;
+
+            begin
+               C := First_Component (Btype);
+               while Present (C) loop
+                  if Is_By_Reference_Type (Etype (C))
+                    or else Is_Volatile (Etype (C))
+                  then
+                     return True;
+                  end if;
+
+                  C := Next_Component (C);
+               end loop;
+            end;
+
+            return False;
+         end if;
+
+      elsif Is_Array_Type (Btype) then
+         return
+           Is_Volatile (Btype)
+             or else Is_By_Reference_Type (Component_Type (Btype))
+             or else Is_Volatile (Component_Type (Btype))
+             or else Has_Volatile_Components (Btype);
+
+      else
+         return False;
+      end if;
+   end Is_By_Reference_Type;
+
+   ---------------------
+   -- Is_Derived_Type --
+   ---------------------
+
+   function Is_Derived_Type (Ent : E) return B is
+      Par : Node_Id;
+
+   begin
+      if Is_Type (Ent)
+        and then Base_Type (Ent) /= Root_Type (Ent)
+        and then not Is_Class_Wide_Type (Ent)
+      then
+         if not Is_Numeric_Type (Root_Type (Ent)) then
+            return True;
+
+         else
+            Par := Parent (First_Subtype (Ent));
+
+            return Present (Par)
+              and then Nkind (Par) = N_Full_Type_Declaration
+              and then Nkind (Type_Definition (Par)) =
+                         N_Derived_Type_Definition;
+         end if;
+
+      else
+         return False;
+      end if;
+   end Is_Derived_Type;
+
+   -----------------------
+   -- Is_Generic_Formal --
+   -----------------------
+
+   function Is_Generic_Formal (E : Entity_Id) return Boolean is
+      Kind : Node_Kind;
+   begin
+      if No (E) then
+         return False;
+      else
+         Kind := Nkind (Parent (E));
+         return
+           Nkind_In (Kind, N_Formal_Object_Declaration,
+                           N_Formal_Package_Declaration,
+                           N_Formal_Type_Declaration)
+             or else Is_Formal_Subprogram (E);
+      end if;
+   end Is_Generic_Formal;
+
+   ---------------------------
+   -- Is_Indefinite_Subtype --
+   ---------------------------
+
+   function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean is
+      K : constant Entity_Kind := Ekind (Ent);
+
+   begin
+      if Is_Constrained (Ent) then
+         return False;
+
+      elsif K in Array_Kind
+        or else K in Class_Wide_Kind
+        or else Has_Unknown_Discriminants (Ent)
+      then
+         return True;
+
+      --  Known discriminants: indefinite if there are no default values
+
+      elsif K in Record_Kind
+        or else Is_Incomplete_Or_Private_Type (Ent)
+        or else Is_Concurrent_Type (Ent)
+      then
+         return (Has_Discriminants (Ent)
+           and then
+             No (Discriminant_Default_Value (First_Discriminant (Ent))));
+
+      else
+         return False;
+      end if;
+   end Is_Indefinite_Subtype;
+
+   -------------------------------
+   -- Is_Immutably_Limited_Type --
+   -------------------------------
+
+   function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean is
+      Btype : constant Entity_Id := Base_Type (Ent);
+
+   begin
+      if Is_Limited_Record (Btype) then
+         return True;
+
+      elsif Ekind (Btype) = E_Limited_Private_Type
+        and then Nkind (Parent (Btype)) = N_Formal_Type_Declaration
+      then
+         return not In_Package_Body (Scope ((Btype)));
+      end if;
+
+      if Is_Private_Type (Btype) then
+
+         --  AI05-0063: A type derived from a limited private formal type is
+         --  not immutably limited in a generic body.
+
+         if Is_Derived_Type (Btype)
+           and then Is_Generic_Type (Etype (Btype))
+         then
+            if not Is_Limited_Type (Etype (Btype)) then
+               return False;
+
+            --  A descendant of a limited formal type is not immutably limited
+            --  in the generic body, or in the body of a generic child.
+
+            elsif Ekind (Scope (Etype (Btype))) = E_Generic_Package then
+               return not In_Package_Body (Scope (Btype));
+
+            else
+               return False;
+            end if;
+
+         else
+            declare
+               Utyp : constant Entity_Id := Underlying_Type (Btype);
+            begin
+               if No (Utyp) then
+                  return False;
+               else
+                  return Is_Immutably_Limited_Type (Utyp);
+               end if;
+            end;
+         end if;
+
+      elsif Is_Concurrent_Type (Btype) then
+         return True;
+
+      elsif Is_Record_Type (Btype) then
+
+         --  Note that we return True for all limited interfaces, even though
+         --  (unsynchronized) limited interfaces can have descendants that are
+         --  nonlimited, because this is a predicate on the type itself, and
+         --  things like functions with limited interface results need to be
+         --  handled as build in place even though they might return objects
+         --  of a type that is not inherently limited.
+
+         if Is_Class_Wide_Type (Btype) then
+            return Is_Immutably_Limited_Type (Root_Type (Btype));
+
+         else
+            declare
+               C : Entity_Id;
+
+            begin
+               C := First_Component (Btype);
+               while Present (C) loop
+
+                  --  Don't consider components with interface types (which can
+                  --  only occur in the case of a _parent component anyway).
+                  --  They don't have any components, plus it would cause this
+                  --  function to return true for nonlimited types derived from
+                  --  limited interfaces.
+
+                  if not Is_Interface (Etype (C))
+                    and then Is_Immutably_Limited_Type (Etype (C))
+                  then
+                     return True;
+                  end if;
+
+                  C := Next_Component (C);
+               end loop;
+            end;
+
+            return False;
+         end if;
+
+      elsif Is_Array_Type (Btype) then
+         return Is_Immutably_Limited_Type (Component_Type (Btype));
+
+      else
+         return False;
+      end if;
+   end Is_Immutably_Limited_Type;
+
+   ---------------------
+   -- Is_Limited_Type --
+   ---------------------
+
+   function Is_Limited_Type (Ent : Entity_Id) return Boolean is
+      Btype : constant E := Base_Type (Ent);
+      Rtype : constant E := Root_Type (Btype);
+
+   begin
+      if not Is_Type (Ent) then
+         return False;
+
+      elsif Ekind (Btype) = E_Limited_Private_Type
+        or else Is_Limited_Composite (Btype)
+      then
+         return True;
+
+      elsif Is_Concurrent_Type (Btype) then
+         return True;
+
+         --  The Is_Limited_Record flag normally indicates that the type is
+         --  limited. The exception is that a type does not inherit limitedness
+         --  from its interface ancestor. So the type may be derived from a
+         --  limited interface, but is not limited.
+
+      elsif Is_Limited_Record (Ent)
+        and then not Is_Interface (Ent)
+      then
+         return True;
+
+      --  Otherwise we will look around to see if there is some other reason
+      --  for it to be limited, except that if an error was posted on the
+      --  entity, then just assume it is non-limited, because it can cause
+      --  trouble to recurse into a murky erroneous entity!
+
+      elsif Error_Posted (Ent) then
+         return False;
+
+      elsif Is_Record_Type (Btype) then
+
+         if Is_Limited_Interface (Ent) then
+            return True;
+
+         --  AI-419: limitedness is not inherited from a limited interface
+
+         elsif Is_Limited_Record (Rtype) then
+            return not Is_Interface (Rtype)
+              or else Is_Protected_Interface (Rtype)
+              or else Is_Synchronized_Interface (Rtype)
+              or else Is_Task_Interface (Rtype);
+
+         elsif Is_Class_Wide_Type (Btype) then
+            return Is_Limited_Type (Rtype);
+
+         else
+            declare
+               C : E;
+
+            begin
+               C := First_Component (Btype);
+               while Present (C) loop
+                  if Is_Limited_Type (Etype (C)) then
+                     return True;
+                  end if;
+
+                  C := Next_Component (C);
+               end loop;
+            end;
+
+            return False;
+         end if;
+
+      elsif Is_Array_Type (Btype) then
+         return Is_Limited_Type (Component_Type (Btype));
+
+      else
+         return False;
+      end if;
+   end Is_Limited_Type;
+
+   ----------------------
+   -- Nearest_Ancestor --
+   ----------------------
+
+   function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id is
+         D : constant Node_Id := Declaration_Node (Typ);
+
+   begin
+      --  If we have a subtype declaration, get the ancestor subtype
+
+      if Nkind (D) = N_Subtype_Declaration then
+         if Nkind (Subtype_Indication (D)) = N_Subtype_Indication then
+            return Entity (Subtype_Mark (Subtype_Indication (D)));
+         else
+            return Entity (Subtype_Indication (D));
+         end if;
+
+      --  If derived type declaration, find who we are derived from
+
+      elsif Nkind (D) = N_Full_Type_Declaration
+        and then Nkind (Type_Definition (D)) = N_Derived_Type_Definition
+      then
+         declare
+            DTD : constant Entity_Id := Type_Definition (D);
+            SI  : constant Entity_Id := Subtype_Indication (DTD);
+         begin
+            if Is_Entity_Name (SI) then
+               return Entity (SI);
+            else
+               return Entity (Subtype_Mark (SI));
+            end if;
+         end;
+
+      --  Otherwise, nothing useful to return, return Empty
+
+      else
+         return Empty;
+      end if;
+   end Nearest_Ancestor;
+
+   ---------------------------
+   -- Nearest_Dynamic_Scope --
+   ---------------------------
+
+   function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id is
+   begin
+      if Is_Dynamic_Scope (Ent) then
+         return Ent;
+      else
+         return Enclosing_Dynamic_Scope (Ent);
+      end if;
+   end Nearest_Dynamic_Scope;
+
+   ------------------------
+   -- Next_Tag_Component --
+   ------------------------
+
+   function Next_Tag_Component (Tag : Entity_Id) return Entity_Id is
+      Comp : Entity_Id;
+
+   begin
+      pragma Assert (Is_Tag (Tag));
+
+      --  Loop to look for next tag component
+
+      Comp := Next_Entity (Tag);
+      while Present (Comp) loop
+         if Is_Tag (Comp) then
+            pragma Assert (Chars (Comp) /= Name_uTag);
+            return Comp;
+         end if;
+
+         Comp := Next_Entity (Comp);
+      end loop;
+
+      --  No tag component found
+
+      return Empty;
+   end Next_Tag_Component;
+
+   --------------------------
+   -- Number_Discriminants --
+   --------------------------
+
+   function Number_Discriminants (Typ : Entity_Id) return Pos is
+      N     : Int;
+      Discr : Entity_Id;
+
+   begin
+      N := 0;
+      Discr := First_Discriminant (Typ);
+      while Present (Discr) loop
+         N := N + 1;
+         Discr := Next_Discriminant (Discr);
+      end loop;
+
+      return N;
+   end Number_Discriminants;
+
+   ---------------
+   -- Tree_Read --
+   ---------------
+
+   procedure Tree_Read is
+   begin
+      Obsolescent_Warnings.Tree_Read;
+   end Tree_Read;
+
+   ----------------
+   -- Tree_Write --
+   ----------------
+
+   procedure Tree_Write is
+   begin
+      Obsolescent_Warnings.Tree_Write;
+   end Tree_Write;
+
+   --------------------
+   -- Ultimate_Alias --
+   --------------------
+
+   function Ultimate_Alias (Prim : Entity_Id) return Entity_Id is
+      E : Entity_Id := Prim;
+
+   begin
+      while Present (Alias (E)) loop
+         pragma Assert (Alias (E) /= E);
+         E := Alias (E);
+      end loop;
+
+      return E;
+   end Ultimate_Alias;
+
+end Sem_Aux;