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