gcc/ada/sem_elim.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S E M _ E L I M                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1997-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;    use Atree;
  27 with Einfo;    use Einfo;
  28 with Errout;   use Errout;
  29 with Lib;      use Lib;
  30 with Namet;    use Namet;
  31 with Nlists;   use Nlists;
  32 with Sem;      use Sem;
  33 with Sem_Prag; use Sem_Prag;
  34 with Sem_Util; use Sem_Util;
  35 with Sinput;   use Sinput;
  36 with Sinfo;    use Sinfo;
  37 with Snames;   use Snames;
  38 with Stand;    use Stand;
  39 with Stringt;  use Stringt;
  40 with Table;
  41
  42 with GNAT.HTable; use GNAT.HTable;
  43
  44 package body Sem_Elim is
  45
  46    No_Elimination : Boolean;
  47    --  Set True if no Eliminate pragmas active
  48
  49    ---------------------
  50    -- Data Structures --
  51    ---------------------
  52
  53    --  A single pragma Eliminate is represented by the following record
  54
  55    type Elim_Data;
  56    type Access_Elim_Data is access Elim_Data;
  57
  58    type Names is array (Nat range <>) of Name_Id;
  59    --  Type used to represent set of names. Used for names in Unit_Name
  60    --  and also the set of names in Argument_Types.
  61
  62    type Access_Names is access Names;
  63
  64    type Elim_Data is record
  65
  66       Unit_Name : Access_Names;
  67       --  Unit name, broken down into a set of names (e.g. A.B.C is
  68       --  represented as Name_Id values for A, B, C in sequence).
  69
  70       Entity_Name : Name_Id;
  71       --  Entity name if Entity parameter if present. If no Entity parameter
  72       --  was supplied, then Entity_Node is set to Empty, and the Entity_Name
  73       --  field contains the last identifier name in the Unit_Name.
  74
  75       Entity_Scope : Access_Names;
  76       --  Static scope of the entity within the compilation unit represented by
  77       --  Unit_Name.
  78
  79       Entity_Node : Node_Id;
  80       --  Save node of entity argument, for posting error messages. Set
  81       --  to Empty if there is no entity argument.
  82
  83       Parameter_Types : Access_Names;
  84       --  Set to set of names given for parameter types. If no parameter
  85       --  types argument is present, this argument is set to null.
  86
  87       Result_Type : Name_Id;
  88       --  Result type name if Result_Types parameter present, No_Name if not
  89
  90       Source_Location : Name_Id;
  91       --  String describing the source location of subprogram defining name if
  92       --  Source_Location parameter present, No_Name if not
  93
  94       Hash_Link : Access_Elim_Data;
  95       --  Link for hash table use
  96
  97       Homonym : Access_Elim_Data;
  98       --  Pointer to next entry with same key
  99
 100       Prag : Node_Id;
 101       --  Node_Id for Eliminate pragma
 102
 103    end record;
 104
 105    ----------------
 106    -- Hash_Table --
 107    ----------------
 108
 109    --  Setup hash table using the Entity_Name field as the hash key
 110
 111    subtype Element is Elim_Data;
 112    subtype Elmt_Ptr is Access_Elim_Data;
 113
 114    subtype Key is Name_Id;
 115
 116    type Header_Num is range 0 .. 1023;
 117
 118    Null_Ptr : constant Elmt_Ptr := null;
 119
 120    ----------------------
 121    -- Hash_Subprograms --
 122    ----------------------
 123
 124    package Hash_Subprograms is
 125
 126       function Equal (F1, F2 : Key) return Boolean;
 127       pragma Inline (Equal);
 128
 129       function Get_Key (E : Elmt_Ptr) return Key;
 130       pragma Inline (Get_Key);
 131
 132       function Hash (F : Key) return Header_Num;
 133       pragma Inline (Hash);
 134
 135       function Next (E : Elmt_Ptr) return Elmt_Ptr;
 136       pragma Inline (Next);
 137
 138       procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
 139       pragma Inline (Set_Next);
 140
 141    end Hash_Subprograms;
 142
 143    package body Hash_Subprograms is
 144
 145       -----------
 146       -- Equal --
 147       -----------
 148
 149       function Equal (F1, F2 : Key) return Boolean is
 150       begin
 151          return F1 = F2;
 152       end Equal;
 153
 154       -------------
 155       -- Get_Key --
 156       -------------
 157
 158       function Get_Key (E : Elmt_Ptr) return Key is
 159       begin
 160          return E.Entity_Name;
 161       end Get_Key;
 162
 163       ----------
 164       -- Hash --
 165       ----------
 166
 167       function Hash (F : Key) return Header_Num is
 168       begin
 169          return Header_Num (Int (F) mod 1024);
 170       end Hash;
 171
 172       ----------
 173       -- Next --
 174       ----------
 175
 176       function Next (E : Elmt_Ptr) return Elmt_Ptr is
 177       begin
 178          return E.Hash_Link;
 179       end Next;
 180
 181       --------------
 182       -- Set_Next --
 183       --------------
 184
 185       procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
 186       begin
 187          E.Hash_Link := Next;
 188       end Set_Next;
 189    end Hash_Subprograms;
 190
 191    ------------
 192    -- Tables --
 193    ------------
 194
 195    --  The following table records the data for each pragmas, using the
 196    --  entity name as the hash key for retrieval. Entries in this table
 197    --  are set by Process_Eliminate_Pragma and read by Check_Eliminated.
 198
 199    package Elim_Hash_Table is new Static_HTable (
 200       Header_Num => Header_Num,
 201       Element    => Element,
 202       Elmt_Ptr   => Elmt_Ptr,
 203       Null_Ptr   => Null_Ptr,
 204       Set_Next   => Hash_Subprograms.Set_Next,
 205       Next       => Hash_Subprograms.Next,
 206       Key        => Key,
 207       Get_Key    => Hash_Subprograms.Get_Key,
 208       Hash       => Hash_Subprograms.Hash,
 209       Equal      => Hash_Subprograms.Equal);
 210
 211    --  The following table records entities for subprograms that are
 212    --  eliminated, and corresponding eliminate pragmas that caused the
 213    --  elimination. Entries in this table are set by Check_Eliminated
 214    --  and read by Eliminate_Error_Msg.
 215
 216    type Elim_Entity_Entry is record
 217       Prag : Node_Id;
 218       Subp : Entity_Id;
 219    end record;
 220
 221    package Elim_Entities is new Table.Table (
 222      Table_Component_Type => Elim_Entity_Entry,
 223      Table_Index_Type     => Name_Id'Base,
 224      Table_Low_Bound      => First_Name_Id,
 225      Table_Initial        => 50,
 226      Table_Increment      => 200,
 227      Table_Name           => "Elim_Entries");
 228
 229    ----------------------
 230    -- Check_Eliminated --
 231    ----------------------
 232
 233    procedure Check_Eliminated (E : Entity_Id) is
 234       Elmt : Access_Elim_Data;
 235       Scop : Entity_Id;
 236       Form : Entity_Id;
 237
 238    begin
 239       if No_Elimination then
 240          return;
 241
 242       --  Elimination of objects and types is not implemented yet
 243
 244       elsif Ekind (E) not in Subprogram_Kind then
 245          return;
 246       end if;
 247
 248       --  Loop through homonyms for this key
 249
 250       Elmt := Elim_Hash_Table.Get (Chars (E));
 251       while Elmt /= null loop
 252          Check_Homonyms : declare
 253             procedure Set_Eliminated;
 254             --  Set current subprogram entity as eliminated
 255
 256             --------------------
 257             -- Set_Eliminated --
 258             --------------------
 259
 260             procedure Set_Eliminated is
 261             begin
 262                if Is_Dispatching_Operation (E) then
 263
 264                   --  If an overriding dispatching primitive is eliminated then
 265                   --  its parent must have been eliminated.
 266
 267                   if Is_Overriding_Operation (E)
 268                     and then not Is_Eliminated (Overridden_Operation (E))
 269                   then
 270                      Error_Msg_Name_1 := Chars (E);
 271                      Error_Msg_N ("cannot eliminate subprogram %", E);
 272                      return;
 273                   end if;
 274                end if;
 275
 276                Set_Is_Eliminated (E);
 277                Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
 278             end Set_Eliminated;
 279
 280          --  Start of processing for Check_Homonyms
 281
 282          begin
 283             --  First we check that the name of the entity matches
 284
 285             if Elmt.Entity_Name /= Chars (E) then
 286                goto Continue;
 287             end if;
 288
 289             --  Find enclosing unit
 290
 291             Scop := Cunit_Entity (Current_Sem_Unit);
 292
 293             --  Now see if compilation unit matches
 294
 295             for J in reverse Elmt.Unit_Name'Range loop
 296                if Elmt.Unit_Name (J) /= Chars (Scop) then
 297                   goto Continue;
 298                end if;
 299
 300                Scop := Scope (Scop);
 301                while Ekind (Scop) = E_Block loop
 302                   Scop := Scope (Scop);
 303                end loop;
 304
 305                if Scop /= Standard_Standard and then J = 1 then
 306                   goto Continue;
 307                end if;
 308             end loop;
 309
 310             if Scop /= Standard_Standard then
 311                goto Continue;
 312             end if;
 313
 314             --  Check for case of given entity is a library level subprogram
 315             --  and we have the single parameter Eliminate case, a match!
 316
 317             if Is_Compilation_Unit (E)
 318               and then Is_Subprogram (E)
 319               and then No (Elmt.Entity_Node)
 320             then
 321                Set_Eliminated;
 322                return;
 323
 324                --  Check for case of type or object with two parameter case
 325
 326             elsif (Is_Type (E) or else Is_Object (E))
 327               and then Elmt.Result_Type = No_Name
 328               and then Elmt.Parameter_Types = null
 329             then
 330                Set_Eliminated;
 331                return;
 332
 333             --  Check for case of subprogram
 334
 335             elsif Ekind (E) = E_Function
 336               or else Ekind (E) = E_Procedure
 337             then
 338                --  If Source_Location present, then see if it matches
 339
 340                if Elmt.Source_Location /= No_Name then
 341                   Get_Name_String (Elmt.Source_Location);
 342
 343                   declare
 344                      Sloc_Trace : constant String :=
 345                                     Name_Buffer (1 .. Name_Len);
 346
 347                      Idx : Natural := Sloc_Trace'First;
 348                      --  Index in Sloc_Trace, if equals to 0, then we have
 349                      --  completely traversed Sloc_Trace
 350
 351                      Last : constant Natural := Sloc_Trace'Last;
 352
 353                      P      : Source_Ptr;
 354                      Sindex : Source_File_Index;
 355
 356                      function File_Name_Match return Boolean;
 357                      --  This function is supposed to be called when Idx points
 358                      --  to the beginning of the new file name, and Name_Buffer
 359                      --  is set to contain the name of the proper source file
 360                      --  from the chain corresponding to the Sloc of E. First
 361                      --  it checks that these two files have the same name. If
 362                      --  this check is successful, moves Idx to point to the
 363                      --  beginning of the column number.
 364
 365                      function Line_Num_Match return Boolean;
 366                      --  This function is supposed to be called when Idx points
 367                      --  to the beginning of the column number, and P is
 368                      --  set to point to the proper Sloc the chain
 369                      --  corresponding to the Sloc of E. First it checks that
 370                      --  the line number Idx points on and the line number
 371                      --  corresponding to P are the same. If this check is
 372                      --  successful, moves Idx to point to the beginning of
 373                      --  the next file name in Sloc_Trace. If there is no file
 374                      --  name any more, Idx is set to 0.
 375
 376                      function Different_Trace_Lengths return Boolean;
 377                      --  From Idx and P, defines if there are in both traces
 378                      --  more element(s) in the instantiation chains. Returns
 379                      --  False if one trace contains more element(s), but
 380                      --  another does not. If both traces contains more
 381                      --  elements (that is, the function returns False), moves
 382                      --  P ahead in the chain corresponding to E, recomputes
 383                      --  Sindex and sets the name of the corresponding file in
 384                      --  Name_Buffer
 385
 386                      function Skip_Spaces return Natural;
 387                      --  If Sloc_Trace (Idx) is not space character, returns
 388                      --  Idx. Otherwise returns the index of the nearest
 389                      --  non-space character in Sloc_Trace to the right of Idx.
 390                      --  Returns 0 if there is no such character.
 391
 392                      -----------------------------
 393                      -- Different_Trace_Lengths --
 394                      -----------------------------
 395
 396                      function Different_Trace_Lengths return Boolean is
 397                      begin
 398                         P := Instantiation (Sindex);
 399
 400                         if (P = No_Location and then Idx /= 0)
 401                           or else
 402                            (P /= No_Location and then Idx = 0)
 403                         then
 404                            return True;
 405
 406                         else
 407                            if P /= No_Location then
 408                               Sindex := Get_Source_File_Index (P);
 409                               Get_Name_String (File_Name (Sindex));
 410                            end if;
 411
 412                            return False;
 413                         end if;
 414                      end Different_Trace_Lengths;
 415
 416                      ---------------------
 417                      -- File_Name_Match --
 418                      ---------------------
 419
 420                      function File_Name_Match return Boolean is
 421                         Tmp_Idx : Natural;
 422                         End_Idx : Natural;
 423
 424                      begin
 425                         if Idx = 0 then
 426                            return False;
 427                         end if;
 428
 429                         --  Find first colon. If no colon, then return False.
 430                         --  If there is a colon, Tmp_Idx is set to point just
 431                         --  before the colon.
 432
 433                         Tmp_Idx := Idx - 1;
 434                         loop
 435                            if Tmp_Idx >= Last then
 436                               return False;
 437                            elsif Sloc_Trace (Tmp_Idx + 1) = ':' then
 438                               exit;
 439                            else
 440                               Tmp_Idx := Tmp_Idx + 1;
 441                            end if;
 442                         end loop;
 443
 444                         --  Find last non-space before this colon. If there is
 445                         --  no space character before this colon, then return
 446                         --  False. Otherwise, End_Idx is set to point to this
 447                         --  non-space character.
 448
 449                         End_Idx := Tmp_Idx;
 450                         loop
 451                            if End_Idx < Idx then
 452                               return False;
 453
 454                            elsif Sloc_Trace (End_Idx) /= ' ' then
 455                               exit;
 456
 457                            else
 458                               End_Idx := End_Idx - 1;
 459                            end if;
 460                         end loop;
 461
 462                         --  Now see if file name matches what is in Name_Buffer
 463                         --  and if so, step Idx past it and return True. If the
 464                         --  name does not match, return False.
 465
 466                         if Sloc_Trace (Idx .. End_Idx) =
 467                            Name_Buffer (1 .. Name_Len)
 468                         then
 469                            Idx := Tmp_Idx + 2;
 470                            Idx := Skip_Spaces;
 471                            return True;
 472                         else
 473                            return False;
 474                         end if;
 475                      end File_Name_Match;
 476
 477                      --------------------
 478                      -- Line_Num_Match --
 479                      --------------------
 480
 481                      function Line_Num_Match return Boolean is
 482                         N : Int := 0;
 483
 484                      begin
 485                         if Idx = 0 then
 486                            return False;
 487                         end if;
 488
 489                         while Idx <= Last
 490                            and then Sloc_Trace (Idx) in '0' .. '9'
 491                         loop
 492                            N := N * 10 +
 493                             (Character'Pos (Sloc_Trace (Idx)) -
 494                              Character'Pos ('0'));
 495                            Idx := Idx + 1;
 496                         end loop;
 497
 498                         if Get_Physical_Line_Number (P) =
 499                            Physical_Line_Number (N)
 500                         then
 501                            while Idx <= Last and then
 502                               Sloc_Trace (Idx) /= '['
 503                            loop
 504                               Idx := Idx + 1;
 505                            end loop;
 506
 507                            if Idx <= Last and then
 508                              Sloc_Trace (Idx) = '['
 509                            then
 510                               Idx := Idx + 1;
 511                               Idx := Skip_Spaces;
 512                            else
 513                               Idx := 0;
 514                            end if;
 515
 516                            return True;
 517
 518                         else
 519                            return False;
 520                         end if;
 521                      end Line_Num_Match;
 522
 523                      -----------------
 524                      -- Skip_Spaces --
 525                      -----------------
 526
 527                      function Skip_Spaces return Natural is
 528                         Res : Natural;
 529
 530                      begin
 531                         Res := Idx;
 532                         while Sloc_Trace (Res) = ' ' loop
 533                            Res := Res + 1;
 534
 535                            if Res > Last then
 536                               Res := 0;
 537                               exit;
 538                            end if;
 539                         end loop;
 540
 541                         return Res;
 542                      end Skip_Spaces;
 543
 544                   begin
 545                      P := Sloc (E);
 546                      Sindex := Get_Source_File_Index (P);
 547                      Get_Name_String (File_Name (Sindex));
 548
 549                      Idx := Skip_Spaces;
 550                      while Idx > 0 loop
 551                         if not File_Name_Match then
 552                            goto Continue;
 553                         elsif not Line_Num_Match then
 554                            goto Continue;
 555                         end if;
 556
 557                         if Different_Trace_Lengths then
 558                            goto Continue;
 559                         end if;
 560                      end loop;
 561                   end;
 562                end if;
 563
 564                --  If we have a Result_Type, then we must have a function with
 565                --  the proper result type.
 566
 567                if Elmt.Result_Type /= No_Name then
 568                   if Ekind (E) /= E_Function
 569                     or else Chars (Etype (E)) /= Elmt.Result_Type
 570                   then
 571                      goto Continue;
 572                   end if;
 573                end if;
 574
 575                --  If we have Parameter_Types, they must match
 576
 577                if Elmt.Parameter_Types /= null then
 578                   Form := First_Formal (E);
 579
 580                   if No (Form)
 581                     and then Elmt.Parameter_Types'Length = 1
 582                     and then Elmt.Parameter_Types (1) = No_Name
 583                   then
 584                      --  Parameterless procedure matches
 585
 586                      null;
 587
 588                   elsif Elmt.Parameter_Types = null then
 589                      goto Continue;
 590
 591                   else
 592                      for J in Elmt.Parameter_Types'Range loop
 593                         if No (Form)
 594                           or else
 595                             Chars (Etype (Form)) /= Elmt.Parameter_Types (J)
 596                         then
 597                            goto Continue;
 598                         else
 599                            Next_Formal (Form);
 600                         end if;
 601                      end loop;
 602
 603                      if Present (Form) then
 604                         goto Continue;
 605                      end if;
 606                   end if;
 607                end if;
 608
 609                --  If we fall through, this is match
 610
 611                Set_Eliminated;
 612                return;
 613             end if;
 614          end Check_Homonyms;
 615
 616       <<Continue>>
 617          Elmt := Elmt.Homonym;
 618       end loop;
 619
 620       return;
 621    end Check_Eliminated;
 622
 623    -------------------------------------
 624    -- Check_For_Eliminated_Subprogram --
 625    -------------------------------------
 626
 627    procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id) is
 628       Ultimate_Subp  : constant Entity_Id := Ultimate_Alias (S);
 629       Enclosing_Subp : Entity_Id;
 630
 631    begin
 632       if Is_Eliminated (Ultimate_Subp)
 633         and then not Inside_A_Generic
 634         and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
 635       then
 636          Enclosing_Subp := Current_Subprogram;
 637          while Present (Enclosing_Subp) loop
 638             if Is_Eliminated (Enclosing_Subp) then
 639                return;
 640             end if;
 641
 642             Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp);
 643          end loop;
 644
 645          Eliminate_Error_Msg (N, Ultimate_Subp);
 646       end if;
 647    end Check_For_Eliminated_Subprogram;
 648
 649    -------------------------
 650    -- Eliminate_Error_Msg --
 651    -------------------------
 652
 653    procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id) is
 654    begin
 655       for J in Elim_Entities.First .. Elim_Entities.Last loop
 656          if E = Elim_Entities.Table (J).Subp then
 657             Error_Msg_Sloc := Sloc (Elim_Entities.Table (J).Prag);
 658             Error_Msg_NE ("cannot reference subprogram & eliminated #", N, E);
 659             return;
 660          end if;
 661       end loop;
 662
 663       --  If this is an internal operation generated for a protected operation,
 664       --  its name does not match the source name, so just report the error.
 665
 666       if not Comes_From_Source (E)
 667         and then Present (First_Entity (E))
 668         and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
 669       then
 670          Error_Msg_NE
 671            ("cannot reference eliminated protected subprogram", N, E);
 672
 673       --  Otherwise should not fall through, entry should be in table
 674
 675       else
 676          raise Program_Error;
 677       end if;
 678    end Eliminate_Error_Msg;
 679
 680    ----------------
 681    -- Initialize --
 682    ----------------
 683
 684    procedure Initialize is
 685    begin
 686       Elim_Hash_Table.Reset;
 687       Elim_Entities.Init;
 688       No_Elimination := True;
 689    end Initialize;
 690
 691    ------------------------------
 692    -- Process_Eliminate_Pragma --
 693    ------------------------------
 694
 695    procedure Process_Eliminate_Pragma
 696      (Pragma_Node         : Node_Id;
 697       Arg_Unit_Name       : Node_Id;
 698       Arg_Entity          : Node_Id;
 699       Arg_Parameter_Types : Node_Id;
 700       Arg_Result_Type     : Node_Id;
 701       Arg_Source_Location : Node_Id)
 702    is
 703       Data : constant Access_Elim_Data := new Elim_Data;
 704       --  Build result data here
 705
 706       Elmt : Access_Elim_Data;
 707
 708       Num_Names : Nat := 0;
 709       --  Number of names in unit name
 710
 711       Lit       : Node_Id;
 712       Arg_Ent   : Entity_Id;
 713       Arg_Uname : Node_Id;
 714
 715       function OK_Selected_Component (N : Node_Id) return Boolean;
 716       --  Test if N is a selected component with all identifiers, or a
 717       --  selected component whose selector is an operator symbol. As a
 718       --  side effect if result is True, sets Num_Names to the number
 719       --  of names present (identifiers and operator if any).
 720
 721       ---------------------------
 722       -- OK_Selected_Component --
 723       ---------------------------
 724
 725       function OK_Selected_Component (N : Node_Id) return Boolean is
 726       begin
 727          if Nkind (N) = N_Identifier
 728            or else Nkind (N) = N_Operator_Symbol
 729          then
 730             Num_Names := Num_Names + 1;
 731             return True;
 732
 733          elsif Nkind (N) = N_Selected_Component then
 734             return OK_Selected_Component (Prefix (N))
 735               and then OK_Selected_Component (Selector_Name (N));
 736
 737          else
 738             return False;
 739          end if;
 740       end OK_Selected_Component;
 741
 742    --  Start of processing for Process_Eliminate_Pragma
 743
 744    begin
 745       Data.Prag := Pragma_Node;
 746       Error_Msg_Name_1 := Name_Eliminate;
 747
 748       --  Process Unit_Name argument
 749
 750       if Nkind (Arg_Unit_Name) = N_Identifier then
 751          Data.Unit_Name := new Names'(1 => Chars (Arg_Unit_Name));
 752          Num_Names := 1;
 753
 754       elsif OK_Selected_Component (Arg_Unit_Name) then
 755          Data.Unit_Name := new Names (1 .. Num_Names);
 756
 757          Arg_Uname := Arg_Unit_Name;
 758          for J in reverse 2 .. Num_Names loop
 759             Data.Unit_Name (J) := Chars (Selector_Name (Arg_Uname));
 760             Arg_Uname := Prefix (Arg_Uname);
 761          end loop;
 762
 763          Data.Unit_Name (1) := Chars (Arg_Uname);
 764
 765       else
 766          Error_Msg_N
 767            ("wrong form for Unit_Name parameter of pragma%", Arg_Unit_Name);
 768          return;
 769       end if;
 770
 771       --  Process Entity argument
 772
 773       if Present (Arg_Entity) then
 774          Num_Names := 0;
 775
 776          if Nkind (Arg_Entity) = N_Identifier
 777            or else Nkind (Arg_Entity) = N_Operator_Symbol
 778          then
 779             Data.Entity_Name  := Chars (Arg_Entity);
 780             Data.Entity_Node  := Arg_Entity;
 781             Data.Entity_Scope := null;
 782
 783          elsif OK_Selected_Component (Arg_Entity) then
 784             Data.Entity_Scope := new Names (1 .. Num_Names - 1);
 785             Data.Entity_Name  := Chars (Selector_Name (Arg_Entity));
 786             Data.Entity_Node  := Arg_Entity;
 787
 788             Arg_Ent := Prefix (Arg_Entity);
 789             for J in reverse 2 .. Num_Names - 1 loop
 790                Data.Entity_Scope (J) := Chars (Selector_Name (Arg_Ent));
 791                Arg_Ent := Prefix (Arg_Ent);
 792             end loop;
 793
 794             Data.Entity_Scope (1) := Chars (Arg_Ent);
 795
 796          elsif Is_Config_Static_String (Arg_Entity) then
 797             Data.Entity_Name := Name_Find;
 798             Data.Entity_Node := Arg_Entity;
 799
 800          else
 801             return;
 802          end if;
 803       else
 804          Data.Entity_Node := Empty;
 805          Data.Entity_Name := Data.Unit_Name (Num_Names);
 806       end if;
 807
 808       --  Process Parameter_Types argument
 809
 810       if Present (Arg_Parameter_Types) then
 811
 812          --  Here for aggregate case
 813
 814          if Nkind (Arg_Parameter_Types) = N_Aggregate then
 815             Data.Parameter_Types :=
 816               new Names
 817                 (1 .. List_Length (Expressions (Arg_Parameter_Types)));
 818
 819             Lit := First (Expressions (Arg_Parameter_Types));
 820             for J in Data.Parameter_Types'Range loop
 821                if Is_Config_Static_String (Lit) then
 822                   Data.Parameter_Types (J) := Name_Find;
 823                   Next (Lit);
 824                else
 825                   return;
 826                end if;
 827             end loop;
 828
 829          --  Otherwise we must have case of one name, which looks like a
 830          --  parenthesized literal rather than an aggregate.
 831
 832          elsif Paren_Count (Arg_Parameter_Types) /= 1 then
 833             Error_Msg_N
 834               ("wrong form for argument of pragma Eliminate",
 835                Arg_Parameter_Types);
 836             return;
 837
 838          elsif Is_Config_Static_String (Arg_Parameter_Types) then
 839             String_To_Name_Buffer (Strval (Arg_Parameter_Types));
 840
 841             if Name_Len = 0 then
 842
 843                --  Parameterless procedure
 844
 845                Data.Parameter_Types := new Names'(1 => No_Name);
 846
 847             else
 848                Data.Parameter_Types := new Names'(1 => Name_Find);
 849             end if;
 850
 851          else
 852             return;
 853          end if;
 854       end if;
 855
 856       --  Process Result_Types argument
 857
 858       if Present (Arg_Result_Type) then
 859          if Is_Config_Static_String (Arg_Result_Type) then
 860             Data.Result_Type := Name_Find;
 861          else
 862             return;
 863          end if;
 864
 865       --  Here if no Result_Types argument
 866
 867       else
 868          Data.Result_Type := No_Name;
 869       end if;
 870
 871       --  Process Source_Location argument
 872
 873       if Present (Arg_Source_Location) then
 874          if Is_Config_Static_String (Arg_Source_Location) then
 875             Data.Source_Location := Name_Find;
 876          else
 877             return;
 878          end if;
 879       else
 880          Data.Source_Location := No_Name;
 881       end if;
 882
 883       Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data));
 884
 885       --  If we already have an entry with this same key, then link
 886       --  it into the chain of entries for this key.
 887
 888       if Elmt /= null then
 889          Data.Homonym := Elmt.Homonym;
 890          Elmt.Homonym := Data;
 891
 892       --  Otherwise create a new entry
 893
 894       else
 895          Elim_Hash_Table.Set (Data);
 896       end if;
 897
 898       No_Elimination := False;
 899    end Process_Eliminate_Pragma;
 900
 901 end Sem_Elim;