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