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-2004 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,
 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             procedure Set_Eliminated is
 278             begin
 279                Set_Is_Eliminated (E);
 280                Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
 281             end Set_Eliminated;
 282
 283          begin
 284             --  First we check that the name of the entity matches
 285
 286             if Elmt.Entity_Name /= Chars (E) then
 287                goto Continue;
 288             end if;
 289
 290             --  Then we need to see if the static scope matches within the
 291             --  compilation unit.
 292
 293             --  At the moment, gnatelim does not consider block statements as
 294             --  scopes (even if a block is named)
 295
 296             Scop := Scope (E);
 297             while Ekind (Scop) = E_Block loop
 298                Scop := Scope (Scop);
 299             end loop;
 300
 301             if Elmt.Entity_Scope /= null then
 302                for J in reverse Elmt.Entity_Scope'Range loop
 303                   if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
 304                      goto Continue;
 305                   end if;
 306
 307                   Scop := Scope (Scop);
 308                   while Ekind (Scop) = E_Block loop
 309                      Scop := Scope (Scop);
 310                   end loop;
 311
 312                   if not Is_Compilation_Unit (Scop) and then J = 1 then
 313                      goto Continue;
 314                   end if;
 315                end loop;
 316             end if;
 317
 318             --  Now see if compilation unit matches
 319
 320             for J in reverse Elmt.Unit_Name'Range loop
 321                if Elmt.Unit_Name (J) /= Chars (Scop) then
 322                   goto Continue;
 323                end if;
 324
 325                Scop := Scope (Scop);
 326                while Ekind (Scop) = E_Block loop
 327                   Scop := Scope (Scop);
 328                end loop;
 329
 330                if Scop /= Standard_Standard and then J = 1 then
 331                   goto Continue;
 332                end if;
 333             end loop;
 334
 335             if Scop /= Standard_Standard then
 336                goto Continue;
 337             end if;
 338
 339             --  Check for case of given entity is a library level subprogram
 340             --  and we have the single parameter Eliminate case, a match!
 341
 342             if Is_Compilation_Unit (E)
 343               and then Is_Subprogram (E)
 344               and then No (Elmt.Entity_Node)
 345             then
 346                Set_Eliminated;
 347                return;
 348
 349                --  Check for case of type or object with two parameter case
 350
 351             elsif (Is_Type (E) or else Is_Object (E))
 352               and then Elmt.Result_Type = No_Name
 353               and then Elmt.Parameter_Types = null
 354             then
 355                Set_Eliminated;
 356                return;
 357
 358             --  Check for case of subprogram
 359
 360             elsif Ekind (E) = E_Function
 361               or else Ekind (E) = E_Procedure
 362             then
 363                --  If Source_Location present, then see if it matches
 364
 365                if Elmt.Source_Location /= No_Name then
 366                   Get_Name_String (Elmt.Source_Location);
 367
 368                   declare
 369                      Sloc_Trace : constant String :=
 370                                     Name_Buffer (1 .. Name_Len);
 371
 372                      Idx : Natural := Sloc_Trace'First;
 373                      --  Index in Sloc_Trace, if equals to 0, then we have
 374                      --  completely traversed Sloc_Trace
 375
 376                      Last : constant Natural := Sloc_Trace'Last;
 377
 378                      P      : Source_Ptr;
 379                      Sindex : Source_File_Index;
 380
 381                      function File_Name_Match return Boolean;
 382                      --  This function is supposed to be called when Idx points
 383                      --  to the beginning of the new file name, and Name_Buffer
 384                      --  is set to contain the name of the proper source file
 385                      --  from the chain corresponding to the Sloc of E. First
 386                      --  it checks that these two files have the same name. If
 387                      --  this check is successful, moves Idx to point to the
 388                      --  beginning of the column number.
 389
 390                      function Line_Num_Match return Boolean;
 391                      --  This function is supposed to be called when Idx points
 392                      --  to the beginning of the column number, and P is
 393                      --  set to point to the proper Sloc the chain
 394                      --  corresponding to the Sloc of E. First it checks that
 395                      --  the line number Idx points on and the line number
 396                      --  corresponding to P are the same. If this check is
 397                      --  successful, moves Idx to point to the beginning of
 398                      --  the next file name in Sloc_Trace. If there is no file
 399                      --  name any more, Idx is set to 0.
 400
 401                      function Different_Trace_Lengths return Boolean;
 402                      --  From Idx and P, defines if there are in both traces
 403                      --  more element(s) in the instantiation chains. Returns
 404                      --  False if one trace contains more element(s), but
 405                      --  another does not. If both traces contains more
 406                      --  elements (that is, the function returns False), moves
 407                      --  P ahead in the chain corresponding to E, recomputes
 408                      --  Sindex and sets the name of the corresponding file in
 409                      --  Name_Buffer
 410
 411                      function Skip_Spaces return Natural;
 412                      --  If Sloc_Trace (Idx) is not space character, returns
 413                      --  Idx. Otherwise returns the index of the nearest
 414                      --  non-space character in Sloc_Trace to the right of
 415                      --  Idx. Returns 0 if there is no such character.
 416
 417                      -----------------------------
 418                      -- Different_Trace_Lengths --
 419                      -----------------------------
 420
 421                      function Different_Trace_Lengths return Boolean is
 422                      begin
 423                         P := Instantiation (Sindex);
 424
 425                         if (P = No_Location and then Idx /= 0)
 426                           or else
 427                            (P /= No_Location and then Idx = 0)
 428                         then
 429                            return True;
 430
 431                         else
 432                            if P /= No_Location then
 433                               Sindex := Get_Source_File_Index (P);
 434                               Get_Name_String (File_Name (Sindex));
 435                            end if;
 436
 437                            return False;
 438                         end if;
 439                      end Different_Trace_Lengths;
 440
 441                      ---------------------
 442                      -- File_Name_Match --
 443                      ---------------------
 444
 445                      function File_Name_Match return Boolean is
 446                         Tmp_Idx : Natural;
 447                         End_Idx : Natural;
 448
 449                      begin
 450                         if Idx = 0 then
 451                            return False;
 452                         end if;
 453
 454                         --  Find first colon. If no colon, then return False.
 455                         --  If there is a colon, Tmp_Idx is set to point just
 456                         --  before the colon.
 457
 458                         Tmp_Idx := Idx - 1;
 459                         loop
 460                            if Tmp_Idx >= Last then
 461                               return False;
 462                            elsif Sloc_Trace (Tmp_Idx + 1) = ':' then
 463                               exit;
 464                            else
 465                               Tmp_Idx := Tmp_Idx + 1;
 466                            end if;
 467                         end loop;
 468
 469                         --  Find last non-space before this colon. If there
 470                         --  is no no space character before this colon, then
 471                         --  return False. Otherwise, End_Idx set to point to
 472                         --  this non-space character.
 473
 474                         End_Idx := Tmp_Idx;
 475                         loop
 476                            if End_Idx < Idx then
 477                               return False;
 478                            elsif Sloc_Trace (End_Idx) /= ' ' then
 479                               exit;
 480                            else
 481                               End_Idx := End_Idx - 1;
 482                            end if;
 483                         end loop;
 484
 485                         --  Now see if file name matches what is in Name_Buffer
 486                         --  and if so, step Idx past it and return True. If the
 487                         --  name does not match, return False.
 488
 489                         if Sloc_Trace (Idx .. End_Idx) =
 490                            Name_Buffer (1 .. Name_Len)
 491                         then
 492                            Idx := Tmp_Idx + 2;
 493                            Idx := Skip_Spaces;
 494                            return True;
 495                         else
 496                            return False;
 497                         end if;
 498                      end File_Name_Match;
 499
 500                      --------------------
 501                      -- Line_Num_Match --
 502                      --------------------
 503
 504                      function Line_Num_Match return Boolean is
 505                         N : Int := 0;
 506
 507                      begin
 508                         if Idx = 0 then
 509                            return False;
 510                         end if;
 511
 512                         while Idx <= Last
 513                            and then Sloc_Trace (Idx) in '0' .. '9'
 514                         loop
 515                            N := N * 10 +
 516                             (Character'Pos (Sloc_Trace (Idx)) -
 517                              Character'Pos ('0'));
 518                            Idx := Idx + 1;
 519                         end loop;
 520
 521                         if Get_Physical_Line_Number (P) =
 522                            Physical_Line_Number (N)
 523                         then
 524                            while Idx <= Last and then
 525                               Sloc_Trace (Idx) /= '['
 526                            loop
 527                               Idx := Idx + 1;
 528                            end loop;
 529
 530                            if Idx <= Last and then
 531                              Sloc_Trace (Idx) = '['
 532                            then
 533                               Idx := Idx + 1;
 534                               Idx := Skip_Spaces;
 535                            else
 536                               Idx := 0;
 537                            end if;
 538
 539                            return True;
 540                         else
 541                            return False;
 542                         end if;
 543                      end Line_Num_Match;
 544
 545                      -----------------
 546                      -- Skip_Spaces --
 547                      -----------------
 548
 549                      function Skip_Spaces return Natural is
 550                         Res : Natural := Idx;
 551
 552                      begin
 553                         while Sloc_Trace (Res) = ' ' loop
 554                            Res := Res + 1;
 555
 556                            if Res > Last then
 557                               Res := 0;
 558                               exit;
 559                            end if;
 560                         end loop;
 561
 562                         return Res;
 563                      end Skip_Spaces;
 564
 565                   begin
 566                      P := Sloc (E);
 567                      Sindex := Get_Source_File_Index (P);
 568                      Get_Name_String (File_Name (Sindex));
 569
 570                      Idx := Skip_Spaces;
 571                      while Idx > 0 loop
 572                         if not File_Name_Match then
 573                            goto Continue;
 574                         elsif not Line_Num_Match then
 575                            goto Continue;
 576                         end if;
 577
 578                         if Different_Trace_Lengths then
 579                            goto Continue;
 580                         end if;
 581                      end loop;
 582                   end;
 583                end if;
 584
 585                --  If we have a Result_Type, then we must have a function
 586                --  with the proper result type
 587
 588                if Elmt.Result_Type /= No_Name then
 589                   if Ekind (E) /= E_Function
 590                     or else Chars (Etype (E)) /= Elmt.Result_Type
 591                   then
 592                      goto Continue;
 593                   end if;
 594                end if;
 595
 596                --  If we have Parameter_Types, they must match
 597
 598                if Elmt.Parameter_Types /= null then
 599                   Form := First_Formal (E);
 600
 601                   if No (Form)
 602                     and then Elmt.Parameter_Types'Length = 1
 603                     and then Elmt.Parameter_Types (1) = No_Name
 604                   then
 605                      --  Parameterless procedure matches
 606
 607                      null;
 608
 609                   elsif Elmt.Parameter_Types = null then
 610                      goto Continue;
 611
 612                   else
 613                      for J in Elmt.Parameter_Types'Range loop
 614                         if No (Form)
 615                           or else
 616                             Chars (Etype (Form)) /= Elmt.Parameter_Types (J)
 617                         then
 618                            goto Continue;
 619                         else
 620                            Next_Formal (Form);
 621                         end if;
 622                      end loop;
 623
 624                      if Present (Form) then
 625                         goto Continue;
 626                      end if;
 627                   end if;
 628                end if;
 629
 630                --  If we fall through, this is match
 631
 632                Set_Eliminated;
 633                return;
 634             end if;
 635          end;
 636
 637       <<Continue>>
 638          Elmt := Elmt.Homonym;
 639       end loop;
 640
 641       return;
 642    end Check_Eliminated;
 643
 644    -------------------------
 645    -- Eliminate_Error_Msg --
 646    -------------------------
 647
 648    procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id) is
 649    begin
 650       for J in Elim_Entities.First .. Elim_Entities.Last loop
 651          if E = Elim_Entities.Table (J).Subp then
 652             Error_Msg_Sloc := Sloc (Elim_Entities.Table (J).Prag);
 653             Error_Msg_NE ("cannot call subprogram & eliminated #", N, E);
 654             return;
 655          end if;
 656       end loop;
 657
 658       --  Should never fall through, since entry should be in table
 659
 660       raise Program_Error;
 661    end Eliminate_Error_Msg;
 662
 663    ----------------
 664    -- Initialize --
 665    ----------------
 666
 667    procedure Initialize is
 668    begin
 669       Elim_Hash_Table.Reset;
 670       Elim_Entities.Init;
 671       No_Elimination := True;
 672    end Initialize;
 673
 674    ------------------------------
 675    -- Process_Eliminate_Pragma --
 676    ------------------------------
 677
 678    procedure Process_Eliminate_Pragma
 679      (Pragma_Node         : Node_Id;
 680       Arg_Unit_Name       : Node_Id;
 681       Arg_Entity          : Node_Id;
 682       Arg_Parameter_Types : Node_Id;
 683       Arg_Result_Type     : Node_Id;
 684       Arg_Source_Location : Node_Id)
 685    is
 686       Data : constant Access_Elim_Data := new Elim_Data;
 687       --  Build result data here
 688
 689       Elmt : Access_Elim_Data;
 690
 691       Num_Names : Nat := 0;
 692       --  Number of names in unit name
 693
 694       Lit       : Node_Id;
 695       Arg_Ent   : Entity_Id;
 696       Arg_Uname : Node_Id;
 697
 698       function OK_Selected_Component (N : Node_Id) return Boolean;
 699       --  Test if N is a selected component with all identifiers, or a
 700       --  selected component whose selector is an operator symbol. As a
 701       --  side effect if result is True, sets Num_Names to the number
 702       --  of names present (identifiers and operator if any).
 703
 704       ---------------------------
 705       -- OK_Selected_Component --
 706       ---------------------------
 707
 708       function OK_Selected_Component (N : Node_Id) return Boolean is
 709       begin
 710          if Nkind (N) = N_Identifier
 711            or else Nkind (N) = N_Operator_Symbol
 712          then
 713             Num_Names := Num_Names + 1;
 714             return True;
 715
 716          elsif Nkind (N) = N_Selected_Component then
 717             return OK_Selected_Component (Prefix (N))
 718               and then OK_Selected_Component (Selector_Name (N));
 719
 720          else
 721             return False;
 722          end if;
 723       end OK_Selected_Component;
 724
 725    --  Start of processing for Process_Eliminate_Pragma
 726
 727    begin
 728       Data.Prag := Pragma_Node;
 729       Error_Msg_Name_1 := Name_Eliminate;
 730
 731       --  Process Unit_Name argument
 732
 733       if Nkind (Arg_Unit_Name) = N_Identifier then
 734          Data.Unit_Name := new Names'(1 => Chars (Arg_Unit_Name));
 735          Num_Names := 1;
 736
 737       elsif OK_Selected_Component (Arg_Unit_Name) then
 738          Data.Unit_Name := new Names (1 .. Num_Names);
 739
 740          Arg_Uname := Arg_Unit_Name;
 741          for J in reverse 2 .. Num_Names loop
 742             Data.Unit_Name (J) := Chars (Selector_Name (Arg_Uname));
 743             Arg_Uname := Prefix (Arg_Uname);
 744          end loop;
 745
 746          Data.Unit_Name (1) := Chars (Arg_Uname);
 747
 748       else
 749          Error_Msg_N
 750            ("wrong form for Unit_Name parameter of pragma%", Arg_Unit_Name);
 751          return;
 752       end if;
 753
 754       --  Process Entity argument
 755
 756       if Present (Arg_Entity) then
 757          Num_Names := 0;
 758
 759          if Nkind (Arg_Entity) = N_Identifier
 760            or else Nkind (Arg_Entity) = N_Operator_Symbol
 761          then
 762             Data.Entity_Name  := Chars (Arg_Entity);
 763             Data.Entity_Node  := Arg_Entity;
 764             Data.Entity_Scope := null;
 765
 766          elsif OK_Selected_Component (Arg_Entity) then
 767             Data.Entity_Scope := new Names (1 .. Num_Names - 1);
 768             Data.Entity_Name  := Chars (Selector_Name (Arg_Entity));
 769             Data.Entity_Node  := Arg_Entity;
 770
 771             Arg_Ent := Prefix (Arg_Entity);
 772             for J in reverse 2 .. Num_Names - 1 loop
 773                Data.Entity_Scope (J) := Chars (Selector_Name (Arg_Ent));
 774                Arg_Ent := Prefix (Arg_Ent);
 775             end loop;
 776
 777             Data.Entity_Scope (1) := Chars (Arg_Ent);
 778
 779          elsif Is_Config_Static_String (Arg_Entity) then
 780             Data.Entity_Name := Name_Find;
 781             Data.Entity_Node := Arg_Entity;
 782
 783          else
 784             return;
 785          end if;
 786       else
 787          Data.Entity_Node := Empty;
 788          Data.Entity_Name := Data.Unit_Name (Num_Names);
 789       end if;
 790
 791       --  Process Parameter_Types argument
 792
 793       if Present (Arg_Parameter_Types) then
 794
 795          --  Here for aggregate case
 796
 797          if Nkind (Arg_Parameter_Types) = N_Aggregate then
 798             Data.Parameter_Types :=
 799               new Names
 800                 (1 .. List_Length (Expressions (Arg_Parameter_Types)));
 801
 802             Lit := First (Expressions (Arg_Parameter_Types));
 803             for J in Data.Parameter_Types'Range loop
 804                if Is_Config_Static_String (Lit) then
 805                   Data.Parameter_Types (J) := Name_Find;
 806                   Next (Lit);
 807                else
 808                   return;
 809                end if;
 810             end loop;
 811
 812          --  Otherwise we must have case of one name, which looks like a
 813          --  parenthesized literal rather than an aggregate.
 814
 815          elsif Paren_Count (Arg_Parameter_Types) /= 1 then
 816             Error_Msg_N
 817               ("wrong form for argument of pragma Eliminate",
 818                Arg_Parameter_Types);
 819             return;
 820
 821          elsif Is_Config_Static_String (Arg_Parameter_Types) then
 822             String_To_Name_Buffer (Strval (Arg_Parameter_Types));
 823
 824             if Name_Len = 0 then
 825
 826                --  Parameterless procedure
 827
 828                Data.Parameter_Types := new Names'(1 => No_Name);
 829
 830             else
 831                Data.Parameter_Types := new Names'(1 => Name_Find);
 832             end if;
 833
 834          else
 835             return;
 836          end if;
 837       end if;
 838
 839       --  Process Result_Types argument
 840
 841       if Present (Arg_Result_Type) then
 842          if Is_Config_Static_String (Arg_Result_Type) then
 843             Data.Result_Type := Name_Find;
 844          else
 845             return;
 846          end if;
 847
 848       --  Here if no Result_Types argument
 849
 850       else
 851          Data.Result_Type := No_Name;
 852       end if;
 853
 854       --  Process Source_Location argument
 855
 856       if Present (Arg_Source_Location) then
 857          if Is_Config_Static_String (Arg_Source_Location) then
 858             Data.Source_Location := Name_Find;
 859          else
 860             return;
 861          end if;
 862       else
 863          Data.Source_Location := No_Name;
 864       end if;
 865
 866       Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data));
 867
 868       --  If we already have an entry with this same key, then link
 869       --  it into the chain of entries for this key.
 870
 871       if Elmt /= null then
 872          Data.Homonym := Elmt.Homonym;
 873          Elmt.Homonym := Data;
 874
 875       --  Otherwise create a new entry
 876
 877       else
 878          Elim_Hash_Table.Set (Data);
 879       end if;
 880
 881       No_Elimination := False;
 882    end Process_Eliminate_Pragma;
 883
 884 end Sem_Elim;