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, 997 insertions, 0 deletions

diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb
new file mode 100644
index 000000000..9f6374e3b
--- /dev/null
+++ b/gcc/ada/sem_elim.adb
@@ -0,0 +1,997 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S E M _ E L I M                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1997-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.          --
+--                                                                          --
+-- 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 Errout;   use Errout;
+with Lib;      use Lib;
+with Namet;    use Namet;
+with Nlists;   use Nlists;
+with Opt;      use Opt;
+with Sem;      use Sem;
+with Sem_Aux;  use Sem_Aux;
+with Sem_Prag; use Sem_Prag;
+with Sem_Util; use Sem_Util;
+with Sinput;   use Sinput;
+with Sinfo;    use Sinfo;
+with Snames;   use Snames;
+with Stand;    use Stand;
+with Stringt;  use Stringt;
+with Table;
+
+with GNAT.HTable; use GNAT.HTable;
+
+package body Sem_Elim is
+
+   No_Elimination : Boolean;
+   --  Set True if no Eliminate pragmas active
+
+   ---------------------
+   -- Data Structures --
+   ---------------------
+
+   --  A single pragma Eliminate is represented by the following record
+
+   type Elim_Data;
+   type Access_Elim_Data is access Elim_Data;
+
+   type Names is array (Nat range <>) of Name_Id;
+   --  Type used to represent set of names. Used for names in Unit_Name
+   --  and also the set of names in Argument_Types.
+
+   type Access_Names is access Names;
+
+   type Elim_Data is record
+
+      Unit_Name : Access_Names;
+      --  Unit name, broken down into a set of names (e.g. A.B.C is
+      --  represented as Name_Id values for A, B, C in sequence).
+
+      Entity_Name : Name_Id;
+      --  Entity name if Entity parameter if present. If no Entity parameter
+      --  was supplied, then Entity_Node is set to Empty, and the Entity_Name
+      --  field contains the last identifier name in the Unit_Name.
+
+      Entity_Scope : Access_Names;
+      --  Static scope of the entity within the compilation unit represented by
+      --  Unit_Name.
+
+      Entity_Node : Node_Id;
+      --  Save node of entity argument, for posting error messages. Set
+      --  to Empty if there is no entity argument.
+
+      Parameter_Types : Access_Names;
+      --  Set to set of names given for parameter types. If no parameter
+      --  types argument is present, this argument is set to null.
+
+      Result_Type : Name_Id;
+      --  Result type name if Result_Types parameter present, No_Name if not
+
+      Source_Location : Name_Id;
+      --  String describing the source location of subprogram defining name if
+      --  Source_Location parameter present, No_Name if not
+
+      Hash_Link : Access_Elim_Data;
+      --  Link for hash table use
+
+      Homonym : Access_Elim_Data;
+      --  Pointer to next entry with same key
+
+      Prag : Node_Id;
+      --  Node_Id for Eliminate pragma
+
+   end record;
+
+   ----------------
+   -- Hash_Table --
+   ----------------
+
+   --  Setup hash table using the Entity_Name field as the hash key
+
+   subtype Element is Elim_Data;
+   subtype Elmt_Ptr is Access_Elim_Data;
+
+   subtype Key is Name_Id;
+
+   type Header_Num is range 0 .. 1023;
+
+   Null_Ptr : constant Elmt_Ptr := null;
+
+   ----------------------
+   -- Hash_Subprograms --
+   ----------------------
+
+   package Hash_Subprograms is
+
+      function Equal (F1, F2 : Key) return Boolean;
+      pragma Inline (Equal);
+
+      function Get_Key (E : Elmt_Ptr) return Key;
+      pragma Inline (Get_Key);
+
+      function Hash (F : Key) return Header_Num;
+      pragma Inline (Hash);
+
+      function Next (E : Elmt_Ptr) return Elmt_Ptr;
+      pragma Inline (Next);
+
+      procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
+      pragma Inline (Set_Next);
+
+   end Hash_Subprograms;
+
+   package body Hash_Subprograms is
+
+      -----------
+      -- Equal --
+      -----------
+
+      function Equal (F1, F2 : Key) return Boolean is
+      begin
+         return F1 = F2;
+      end Equal;
+
+      -------------
+      -- Get_Key --
+      -------------
+
+      function Get_Key (E : Elmt_Ptr) return Key is
+      begin
+         return E.Entity_Name;
+      end Get_Key;
+
+      ----------
+      -- Hash --
+      ----------
+
+      function Hash (F : Key) return Header_Num is
+      begin
+         return Header_Num (Int (F) mod 1024);
+      end Hash;
+
+      ----------
+      -- Next --
+      ----------
+
+      function Next (E : Elmt_Ptr) return Elmt_Ptr is
+      begin
+         return E.Hash_Link;
+      end Next;
+
+      --------------
+      -- Set_Next --
+      --------------
+
+      procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
+      begin
+         E.Hash_Link := Next;
+      end Set_Next;
+   end Hash_Subprograms;
+
+   ------------
+   -- Tables --
+   ------------
+
+   --  The following table records the data for each pragmas, using the
+   --  entity name as the hash key for retrieval. Entries in this table
+   --  are set by Process_Eliminate_Pragma and read by Check_Eliminated.
+
+   package Elim_Hash_Table is new Static_HTable (
+      Header_Num => Header_Num,
+      Element    => Element,
+      Elmt_Ptr   => Elmt_Ptr,
+      Null_Ptr   => Null_Ptr,
+      Set_Next   => Hash_Subprograms.Set_Next,
+      Next       => Hash_Subprograms.Next,
+      Key        => Key,
+      Get_Key    => Hash_Subprograms.Get_Key,
+      Hash       => Hash_Subprograms.Hash,
+      Equal      => Hash_Subprograms.Equal);
+
+   --  The following table records entities for subprograms that are
+   --  eliminated, and corresponding eliminate pragmas that caused the
+   --  elimination. Entries in this table are set by Check_Eliminated
+   --  and read by Eliminate_Error_Msg.
+
+   type Elim_Entity_Entry is record
+      Prag : Node_Id;
+      Subp : Entity_Id;
+   end record;
+
+   package Elim_Entities is new Table.Table (
+     Table_Component_Type => Elim_Entity_Entry,
+     Table_Index_Type     => Name_Id'Base,
+     Table_Low_Bound      => First_Name_Id,
+     Table_Initial        => 50,
+     Table_Increment      => 200,
+     Table_Name           => "Elim_Entries");
+
+   ----------------------
+   -- Check_Eliminated --
+   ----------------------
+
+   procedure Check_Eliminated (E : Entity_Id) is
+      Elmt : Access_Elim_Data;
+      Scop : Entity_Id;
+      Form : Entity_Id;
+      Up   : Nat;
+
+   begin
+      if No_Elimination then
+         return;
+
+      --  Elimination of objects and types is not implemented yet
+
+      elsif Ekind (E) not in Subprogram_Kind then
+         return;
+      end if;
+
+      --  Loop through homonyms for this key
+
+      Elmt := Elim_Hash_Table.Get (Chars (E));
+      while Elmt /= null loop
+         Check_Homonyms : declare
+            procedure Set_Eliminated;
+            --  Set current subprogram entity as eliminated
+
+            --------------------
+            -- Set_Eliminated --
+            --------------------
+
+            procedure Set_Eliminated is
+            begin
+               if Is_Dispatching_Operation (E) then
+
+                  --  If an overriding dispatching primitive is eliminated then
+                  --  its parent must have been eliminated.
+
+                  if Present (Overridden_Operation (E))
+                    and then not Is_Eliminated (Overridden_Operation (E))
+                  then
+                     Error_Msg_Name_1 := Chars (E);
+                     Error_Msg_N ("cannot eliminate subprogram %", E);
+                     return;
+                  end if;
+               end if;
+
+               Set_Is_Eliminated (E);
+               Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
+            end Set_Eliminated;
+
+         --  Start of processing for Check_Homonyms
+
+         begin
+            --  First we check that the name of the entity matches
+
+            if Elmt.Entity_Name /= Chars (E) then
+               goto Continue;
+            end if;
+
+            --  Find enclosing unit, and verify that its name and those of its
+            --  parents match.
+
+            Scop := Cunit_Entity (Current_Sem_Unit);
+
+            --  Now see if compilation unit matches
+
+            Up := Elmt.Unit_Name'Last;
+
+            --  If we are within a subunit, the name in the pragma has been
+            --  parsed as a child unit, but the current compilation unit is in
+            --  fact the parent in which the subunit is embedded. We must skip
+            --  the first name which is that of the subunit to match the pragma
+            --  specification. Body may be that of a package or subprogram.
+
+            declare
+               Par : Node_Id;
+
+            begin
+               Par := Parent (E);
+               while Present (Par) loop
+                  if Nkind (Par) = N_Subunit then
+                     if Chars (Defining_Entity (Proper_Body (Par))) =
+                                                         Elmt.Unit_Name (Up)
+                     then
+                        Up := Up - 1;
+                        exit;
+
+                     else
+                        goto Continue;
+                     end if;
+                  end if;
+
+                  Par := Parent (Par);
+               end loop;
+            end;
+
+            for J in reverse Elmt.Unit_Name'First .. Up loop
+               if Elmt.Unit_Name (J) /= Chars (Scop) then
+                  goto Continue;
+               end if;
+
+               Scop := Scope (Scop);
+
+               if Scop /= Standard_Standard and then J = 1 then
+                  goto Continue;
+               end if;
+            end loop;
+
+            if Scop /= Standard_Standard then
+               goto Continue;
+            end if;
+
+            if Present (Elmt.Entity_Node)
+              and then Elmt.Entity_Scope /= null
+            then
+               --  Check that names of enclosing scopes match. Skip blocks and
+               --  wrapper package of subprogram instances, which do not appear
+               --  in the pragma.
+
+               Scop := Scope (E);
+
+               for J in reverse  Elmt.Entity_Scope'Range loop
+                  while Ekind (Scop) = E_Block
+                    or else
+                     (Ekind (Scop) = E_Package
+                       and then Is_Wrapper_Package (Scop))
+                  loop
+                     Scop := Scope (Scop);
+                  end loop;
+
+                  if Elmt.Entity_Scope (J) /= Chars (Scop) then
+                     if Ekind (Scop) /= E_Protected_Type
+                       or else Comes_From_Source (Scop)
+                     then
+                        goto Continue;
+
+                     --  For simple protected declarations, retrieve the source
+                     --  name of the object, which appeared in the Eliminate
+                     --  pragma.
+
+                     else
+                        declare
+                           Decl : constant Node_Id :=
+                             Original_Node (Parent (Scop));
+
+                        begin
+                           if Elmt.Entity_Scope (J) /=
+                             Chars (Defining_Identifier (Decl))
+                           then
+                              if J > 0 then
+                                 null;
+                              end if;
+                              goto Continue;
+                           end if;
+                        end;
+                     end if;
+
+                  end if;
+
+                  Scop := Scope (Scop);
+               end loop;
+            end if;
+
+            --  If given entity is a library level subprogram and pragma had a
+            --  single parameter, a match!
+
+            if Is_Compilation_Unit (E)
+              and then Is_Subprogram (E)
+              and then No (Elmt.Entity_Node)
+            then
+               Set_Eliminated;
+               return;
+
+               --  Check for case of type or object with two parameter case
+
+            elsif (Is_Type (E) or else Is_Object (E))
+              and then Elmt.Result_Type = No_Name
+              and then Elmt.Parameter_Types = null
+            then
+               Set_Eliminated;
+               return;
+
+            --  Check for case of subprogram
+
+            elsif Ekind_In (E, E_Function, E_Procedure) then
+
+               --  If Source_Location present, then see if it matches
+
+               if Elmt.Source_Location /= No_Name then
+                  Get_Name_String (Elmt.Source_Location);
+
+                  declare
+                     Sloc_Trace : constant String :=
+                                    Name_Buffer (1 .. Name_Len);
+
+                     Idx : Natural := Sloc_Trace'First;
+                     --  Index in Sloc_Trace, if equals to 0, then we have
+                     --  completely traversed Sloc_Trace
+
+                     Last : constant Natural := Sloc_Trace'Last;
+
+                     P      : Source_Ptr;
+                     Sindex : Source_File_Index;
+
+                     function File_Name_Match return Boolean;
+                     --  This function is supposed to be called when Idx points
+                     --  to the beginning of the new file name, and Name_Buffer
+                     --  is set to contain the name of the proper source file
+                     --  from the chain corresponding to the Sloc of E. First
+                     --  it checks that these two files have the same name. If
+                     --  this check is successful, moves Idx to point to the
+                     --  beginning of the column number.
+
+                     function Line_Num_Match return Boolean;
+                     --  This function is supposed to be called when Idx points
+                     --  to the beginning of the column number, and P is
+                     --  set to point to the proper Sloc the chain
+                     --  corresponding to the Sloc of E. First it checks that
+                     --  the line number Idx points on and the line number
+                     --  corresponding to P are the same. If this check is
+                     --  successful, moves Idx to point to the beginning of
+                     --  the next file name in Sloc_Trace. If there is no file
+                     --  name any more, Idx is set to 0.
+
+                     function Different_Trace_Lengths return Boolean;
+                     --  From Idx and P, defines if there are in both traces
+                     --  more element(s) in the instantiation chains. Returns
+                     --  False if one trace contains more element(s), but
+                     --  another does not. If both traces contains more
+                     --  elements (that is, the function returns False), moves
+                     --  P ahead in the chain corresponding to E, recomputes
+                     --  Sindex and sets the name of the corresponding file in
+                     --  Name_Buffer
+
+                     function Skip_Spaces return Natural;
+                     --  If Sloc_Trace (Idx) is not space character, returns
+                     --  Idx. Otherwise returns the index of the nearest
+                     --  non-space character in Sloc_Trace to the right of Idx.
+                     --  Returns 0 if there is no such character.
+
+                     -----------------------------
+                     -- Different_Trace_Lengths --
+                     -----------------------------
+
+                     function Different_Trace_Lengths return Boolean is
+                     begin
+                        P := Instantiation (Sindex);
+
+                        if (P = No_Location and then Idx /= 0)
+                          or else
+                           (P /= No_Location and then Idx = 0)
+                        then
+                           return True;
+
+                        else
+                           if P /= No_Location then
+                              Sindex := Get_Source_File_Index (P);
+                              Get_Name_String (File_Name (Sindex));
+                           end if;
+
+                           return False;
+                        end if;
+                     end Different_Trace_Lengths;
+
+                     ---------------------
+                     -- File_Name_Match --
+                     ---------------------
+
+                     function File_Name_Match return Boolean is
+                        Tmp_Idx : Natural;
+                        End_Idx : Natural;
+
+                     begin
+                        if Idx = 0 then
+                           return False;
+                        end if;
+
+                        --  Find first colon. If no colon, then return False.
+                        --  If there is a colon, Tmp_Idx is set to point just
+                        --  before the colon.
+
+                        Tmp_Idx := Idx - 1;
+                        loop
+                           if Tmp_Idx >= Last then
+                              return False;
+                           elsif Sloc_Trace (Tmp_Idx + 1) = ':' then
+                              exit;
+                           else
+                              Tmp_Idx := Tmp_Idx + 1;
+                           end if;
+                        end loop;
+
+                        --  Find last non-space before this colon. If there is
+                        --  no space character before this colon, then return
+                        --  False. Otherwise, End_Idx is set to point to this
+                        --  non-space character.
+
+                        End_Idx := Tmp_Idx;
+                        loop
+                           if End_Idx < Idx then
+                              return False;
+
+                           elsif Sloc_Trace (End_Idx) /= ' ' then
+                              exit;
+
+                           else
+                              End_Idx := End_Idx - 1;
+                           end if;
+                        end loop;
+
+                        --  Now see if file name matches what is in Name_Buffer
+                        --  and if so, step Idx past it and return True. If the
+                        --  name does not match, return False.
+
+                        if Sloc_Trace (Idx .. End_Idx) =
+                           Name_Buffer (1 .. Name_Len)
+                        then
+                           Idx := Tmp_Idx + 2;
+                           Idx := Skip_Spaces;
+                           return True;
+                        else
+                           return False;
+                        end if;
+                     end File_Name_Match;
+
+                     --------------------
+                     -- Line_Num_Match --
+                     --------------------
+
+                     function Line_Num_Match return Boolean is
+                        N : Int := 0;
+
+                     begin
+                        if Idx = 0 then
+                           return False;
+                        end if;
+
+                        while Idx <= Last
+                           and then Sloc_Trace (Idx) in '0' .. '9'
+                        loop
+                           N := N * 10 +
+                            (Character'Pos (Sloc_Trace (Idx)) -
+                             Character'Pos ('0'));
+                           Idx := Idx + 1;
+                        end loop;
+
+                        if Get_Physical_Line_Number (P) =
+                           Physical_Line_Number (N)
+                        then
+                           while Idx <= Last and then
+                              Sloc_Trace (Idx) /= '['
+                           loop
+                              Idx := Idx + 1;
+                           end loop;
+
+                           if Idx <= Last and then
+                             Sloc_Trace (Idx) = '['
+                           then
+                              Idx := Idx + 1;
+                              Idx := Skip_Spaces;
+                           else
+                              Idx := 0;
+                           end if;
+
+                           return True;
+
+                        else
+                           return False;
+                        end if;
+                     end Line_Num_Match;
+
+                     -----------------
+                     -- Skip_Spaces --
+                     -----------------
+
+                     function Skip_Spaces return Natural is
+                        Res : Natural;
+
+                     begin
+                        Res := Idx;
+                        while Sloc_Trace (Res) = ' ' loop
+                           Res := Res + 1;
+
+                           if Res > Last then
+                              Res := 0;
+                              exit;
+                           end if;
+                        end loop;
+
+                        return Res;
+                     end Skip_Spaces;
+
+                  begin
+                     P := Sloc (E);
+                     Sindex := Get_Source_File_Index (P);
+                     Get_Name_String (File_Name (Sindex));
+
+                     Idx := Skip_Spaces;
+                     while Idx > 0 loop
+                        if not File_Name_Match then
+                           goto Continue;
+                        elsif not Line_Num_Match then
+                           goto Continue;
+                        end if;
+
+                        if Different_Trace_Lengths then
+                           goto Continue;
+                        end if;
+                     end loop;
+                  end;
+               end if;
+
+               --  If we have a Result_Type, then we must have a function with
+               --  the proper result type.
+
+               if Elmt.Result_Type /= No_Name then
+                  if Ekind (E) /= E_Function
+                    or else Chars (Etype (E)) /= Elmt.Result_Type
+                  then
+                     goto Continue;
+                  end if;
+               end if;
+
+               --  If we have Parameter_Types, they must match
+
+               if Elmt.Parameter_Types /= null then
+                  Form := First_Formal (E);
+
+                  if No (Form)
+                    and then Elmt.Parameter_Types'Length = 1
+                    and then Elmt.Parameter_Types (1) = No_Name
+                  then
+                     --  Parameterless procedure matches
+
+                     null;
+
+                  elsif Elmt.Parameter_Types = null then
+                     goto Continue;
+
+                  else
+                     for J in Elmt.Parameter_Types'Range loop
+                        if No (Form)
+                          or else
+                            Chars (Etype (Form)) /= Elmt.Parameter_Types (J)
+                        then
+                           goto Continue;
+                        else
+                           Next_Formal (Form);
+                        end if;
+                     end loop;
+
+                     if Present (Form) then
+                        goto Continue;
+                     end if;
+                  end if;
+               end if;
+
+               --  If we fall through, this is match
+
+               Set_Eliminated;
+               return;
+            end if;
+         end Check_Homonyms;
+
+      <<Continue>>
+         Elmt := Elmt.Homonym;
+      end loop;
+
+      return;
+   end Check_Eliminated;
+
+   -------------------------------------
+   -- Check_For_Eliminated_Subprogram --
+   -------------------------------------
+
+   procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id) is
+      Ultimate_Subp  : constant Entity_Id := Ultimate_Alias (S);
+      Enclosing_Subp : Entity_Id;
+
+   begin
+      if Is_Eliminated (Ultimate_Subp)
+        and then not Inside_A_Generic
+        and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
+      then
+         Enclosing_Subp := Current_Subprogram;
+         while Present (Enclosing_Subp) loop
+            if Is_Eliminated (Enclosing_Subp) then
+               return;
+            end if;
+
+            Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp);
+         end loop;
+
+         --  Emit error, unless we are within an instance body and the expander
+         --  is disabled, indicating an instance within an enclosing generic.
+         --  In an instance, the ultimate alias is an internal entity, so place
+         --  the message on the original subprogram.
+
+         if In_Instance_Body and then not Expander_Active then
+            null;
+
+         elsif Comes_From_Source (Ultimate_Subp) then
+            Eliminate_Error_Msg (N, Ultimate_Subp);
+
+         else
+            Eliminate_Error_Msg (N, S);
+         end if;
+      end if;
+   end Check_For_Eliminated_Subprogram;
+
+   -------------------------
+   -- Eliminate_Error_Msg --
+   -------------------------
+
+   procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id) is
+   begin
+      for J in Elim_Entities.First .. Elim_Entities.Last loop
+         if E = Elim_Entities.Table (J).Subp then
+            Error_Msg_Sloc := Sloc (Elim_Entities.Table (J).Prag);
+            Error_Msg_NE ("cannot reference subprogram & eliminated #", N, E);
+            return;
+         end if;
+      end loop;
+
+      --  If this is an internal operation generated for a protected operation,
+      --  its name does not match the source name, so just report the error.
+
+      if not Comes_From_Source (E)
+        and then Present (First_Entity (E))
+        and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
+      then
+         Error_Msg_NE
+           ("cannot reference eliminated protected subprogram", N, E);
+
+      --  Otherwise should not fall through, entry should be in table
+
+      else
+         Error_Msg_NE
+           ("subprogram& is called but its alias is eliminated", N, E);
+         --  raise Program_Error;
+      end if;
+   end Eliminate_Error_Msg;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      Elim_Hash_Table.Reset;
+      Elim_Entities.Init;
+      No_Elimination := True;
+   end Initialize;
+
+   ------------------------------
+   -- Process_Eliminate_Pragma --
+   ------------------------------
+
+   procedure Process_Eliminate_Pragma
+     (Pragma_Node         : Node_Id;
+      Arg_Unit_Name       : Node_Id;
+      Arg_Entity          : Node_Id;
+      Arg_Parameter_Types : Node_Id;
+      Arg_Result_Type     : Node_Id;
+      Arg_Source_Location : Node_Id)
+   is
+      Data : constant Access_Elim_Data := new Elim_Data;
+      --  Build result data here
+
+      Elmt : Access_Elim_Data;
+
+      Num_Names : Nat := 0;
+      --  Number of names in unit name
+
+      Lit       : Node_Id;
+      Arg_Ent   : Entity_Id;
+      Arg_Uname : Node_Id;
+
+      function OK_Selected_Component (N : Node_Id) return Boolean;
+      --  Test if N is a selected component with all identifiers, or a
+      --  selected component whose selector is an operator symbol. As a
+      --  side effect if result is True, sets Num_Names to the number
+      --  of names present (identifiers and operator if any).
+
+      ---------------------------
+      -- OK_Selected_Component --
+      ---------------------------
+
+      function OK_Selected_Component (N : Node_Id) return Boolean is
+      begin
+         if Nkind (N) = N_Identifier
+           or else Nkind (N) = N_Operator_Symbol
+         then
+            Num_Names := Num_Names + 1;
+            return True;
+
+         elsif Nkind (N) = N_Selected_Component then
+            return OK_Selected_Component (Prefix (N))
+              and then OK_Selected_Component (Selector_Name (N));
+
+         else
+            return False;
+         end if;
+      end OK_Selected_Component;
+
+   --  Start of processing for Process_Eliminate_Pragma
+
+   begin
+      Data.Prag := Pragma_Node;
+      Error_Msg_Name_1 := Name_Eliminate;
+
+      --  Process Unit_Name argument
+
+      if Nkind (Arg_Unit_Name) = N_Identifier then
+         Data.Unit_Name := new Names'(1 => Chars (Arg_Unit_Name));
+         Num_Names := 1;
+
+      elsif OK_Selected_Component (Arg_Unit_Name) then
+         Data.Unit_Name := new Names (1 .. Num_Names);
+
+         Arg_Uname := Arg_Unit_Name;
+         for J in reverse 2 .. Num_Names loop
+            Data.Unit_Name (J) := Chars (Selector_Name (Arg_Uname));
+            Arg_Uname := Prefix (Arg_Uname);
+         end loop;
+
+         Data.Unit_Name (1) := Chars (Arg_Uname);
+
+      else
+         Error_Msg_N
+           ("wrong form for Unit_Name parameter of pragma%", Arg_Unit_Name);
+         return;
+      end if;
+
+      --  Process Entity argument
+
+      if Present (Arg_Entity) then
+         Num_Names := 0;
+
+         if Nkind (Arg_Entity) = N_Identifier
+           or else Nkind (Arg_Entity) = N_Operator_Symbol
+         then
+            Data.Entity_Name  := Chars (Arg_Entity);
+            Data.Entity_Node  := Arg_Entity;
+            Data.Entity_Scope := null;
+
+         elsif OK_Selected_Component (Arg_Entity) then
+            Data.Entity_Scope := new Names (1 .. Num_Names - 1);
+            Data.Entity_Name  := Chars (Selector_Name (Arg_Entity));
+            Data.Entity_Node  := Arg_Entity;
+
+            Arg_Ent := Prefix (Arg_Entity);
+            for J in reverse 2 .. Num_Names - 1 loop
+               Data.Entity_Scope (J) := Chars (Selector_Name (Arg_Ent));
+               Arg_Ent := Prefix (Arg_Ent);
+            end loop;
+
+            Data.Entity_Scope (1) := Chars (Arg_Ent);
+
+         elsif Is_Config_Static_String (Arg_Entity) then
+            Data.Entity_Name := Name_Find;
+            Data.Entity_Node := Arg_Entity;
+
+         else
+            return;
+         end if;
+      else
+         Data.Entity_Node := Empty;
+         Data.Entity_Name := Data.Unit_Name (Num_Names);
+      end if;
+
+      --  Process Parameter_Types argument
+
+      if Present (Arg_Parameter_Types) then
+
+         --  Here for aggregate case
+
+         if Nkind (Arg_Parameter_Types) = N_Aggregate then
+            Data.Parameter_Types :=
+              new Names
+                (1 .. List_Length (Expressions (Arg_Parameter_Types)));
+
+            Lit := First (Expressions (Arg_Parameter_Types));
+            for J in Data.Parameter_Types'Range loop
+               if Is_Config_Static_String (Lit) then
+                  Data.Parameter_Types (J) := Name_Find;
+                  Next (Lit);
+               else
+                  return;
+               end if;
+            end loop;
+
+         --  Otherwise we must have case of one name, which looks like a
+         --  parenthesized literal rather than an aggregate.
+
+         elsif Paren_Count (Arg_Parameter_Types) /= 1 then
+            Error_Msg_N
+              ("wrong form for argument of pragma Eliminate",
+               Arg_Parameter_Types);
+            return;
+
+         elsif Is_Config_Static_String (Arg_Parameter_Types) then
+            String_To_Name_Buffer (Strval (Arg_Parameter_Types));
+
+            if Name_Len = 0 then
+
+               --  Parameterless procedure
+
+               Data.Parameter_Types := new Names'(1 => No_Name);
+
+            else
+               Data.Parameter_Types := new Names'(1 => Name_Find);
+            end if;
+
+         else
+            return;
+         end if;
+      end if;
+
+      --  Process Result_Types argument
+
+      if Present (Arg_Result_Type) then
+         if Is_Config_Static_String (Arg_Result_Type) then
+            Data.Result_Type := Name_Find;
+         else
+            return;
+         end if;
+
+      --  Here if no Result_Types argument
+
+      else
+         Data.Result_Type := No_Name;
+      end if;
+
+      --  Process Source_Location argument
+
+      if Present (Arg_Source_Location) then
+         if Is_Config_Static_String (Arg_Source_Location) then
+            Data.Source_Location := Name_Find;
+         else
+            return;
+         end if;
+      else
+         Data.Source_Location := No_Name;
+      end if;
+
+      Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data));
+
+      --  If we already have an entry with this same key, then link
+      --  it into the chain of entries for this key.
+
+      if Elmt /= null then
+         Data.Homonym := Elmt.Homonym;
+         Elmt.Homonym := Data;
+
+      --  Otherwise create a new entry
+
+      else
+         Elim_Hash_Table.Set (Data);
+      end if;
+
+      No_Elimination := False;
+   end Process_Eliminate_Pragma;
+
+end Sem_Elim;