gcc/ada/lib-xref-alfa.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                        L I B . X R E F . A L F A                         --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2011-2012, 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 Alfa;     use Alfa;
  27 with Einfo;    use Einfo;
  28 with Nmake;    use Nmake;
  29 with Put_Alfa;
  30
  31 with GNAT.HTable;
  32
  33 separate (Lib.Xref)
  34 package body Alfa is
  35
  36    ---------------------
  37    -- Local Constants --
  38    ---------------------
  39
  40    --  Table of Alfa_Entities, True for each entity kind used in Alfa
  41
  42    Alfa_Entities : constant array (Entity_Kind) of Boolean :=
  43      (E_Constant         => True,
  44       E_Function         => True,
  45       E_In_Out_Parameter => True,
  46       E_In_Parameter     => True,
  47       E_Loop_Parameter   => True,
  48       E_Operator         => True,
  49       E_Out_Parameter    => True,
  50       E_Procedure        => True,
  51       E_Variable         => True,
  52       others             => False);
  53
  54    --  True for each reference type used in Alfa
  55
  56    Alfa_References : constant array (Character) of Boolean :=
  57      ('m' => True,
  58       'r' => True,
  59       's' => True,
  60       others => False);
  61
  62    type Entity_Hashed_Range is range 0 .. 255;
  63    --  Size of hash table headers
  64
  65    ---------------------
  66    -- Local Variables --
  67    ---------------------
  68
  69    Heap : Entity_Id := Empty;
  70    --  A special entity which denotes the heap object
  71
  72    package Drefs is new Table.Table (
  73      Table_Component_Type => Xref_Entry,
  74      Table_Index_Type     => Xref_Entry_Number,
  75      Table_Low_Bound      => 1,
  76      Table_Initial        => Alloc.Drefs_Initial,
  77      Table_Increment      => Alloc.Drefs_Increment,
  78      Table_Name           => "Drefs");
  79    --  Table of cross-references for reads and writes through explicit
  80    --  dereferences, that are output as reads/writes to the special variable
  81    --  "Heap". These references are added to the regular references when
  82    --  computing Alfa cross-references.
  83
  84    -----------------------
  85    -- Local Subprograms --
  86    -----------------------
  87
  88    procedure Add_Alfa_File (Ubody, Uspec : Unit_Number_Type; Dspec : Nat);
  89    --  Add file and corresponding scopes for unit to the tables Alfa_File_Table
  90    --  and Alfa_Scope_Table. When two units are present for the same
  91    --  compilation unit, as it happens for library-level instantiations of
  92    --  generics, then Ubody /= Uspec, and all scopes are added to the same
  93    --  Alfa file. Otherwise Ubody = Uspec.
  94
  95    procedure Add_Alfa_Scope (N : Node_Id);
  96    --  Add scope N to the table Alfa_Scope_Table
  97
  98    procedure Add_Alfa_Xrefs;
  99    --  Filter table Xrefs to add all references used in Alfa to the table
 100    --  Alfa_Xref_Table.
 101
 102    procedure Detect_And_Add_Alfa_Scope (N : Node_Id);
 103    --  Call Add_Alfa_Scope on scopes
 104
 105    function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range;
 106    --  Hash function for hash table
 107
 108    procedure Traverse_Declarations_Or_Statements
 109      (L            : List_Id;
 110       Process      : Node_Processing;
 111       Inside_Stubs : Boolean);
 112    procedure Traverse_Handled_Statement_Sequence
 113      (N            : Node_Id;
 114       Process      : Node_Processing;
 115       Inside_Stubs : Boolean);
 116    procedure Traverse_Package_Body
 117      (N            : Node_Id;
 118       Process      : Node_Processing;
 119       Inside_Stubs : Boolean);
 120    procedure Traverse_Package_Declaration
 121      (N            : Node_Id;
 122       Process      : Node_Processing;
 123       Inside_Stubs : Boolean);
 124    procedure Traverse_Subprogram_Body
 125      (N            : Node_Id;
 126       Process      : Node_Processing;
 127       Inside_Stubs : Boolean);
 128    --  Traverse corresponding construct, calling Process on all declarations
 129
 130    -------------------
 131    -- Add_Alfa_File --
 132    -------------------
 133
 134    procedure Add_Alfa_File (Ubody, Uspec : Unit_Number_Type; Dspec : Nat) is
 135       File : constant Source_File_Index := Source_Index (Uspec);
 136       From : Scope_Index;
 137
 138       File_Name      : String_Ptr;
 139       Unit_File_Name : String_Ptr;
 140
 141    begin
 142       --  Source file could be inexistant as a result of an error, if option
 143       --  gnatQ is used.
 144
 145       if File = No_Source_File then
 146          return;
 147       end if;
 148
 149       From := Alfa_Scope_Table.Last + 1;
 150
 151       --  Unit might not have an associated compilation unit, as seen in code
 152       --  filling Sdep_Table in Write_ALI.
 153
 154       if Present (Cunit (Ubody)) then
 155          Traverse_Compilation_Unit
 156            (CU           => Cunit (Ubody),
 157             Process      => Detect_And_Add_Alfa_Scope'Access,
 158             Inside_Stubs => False);
 159       end if;
 160
 161       --  When two units are present for the same compilation unit, as it
 162       --  happens for library-level instantiations of generics, then add all
 163       --  scopes to the same Alfa file.
 164
 165       if Ubody /= Uspec then
 166          if Present (Cunit (Uspec)) then
 167             Traverse_Compilation_Unit
 168               (CU           => Cunit (Uspec),
 169                Process      => Detect_And_Add_Alfa_Scope'Access,
 170                Inside_Stubs => False);
 171          end if;
 172       end if;
 173
 174       --  Update scope numbers
 175
 176       declare
 177          Scope_Id : Int;
 178       begin
 179          Scope_Id := 1;
 180          for Index in From .. Alfa_Scope_Table.Last loop
 181             declare
 182                S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Index);
 183             begin
 184                S.Scope_Num := Scope_Id;
 185                S.File_Num  := Dspec;
 186                Scope_Id    := Scope_Id + 1;
 187             end;
 188          end loop;
 189       end;
 190
 191       --  Remove those scopes previously marked for removal
 192
 193       declare
 194          Scope_Id : Scope_Index;
 195
 196       begin
 197          Scope_Id := From;
 198          for Index in From .. Alfa_Scope_Table.Last loop
 199             declare
 200                S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Index);
 201             begin
 202                if S.Scope_Num /= 0 then
 203                   Alfa_Scope_Table.Table (Scope_Id) := S;
 204                   Scope_Id := Scope_Id + 1;
 205                end if;
 206             end;
 207          end loop;
 208
 209          Alfa_Scope_Table.Set_Last (Scope_Id - 1);
 210       end;
 211
 212       --  Make entry for new file in file table
 213
 214       Get_Name_String (Reference_Name (File));
 215       File_Name := new String'(Name_Buffer (1 .. Name_Len));
 216
 217       --  For subunits, also retrieve the file name of the unit. Only do so if
 218       --  unit has an associated compilation unit.
 219
 220       if Present (Cunit (Uspec))
 221         and then Present (Cunit (Unit (File)))
 222         and then Nkind (Unit (Cunit (Unit (File)))) = N_Subunit
 223       then
 224          Get_Name_String (Reference_Name (Main_Source_File));
 225          Unit_File_Name := new String'(Name_Buffer (1 .. Name_Len));
 226       end if;
 227
 228       Alfa_File_Table.Append (
 229         (File_Name      => File_Name,
 230          Unit_File_Name => Unit_File_Name,
 231          File_Num       => Dspec,
 232          From_Scope     => From,
 233          To_Scope       => Alfa_Scope_Table.Last));
 234    end Add_Alfa_File;
 235
 236    --------------------
 237    -- Add_Alfa_Scope --
 238    --------------------
 239
 240    procedure Add_Alfa_Scope (N : Node_Id) is
 241       E   : constant Entity_Id  := Defining_Entity (N);
 242       Loc : constant Source_Ptr := Sloc (E);
 243       Typ : Character;
 244
 245    begin
 246       --  Ignore scopes without a proper location
 247
 248       if Sloc (N) = No_Location then
 249          return;
 250       end if;
 251
 252       case Ekind (E) is
 253          when E_Function | E_Generic_Function =>
 254             Typ := 'V';
 255
 256          when E_Procedure | E_Generic_Procedure =>
 257             Typ := 'U';
 258
 259          when E_Subprogram_Body =>
 260             declare
 261                Spec : Node_Id;
 262
 263             begin
 264                Spec := Parent (E);
 265
 266                if Nkind (Spec) = N_Defining_Program_Unit_Name then
 267                   Spec := Parent (Spec);
 268                end if;
 269
 270                if Nkind (Spec) = N_Function_Specification then
 271                   Typ := 'V';
 272                else
 273                   pragma Assert
 274                     (Nkind (Spec) = N_Procedure_Specification);
 275                   Typ := 'U';
 276                end if;
 277             end;
 278
 279          when E_Package | E_Package_Body | E_Generic_Package =>
 280             Typ := 'K';
 281
 282          when E_Void =>
 283             --  Compilation of prj-attr.adb with -gnatn creates a node with
 284             --  entity E_Void for the package defined at a-charac.ads16:13
 285
 286             --  ??? TBD
 287
 288             return;
 289
 290          when others =>
 291             raise Program_Error;
 292       end case;
 293
 294       --  File_Num and Scope_Num are filled later. From_Xref and To_Xref are
 295       --  filled even later, but are initialized to represent an empty range.
 296
 297       Alfa_Scope_Table.Append (
 298         (Scope_Name     => new String'(Unique_Name (E)),
 299          File_Num       => 0,
 300          Scope_Num      => 0,
 301          Spec_File_Num  => 0,
 302          Spec_Scope_Num => 0,
 303          Line           => Nat (Get_Logical_Line_Number (Loc)),
 304          Stype          => Typ,
 305          Col            => Nat (Get_Column_Number (Loc)),
 306          From_Xref      => 1,
 307          To_Xref        => 0,
 308          Scope_Entity   => E));
 309    end Add_Alfa_Scope;
 310
 311    --------------------
 312    -- Add_Alfa_Xrefs --
 313    --------------------
 314
 315    procedure Add_Alfa_Xrefs is
 316       function Entity_Of_Scope (S : Scope_Index) return Entity_Id;
 317       --  Return the entity which maps to the input scope index
 318
 319       function Get_Entity_Type (E : Entity_Id) return Character;
 320       --  Return a character representing the type of entity
 321
 322       function Is_Alfa_Reference
 323         (E   : Entity_Id;
 324          Typ : Character) return Boolean;
 325       --  Return whether entity reference E meets Alfa requirements. Typ is the
 326       --  reference type.
 327
 328       function Is_Alfa_Scope (E : Entity_Id) return Boolean;
 329       --  Return whether the entity or reference scope meets requirements for
 330       --  being an Alfa scope.
 331
 332       function Is_Future_Scope_Entity
 333         (E : Entity_Id;
 334          S : Scope_Index) return Boolean;
 335       --  Check whether entity E is in Alfa_Scope_Table at index S or higher
 336
 337       function Is_Global_Constant (E : Entity_Id) return Boolean;
 338       --  Return True if E is a global constant for which we should ignore
 339       --  reads in Alfa.
 340
 341       function Lt (Op1 : Natural; Op2 : Natural) return Boolean;
 342       --  Comparison function for Sort call
 343
 344       procedure Move (From : Natural; To : Natural);
 345       --  Move procedure for Sort call
 346
 347       procedure Update_Scope_Range
 348         (S    : Scope_Index;
 349          From : Xref_Index;
 350          To   : Xref_Index);
 351       --  Update the scope which maps to S with the new range From .. To
 352
 353       package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
 354
 355       function Get_Scope_Num (N : Entity_Id) return Nat;
 356       --  Return the scope number associated to entity N
 357
 358       procedure Set_Scope_Num (N : Entity_Id; Num : Nat);
 359       --  Associate entity N to scope number Num
 360
 361       No_Scope : constant Nat := 0;
 362       --  Initial scope counter
 363
 364       type Scope_Rec is record
 365          Num    : Nat;
 366          Entity : Entity_Id;
 367       end record;
 368       --  Type used to relate an entity and a scope number
 369
 370       package Scopes is new GNAT.HTable.Simple_HTable
 371         (Header_Num => Entity_Hashed_Range,
 372          Element    => Scope_Rec,
 373          No_Element => (Num => No_Scope, Entity => Empty),
 374          Key        => Entity_Id,
 375          Hash       => Entity_Hash,
 376          Equal      => "=");
 377       --  Package used to build a correspondance between entities and scope
 378       --  numbers used in Alfa cross references.
 379
 380       Nrefs : Nat := Xrefs.Last;
 381       --  Number of references in table. This value may get reset (reduced)
 382       --  when we eliminate duplicate reference entries as well as references
 383       --  not suitable for local cross-references.
 384
 385       Nrefs_Add : constant Nat := Drefs.Last;
 386       --  Number of additional references which correspond to dereferences in
 387       --  the source code.
 388
 389       Rnums : array (0 .. Nrefs + Nrefs_Add) of Nat;
 390       --  This array contains numbers of references in the Xrefs table. This
 391       --  list is sorted in output order. The extra 0'th entry is convenient
 392       --  for the call to sort. When we sort the table, we move the entries in
 393       --  Rnums around, but we do not move the original table entries.
 394
 395       ---------------------
 396       -- Entity_Of_Scope --
 397       ---------------------
 398
 399       function Entity_Of_Scope (S : Scope_Index) return Entity_Id is
 400       begin
 401          return Alfa_Scope_Table.Table (S).Scope_Entity;
 402       end Entity_Of_Scope;
 403
 404       ---------------------
 405       -- Get_Entity_Type --
 406       ---------------------
 407
 408       function Get_Entity_Type (E : Entity_Id) return Character is
 409       begin
 410          case Ekind (E) is
 411             when E_Out_Parameter    => return '<';
 412             when E_In_Out_Parameter => return '=';
 413             when E_In_Parameter     => return '>';
 414             when others             => return '*';
 415          end case;
 416       end Get_Entity_Type;
 417
 418       -------------------
 419       -- Get_Scope_Num --
 420       -------------------
 421
 422       function Get_Scope_Num (N : Entity_Id) return Nat is
 423       begin
 424          return Scopes.Get (N).Num;
 425       end Get_Scope_Num;
 426
 427       -----------------------
 428       -- Is_Alfa_Reference --
 429       -----------------------
 430
 431       function Is_Alfa_Reference
 432         (E   : Entity_Id;
 433          Typ : Character) return Boolean
 434       is
 435       begin
 436          --  The only references of interest on callable entities are calls. On
 437          --  non-callable entities, the only references of interest are reads
 438          --  and writes.
 439
 440          if Ekind (E) in Overloadable_Kind then
 441             return Typ = 's';
 442
 443          --  References to constant objects are not considered in Alfa section,
 444          --  as these will be translated as constants in the intermediate
 445          --  language for formal verification, and should therefore never
 446          --  appear in frame conditions.
 447
 448          elsif Is_Constant_Object (E) then
 449             return False;
 450
 451          --  Objects of Task type or protected type are not Alfa references
 452
 453          elsif Present (Etype (E))
 454            and then Ekind (Etype (E)) in Concurrent_Kind
 455          then
 456             return False;
 457
 458          --  In all other cases, result is true for reference/modify cases,
 459          --  and false for all other cases.
 460
 461          else
 462             return Typ = 'r' or else Typ = 'm';
 463          end if;
 464       end Is_Alfa_Reference;
 465
 466       -------------------
 467       -- Is_Alfa_Scope --
 468       -------------------
 469
 470       function Is_Alfa_Scope (E : Entity_Id) return Boolean is
 471       begin
 472          return Present (E)
 473            and then not Is_Generic_Unit (E)
 474            and then Renamed_Entity (E) = Empty
 475            and then Get_Scope_Num (E) /= No_Scope;
 476       end Is_Alfa_Scope;
 477
 478       ----------------------------
 479       -- Is_Future_Scope_Entity --
 480       ----------------------------
 481
 482       function Is_Future_Scope_Entity
 483         (E : Entity_Id;
 484          S : Scope_Index) return Boolean
 485       is
 486          function Is_Past_Scope_Entity return Boolean;
 487          --  Check whether entity E is in Alfa_Scope_Table at index strictly
 488          --  lower than S.
 489
 490          --------------------------
 491          -- Is_Past_Scope_Entity --
 492          --------------------------
 493
 494          function Is_Past_Scope_Entity return Boolean is
 495          begin
 496             for Index in Alfa_Scope_Table.First .. S - 1 loop
 497                if Alfa_Scope_Table.Table (Index).Scope_Entity = E then
 498                   declare
 499                      Dummy : constant Alfa_Scope_Record :=
 500                                Alfa_Scope_Table.Table (Index);
 501                      pragma Unreferenced (Dummy);
 502                   begin
 503                      return True;
 504                   end;
 505                end if;
 506             end loop;
 507
 508             return False;
 509          end Is_Past_Scope_Entity;
 510
 511       --  Start of processing for Is_Future_Scope_Entity
 512
 513       begin
 514          for Index in S .. Alfa_Scope_Table.Last loop
 515             if Alfa_Scope_Table.Table (Index).Scope_Entity = E then
 516                return True;
 517             end if;
 518          end loop;
 519
 520          --  If this assertion fails, this means that the scope which we are
 521          --  looking for has been treated already, which reveals a problem in
 522          --  the order of cross-references.
 523
 524          pragma Assert (not Is_Past_Scope_Entity);
 525
 526          return False;
 527       end Is_Future_Scope_Entity;
 528
 529       ------------------------
 530       -- Is_Global_Constant --
 531       ------------------------
 532
 533       function Is_Global_Constant (E : Entity_Id) return Boolean is
 534       begin
 535          return Ekind (E) = E_Constant
 536            and then Ekind_In (Scope (E), E_Package, E_Package_Body);
 537       end Is_Global_Constant;
 538
 539       --------
 540       -- Lt --
 541       --------
 542
 543       function Lt (Op1, Op2 : Natural) return Boolean is
 544          T1 : constant Xref_Entry := Xrefs.Table (Rnums (Nat (Op1)));
 545          T2 : constant Xref_Entry := Xrefs.Table (Rnums (Nat (Op2)));
 546
 547       begin
 548          --  First test: if entity is in different unit, sort by unit. Note:
 549          --  that we use Ent_Scope_File rather than Eun, as Eun may refer to
 550          --  the file where the generic scope is defined, which may differ from
 551          --  the file where the enclosing scope is defined. It is the latter
 552          --  which matters for a correct order here.
 553
 554          if T1.Ent_Scope_File /= T2.Ent_Scope_File then
 555             return Dependency_Num (T1.Ent_Scope_File) <
 556                    Dependency_Num (T2.Ent_Scope_File);
 557
 558          --  Second test: within same unit, sort by location of the scope of
 559          --  the entity definition.
 560
 561          elsif Get_Scope_Num (T1.Key.Ent_Scope) /=
 562                Get_Scope_Num (T2.Key.Ent_Scope)
 563          then
 564             return Get_Scope_Num (T1.Key.Ent_Scope) <
 565                    Get_Scope_Num (T2.Key.Ent_Scope);
 566
 567          --  Third test: within same unit and scope, sort by location of
 568          --  entity definition.
 569
 570          elsif T1.Def /= T2.Def then
 571             return T1.Def < T2.Def;
 572
 573          else
 574             --  Both entities must be equal at this point
 575
 576             pragma Assert (T1.Key.Ent = T2.Key.Ent);
 577
 578             --  Fourth test: if reference is in same unit as entity definition,
 579             --  sort first.
 580
 581             if T1.Key.Lun /= T2.Key.Lun
 582               and then T1.Ent_Scope_File = T1.Key.Lun
 583             then
 584                return True;
 585
 586             elsif T1.Key.Lun /= T2.Key.Lun
 587               and then T2.Ent_Scope_File = T2.Key.Lun
 588             then
 589                return False;
 590
 591             --  Fifth test: if reference is in same unit and same scope as
 592             --  entity definition, sort first.
 593
 594             elsif T1.Ent_Scope_File = T1.Key.Lun
 595               and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
 596               and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
 597             then
 598                return True;
 599
 600             elsif T2.Ent_Scope_File = T2.Key.Lun
 601               and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
 602               and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
 603             then
 604                return False;
 605
 606             --  Sixth test: for same entity, sort by reference location unit
 607
 608             elsif T1.Key.Lun /= T2.Key.Lun then
 609                return Dependency_Num (T1.Key.Lun) <
 610                       Dependency_Num (T2.Key.Lun);
 611
 612             --  Seventh test: for same entity, sort by reference location scope
 613
 614             elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
 615                   Get_Scope_Num (T2.Key.Ref_Scope)
 616             then
 617                return Get_Scope_Num (T1.Key.Ref_Scope) <
 618                       Get_Scope_Num (T2.Key.Ref_Scope);
 619
 620             --  Eighth test: order of location within referencing unit
 621
 622             elsif T1.Key.Loc /= T2.Key.Loc then
 623                return T1.Key.Loc < T2.Key.Loc;
 624
 625             --  Finally, for two locations at the same address prefer the one
 626             --  that does NOT have the type 'r', so that a modification or
 627             --  extension takes preference, when there are more than one
 628             --  reference at the same location. As a result, in the case of
 629             --  entities that are in-out actuals, the read reference follows
 630             --  the modify reference.
 631
 632             else
 633                return T2.Key.Typ = 'r';
 634             end if;
 635          end if;
 636       end Lt;
 637
 638       ----------
 639       -- Move --
 640       ----------
 641
 642       procedure Move (From : Natural; To : Natural) is
 643       begin
 644          Rnums (Nat (To)) := Rnums (Nat (From));
 645       end Move;
 646
 647       -------------------
 648       -- Set_Scope_Num --
 649       -------------------
 650
 651       procedure Set_Scope_Num (N : Entity_Id; Num : Nat) is
 652       begin
 653          Scopes.Set (K => N, E => Scope_Rec'(Num => Num, Entity => N));
 654       end Set_Scope_Num;
 655
 656       ------------------------
 657       -- Update_Scope_Range --
 658       ------------------------
 659
 660       procedure Update_Scope_Range
 661         (S    : Scope_Index;
 662          From : Xref_Index;
 663          To   : Xref_Index)
 664       is
 665       begin
 666          Alfa_Scope_Table.Table (S).From_Xref := From;
 667          Alfa_Scope_Table.Table (S).To_Xref := To;
 668       end Update_Scope_Range;
 669
 670       --  Local variables
 671
 672       Col        : Nat;
 673       From_Index : Xref_Index;
 674       Line       : Nat;
 675       Loc        : Source_Ptr;
 676       Prev_Typ   : Character;
 677       Ref_Count  : Nat;
 678       Ref_Id     : Entity_Id;
 679       Ref_Name   : String_Ptr;
 680       Scope_Id   : Scope_Index;
 681
 682    --  Start of processing for Add_Alfa_Xrefs
 683
 684    begin
 685       for Index in Alfa_Scope_Table.First .. Alfa_Scope_Table.Last loop
 686          declare
 687             S : Alfa_Scope_Record renames Alfa_Scope_Table.Table (Index);
 688          begin
 689             Set_Scope_Num (S.Scope_Entity, S.Scope_Num);
 690          end;
 691       end loop;
 692
 693       --  Set up the pointer vector for the sort
 694
 695       for Index in 1 .. Nrefs loop
 696          Rnums (Index) := Index;
 697       end loop;
 698
 699       for Index in Drefs.First .. Drefs.Last loop
 700          Xrefs.Append (Drefs.Table (Index));
 701
 702          Nrefs         := Nrefs + 1;
 703          Rnums (Nrefs) := Xrefs.Last;
 704       end loop;
 705
 706       --  Capture the definition Sloc values. As in the case of normal cross
 707       --  references, we have to wait until now to get the correct value.
 708
 709       for Index in 1 .. Nrefs loop
 710          Xrefs.Table (Index).Def := Sloc (Xrefs.Table (Index).Key.Ent);
 711       end loop;
 712
 713       --  Eliminate entries not appropriate for Alfa. Done prior to sorting
 714       --  cross-references, as it discards useless references which do not have
 715       --  a proper format for the comparison function (like no location).
 716
 717       Ref_Count := Nrefs;
 718       Nrefs     := 0;
 719
 720       for Index in 1 .. Ref_Count loop
 721          declare
 722             Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
 723
 724          begin
 725             if Alfa_Entities (Ekind (Ref.Ent))
 726               and then Alfa_References (Ref.Typ)
 727               and then Is_Alfa_Scope (Ref.Ent_Scope)
 728               and then Is_Alfa_Scope (Ref.Ref_Scope)
 729               and then not Is_Global_Constant (Ref.Ent)
 730               and then Is_Alfa_Reference (Ref.Ent, Ref.Typ)
 731
 732               --  Discard references from unknown scopes, e.g. generic scopes
 733
 734               and then Get_Scope_Num (Ref.Ent_Scope) /= No_Scope
 735               and then Get_Scope_Num (Ref.Ref_Scope) /= No_Scope
 736             then
 737                Nrefs         := Nrefs + 1;
 738                Rnums (Nrefs) := Rnums (Index);
 739             end if;
 740          end;
 741       end loop;
 742
 743       --  Sort the references
 744
 745       Sorting.Sort (Integer (Nrefs));
 746
 747       --  Eliminate duplicate entries
 748
 749       --  We need this test for Ref_Count because if we force ALI file
 750       --  generation in case of errors detected, it may be the case that
 751       --  Nrefs is 0, so we should not reset it here.
 752
 753       if Nrefs >= 2 then
 754          Ref_Count := Nrefs;
 755          Nrefs     := 1;
 756
 757          for Index in 2 .. Ref_Count loop
 758             if Xrefs.Table (Rnums (Index)) /=
 759                Xrefs.Table (Rnums (Nrefs))
 760             then
 761                Nrefs := Nrefs + 1;
 762                Rnums (Nrefs) := Rnums (Index);
 763             end if;
 764          end loop;
 765       end if;
 766
 767       --  Eliminate the reference if it is at the same location as the previous
 768       --  one, unless it is a read-reference indicating that the entity is an
 769       --  in-out actual in a call.
 770
 771       Ref_Count := Nrefs;
 772       Nrefs     := 0;
 773       Loc       := No_Location;
 774       Prev_Typ  := 'm';
 775
 776       for Index in 1 .. Ref_Count loop
 777          declare
 778             Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
 779
 780          begin
 781             if Ref.Loc /= Loc
 782               or else (Prev_Typ = 'm' and then Ref.Typ = 'r')
 783             then
 784                Loc           := Ref.Loc;
 785                Prev_Typ      := Ref.Typ;
 786                Nrefs         := Nrefs + 1;
 787                Rnums (Nrefs) := Rnums (Index);
 788             end if;
 789          end;
 790       end loop;
 791
 792       --  The two steps have eliminated all references, nothing to do
 793
 794       if Alfa_Scope_Table.Last = 0 then
 795          return;
 796       end if;
 797
 798       Ref_Id     := Empty;
 799       Scope_Id   := 1;
 800       From_Index := 1;
 801
 802       --  Loop to output references
 803
 804       for Refno in 1 .. Nrefs loop
 805          declare
 806             Ref_Entry : Xref_Entry renames Xrefs.Table (Rnums (Refno));
 807             Ref       : Xref_Key   renames Ref_Entry.Key;
 808
 809          begin
 810             --  If this assertion fails, the scope which we are looking for is
 811             --  not in Alfa scope table, which reveals either a problem in the
 812             --  construction of the scope table, or an erroneous scope for the
 813             --  current cross-reference.
 814
 815             pragma Assert (Is_Future_Scope_Entity (Ref.Ent_Scope, Scope_Id));
 816
 817             --  Update the range of cross references to which the current scope
 818             --  refers to. This may be the empty range only for the first scope
 819             --  considered.
 820
 821             if Ref.Ent_Scope /= Entity_Of_Scope (Scope_Id) then
 822                Update_Scope_Range
 823                  (S    => Scope_Id,
 824                   From => From_Index,
 825                   To   => Alfa_Xref_Table.Last);
 826
 827                From_Index := Alfa_Xref_Table.Last + 1;
 828             end if;
 829
 830             while Ref.Ent_Scope /= Entity_Of_Scope (Scope_Id) loop
 831                Scope_Id := Scope_Id + 1;
 832                pragma Assert (Scope_Id <= Alfa_Scope_Table.Last);
 833             end loop;
 834
 835             if Ref.Ent /= Ref_Id then
 836                Ref_Name := new String'(Unique_Name (Ref.Ent));
 837             end if;
 838
 839             if Ref.Ent = Heap then
 840                Line := 0;
 841                Col  := 0;
 842             else
 843                Line := Int (Get_Logical_Line_Number (Ref_Entry.Def));
 844                Col  := Int (Get_Column_Number (Ref_Entry.Def));
 845             end if;
 846
 847             Alfa_Xref_Table.Append (
 848               (Entity_Name => Ref_Name,
 849                Entity_Line => Line,
 850                Etype       => Get_Entity_Type (Ref.Ent),
 851                Entity_Col  => Col,
 852                File_Num    => Dependency_Num (Ref.Lun),
 853                Scope_Num   => Get_Scope_Num (Ref.Ref_Scope),
 854                Line        => Int (Get_Logical_Line_Number (Ref.Loc)),
 855                Rtype       => Ref.Typ,
 856                Col         => Int (Get_Column_Number (Ref.Loc))));
 857          end;
 858       end loop;
 859
 860       --  Update the range of cross references to which the scope refers to
 861
 862       Update_Scope_Range
 863         (S    => Scope_Id,
 864          From => From_Index,
 865          To   => Alfa_Xref_Table.Last);
 866    end Add_Alfa_Xrefs;
 867
 868    ------------------
 869    -- Collect_Alfa --
 870    ------------------
 871
 872    procedure Collect_Alfa (Sdep_Table : Unit_Ref_Table; Num_Sdep : Nat) is
 873       D1 : Nat;
 874       D2 : Nat;
 875
 876    begin
 877       --  Cross-references should have been computed first
 878
 879       pragma Assert (Xrefs.Last /= 0);
 880
 881       Initialize_Alfa_Tables;
 882
 883       --  Generate file and scope Alfa information
 884
 885       D1 := 1;
 886       while D1 <= Num_Sdep loop
 887
 888          --  In rare cases, when treating the library-level instantiation of a
 889          --  generic, two consecutive units refer to the same compilation unit
 890          --  node and entity. In that case, treat them as a single unit for the
 891          --  sake of Alfa cross references by passing to Add_Alfa_File.
 892
 893          if D1 < Num_Sdep
 894            and then Cunit_Entity (Sdep_Table (D1)) =
 895                     Cunit_Entity (Sdep_Table (D1 + 1))
 896          then
 897             D2 := D1 + 1;
 898          else
 899             D2 := D1;
 900          end if;
 901
 902          Add_Alfa_File
 903            (Ubody => Sdep_Table (D1),
 904             Uspec => Sdep_Table (D2),
 905             Dspec => D2);
 906          D1 := D2 + 1;
 907       end loop;
 908
 909       --  Fill in the spec information when relevant
 910
 911       declare
 912          package Entity_Hash_Table is new
 913            GNAT.HTable.Simple_HTable
 914              (Header_Num => Entity_Hashed_Range,
 915               Element    => Scope_Index,
 916               No_Element => 0,
 917               Key        => Entity_Id,
 918               Hash       => Entity_Hash,
 919               Equal      => "=");
 920
 921       begin
 922          --  Fill in the hash-table
 923
 924          for S in Alfa_Scope_Table.First .. Alfa_Scope_Table.Last loop
 925             declare
 926                Srec : Alfa_Scope_Record renames Alfa_Scope_Table.Table (S);
 927             begin
 928                Entity_Hash_Table.Set (Srec.Scope_Entity, S);
 929             end;
 930          end loop;
 931
 932          --  Use the hash-table to locate spec entities
 933
 934          for S in Alfa_Scope_Table.First .. Alfa_Scope_Table.Last loop
 935             declare
 936                Srec : Alfa_Scope_Record renames Alfa_Scope_Table.Table (S);
 937
 938                Spec_Entity : constant Entity_Id :=
 939                                Unique_Entity (Srec.Scope_Entity);
 940                Spec_Scope  : constant Scope_Index :=
 941                                Entity_Hash_Table.Get (Spec_Entity);
 942
 943             begin
 944                --  Generic spec may be missing in which case Spec_Scope is zero
 945
 946                if Spec_Entity /= Srec.Scope_Entity
 947                  and then Spec_Scope /= 0
 948                then
 949                   Srec.Spec_File_Num :=
 950                     Alfa_Scope_Table.Table (Spec_Scope).File_Num;
 951                   Srec.Spec_Scope_Num :=
 952                     Alfa_Scope_Table.Table (Spec_Scope).Scope_Num;
 953                end if;
 954             end;
 955          end loop;
 956       end;
 957
 958       --  Generate cross reference Alfa information
 959
 960       Add_Alfa_Xrefs;
 961    end Collect_Alfa;
 962
 963    -------------------------------
 964    -- Detect_And_Add_Alfa_Scope --
 965    -------------------------------
 966
 967    procedure Detect_And_Add_Alfa_Scope (N : Node_Id) is
 968    begin
 969       if Nkind_In (N, N_Subprogram_Declaration,
 970                       N_Subprogram_Body,
 971                       N_Subprogram_Body_Stub,
 972                       N_Package_Declaration,
 973                       N_Package_Body)
 974       then
 975          Add_Alfa_Scope (N);
 976       end if;
 977    end Detect_And_Add_Alfa_Scope;
 978
 979    -------------------------------------
 980    -- Enclosing_Subprogram_Or_Package --
 981    -------------------------------------
 982
 983    function Enclosing_Subprogram_Or_Package (N : Node_Id) return Entity_Id is
 984       Result : Entity_Id;
 985
 986    begin
 987       --  If N is the defining identifier for a subprogram, then return the
 988       --  enclosing subprogram or package, not this subprogram.
 989
 990       if Nkind_In (N, N_Defining_Identifier, N_Defining_Operator_Symbol)
 991         and then Nkind (Parent (N)) in N_Subprogram_Specification
 992       then
 993          Result := Parent (Parent (Parent (N)));
 994       else
 995          Result := N;
 996       end if;
 997
 998       while Present (Result) loop
 999          case Nkind (Result) is
1000             when N_Package_Specification =>
1001                Result := Defining_Unit_Name (Result);
1002                exit;
1003
1004             when N_Package_Body =>
1005                Result := Defining_Unit_Name (Result);
1006                exit;
1007
1008             when N_Subprogram_Specification =>
1009                Result := Defining_Unit_Name (Result);
1010                exit;
1011
1012             when N_Subprogram_Declaration =>
1013                Result := Defining_Unit_Name (Specification (Result));
1014                exit;
1015
1016             when N_Subprogram_Body =>
1017                Result := Defining_Unit_Name (Specification (Result));
1018                exit;
1019
1020             --  The enclosing subprogram for a pre- or postconditions should be
1021             --  the subprogram to which the pragma is attached. This is not
1022             --  always the case in the AST, as the pragma may be declared after
1023             --  the declaration of the subprogram. Return Empty in this case.
1024
1025             when N_Pragma =>
1026                if Get_Pragma_Id (Result) = Pragma_Precondition
1027                     or else
1028                   Get_Pragma_Id (Result) = Pragma_Postcondition
1029                then
1030                   return Empty;
1031                else
1032                   Result := Parent (Result);
1033                end if;
1034
1035             when others =>
1036                Result := Parent (Result);
1037          end case;
1038       end loop;
1039
1040       if Nkind (Result) = N_Defining_Program_Unit_Name then
1041          Result := Defining_Identifier (Result);
1042       end if;
1043
1044       --  Do not return a scope without a proper location
1045
1046       if Present (Result)
1047         and then Sloc (Result) = No_Location
1048       then
1049          return Empty;
1050       end if;
1051
1052       return Result;
1053    end Enclosing_Subprogram_Or_Package;
1054
1055    -----------------
1056    -- Entity_Hash --
1057    -----------------
1058
1059    function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is
1060    begin
1061       return
1062         Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
1063    end Entity_Hash;
1064
1065    --------------------------
1066    -- Generate_Dereference --
1067    --------------------------
1068
1069    procedure Generate_Dereference
1070      (N   : Node_Id;
1071       Typ : Character := 'r')
1072    is
1073       procedure Create_Heap;
1074       --  Create and decorate the special entity which denotes the heap
1075
1076       -----------------
1077       -- Create_Heap --
1078       -----------------
1079
1080       procedure Create_Heap is
1081       begin
1082          Name_Len := Name_Of_Heap_Variable'Length;
1083          Name_Buffer (1 .. Name_Len) := Name_Of_Heap_Variable;
1084
1085          Heap := Make_Defining_Identifier (Standard_Location, Name_Enter);
1086
1087          Set_Ekind       (Heap, E_Variable);
1088          Set_Is_Internal (Heap, True);
1089          Set_Has_Fully_Qualified_Name (Heap);
1090       end Create_Heap;
1091
1092       --  Local variables
1093
1094       Loc       : constant Source_Ptr := Sloc (N);
1095       Index     : Nat;
1096       Ref_Scope : Entity_Id;
1097
1098    --  Start of processing for Generate_Dereference
1099
1100    begin
1101
1102       if Loc > No_Location then
1103          Drefs.Increment_Last;
1104          Index := Drefs.Last;
1105
1106          declare
1107             Deref_Entry : Xref_Entry renames Drefs.Table (Index);
1108             Deref       : Xref_Key   renames Deref_Entry.Key;
1109
1110          begin
1111             if No (Heap) then
1112                Create_Heap;
1113             end if;
1114
1115             Ref_Scope := Enclosing_Subprogram_Or_Package (N);
1116
1117             Deref.Ent := Heap;
1118             Deref.Loc := Loc;
1119             Deref.Typ := Typ;
1120
1121             --  It is as if the special "Heap" was defined in every scope where
1122             --  it is referenced.
1123
1124             Deref.Eun := Get_Code_Unit (Loc);
1125             Deref.Lun := Get_Code_Unit (Loc);
1126
1127             Deref.Ref_Scope := Ref_Scope;
1128             Deref.Ent_Scope := Ref_Scope;
1129
1130             Deref_Entry.Def := No_Location;
1131
1132             Deref_Entry.Ent_Scope_File := Get_Code_Unit (N);
1133          end;
1134       end if;
1135    end Generate_Dereference;
1136
1137    ------------------------------------
1138    -- Traverse_All_Compilation_Units --
1139    ------------------------------------
1140
1141    procedure Traverse_All_Compilation_Units (Process : Node_Processing) is
1142    begin
1143       for U in Units.First .. Last_Unit loop
1144          Traverse_Compilation_Unit (Cunit (U), Process, Inside_Stubs => False);
1145       end loop;
1146    end Traverse_All_Compilation_Units;
1147
1148    -------------------------------
1149    -- Traverse_Compilation_Unit --
1150    -------------------------------
1151
1152    procedure Traverse_Compilation_Unit
1153      (CU           : Node_Id;
1154       Process      : Node_Processing;
1155       Inside_Stubs : Boolean)
1156    is
1157       Lu : Node_Id;
1158
1159    begin
1160       --  Get Unit (checking case of subunit)
1161
1162       Lu := Unit (CU);
1163
1164       if Nkind (Lu) = N_Subunit then
1165          Lu := Proper_Body (Lu);
1166       end if;
1167
1168       --  Do not add scopes for generic units
1169
1170       if Nkind (Lu) = N_Package_Body
1171         and then Ekind (Corresponding_Spec (Lu)) in Generic_Unit_Kind
1172       then
1173          return;
1174       end if;
1175
1176       --  Call Process on all declarations
1177
1178       if Nkind (Lu) in N_Declaration
1179         or else Nkind (Lu) in N_Later_Decl_Item
1180       then
1181          Process (Lu);
1182       end if;
1183
1184       --  Traverse the unit
1185
1186       if Nkind (Lu) = N_Subprogram_Body then
1187          Traverse_Subprogram_Body (Lu, Process, Inside_Stubs);
1188
1189       elsif Nkind (Lu) = N_Subprogram_Declaration then
1190          null;
1191
1192       elsif Nkind (Lu) = N_Package_Declaration then
1193          Traverse_Package_Declaration (Lu, Process, Inside_Stubs);
1194
1195       elsif Nkind (Lu) = N_Package_Body then
1196          Traverse_Package_Body (Lu, Process, Inside_Stubs);
1197
1198       --  All other cases of compilation units (e.g. renamings), are not
1199       --  declarations, or else generic declarations which are ignored.
1200
1201       else
1202          null;
1203       end if;
1204    end Traverse_Compilation_Unit;
1205
1206    -----------------------------------------
1207    -- Traverse_Declarations_Or_Statements --
1208    -----------------------------------------
1209
1210    procedure Traverse_Declarations_Or_Statements
1211      (L            : List_Id;
1212       Process      : Node_Processing;
1213       Inside_Stubs : Boolean)
1214    is
1215       N : Node_Id;
1216
1217    begin
1218       --  Loop through statements or declarations
1219
1220       N := First (L);
1221       while Present (N) loop
1222          --  Call Process on all declarations
1223
1224          if Nkind (N) in N_Declaration
1225               or else
1226             Nkind (N) in N_Later_Decl_Item
1227          then
1228             Process (N);
1229          end if;
1230
1231          case Nkind (N) is
1232
1233             --  Package declaration
1234
1235             when N_Package_Declaration =>
1236                Traverse_Package_Declaration (N, Process, Inside_Stubs);
1237
1238             --  Package body
1239
1240             when N_Package_Body =>
1241                if Ekind (Defining_Entity (N)) /= E_Generic_Package then
1242                   Traverse_Package_Body (N, Process, Inside_Stubs);
1243                end if;
1244
1245             when N_Package_Body_Stub =>
1246                if Present (Library_Unit (N)) then
1247                   declare
1248                      Body_N : constant Node_Id := Get_Body_From_Stub (N);
1249                   begin
1250                      if Inside_Stubs
1251                        and then
1252                          Ekind (Defining_Entity (Body_N)) /= E_Generic_Package
1253                      then
1254                         Traverse_Package_Body (Body_N, Process, Inside_Stubs);
1255                      end if;
1256                   end;
1257                end if;
1258
1259             --  Subprogram declaration
1260
1261             when N_Subprogram_Declaration =>
1262                null;
1263
1264             --  Subprogram body
1265
1266             when N_Subprogram_Body =>
1267                if not Is_Generic_Subprogram (Defining_Entity (N)) then
1268                   Traverse_Subprogram_Body (N, Process, Inside_Stubs);
1269                end if;
1270
1271             when N_Subprogram_Body_Stub =>
1272                if Present (Library_Unit (N)) then
1273                   declare
1274                      Body_N : constant Node_Id := Get_Body_From_Stub (N);
1275                   begin
1276                      if Inside_Stubs
1277                        and then
1278                          not Is_Generic_Subprogram (Defining_Entity (Body_N))
1279                      then
1280                         Traverse_Subprogram_Body
1281                           (Body_N, Process, Inside_Stubs);
1282                      end if;
1283                   end;
1284                end if;
1285
1286             --  Block statement
1287
1288             when N_Block_Statement =>
1289                Traverse_Declarations_Or_Statements
1290                  (Declarations (N), Process, Inside_Stubs);
1291                Traverse_Handled_Statement_Sequence
1292                  (Handled_Statement_Sequence (N), Process, Inside_Stubs);
1293
1294             when N_If_Statement =>
1295
1296                --  Traverse the statements in the THEN part
1297
1298                Traverse_Declarations_Or_Statements
1299                  (Then_Statements (N), Process, Inside_Stubs);
1300
1301                --  Loop through ELSIF parts if present
1302
1303                if Present (Elsif_Parts (N)) then
1304                   declare
1305                      Elif : Node_Id := First (Elsif_Parts (N));
1306
1307                   begin
1308                      while Present (Elif) loop
1309                         Traverse_Declarations_Or_Statements
1310                           (Then_Statements (Elif), Process, Inside_Stubs);
1311                         Next (Elif);
1312                      end loop;
1313                   end;
1314                end if;
1315
1316                --  Finally traverse the ELSE statements if present
1317
1318                Traverse_Declarations_Or_Statements
1319                  (Else_Statements (N), Process, Inside_Stubs);
1320
1321             --  Case statement
1322
1323             when N_Case_Statement =>
1324
1325                --  Process case branches
1326
1327                declare
1328                   Alt : Node_Id;
1329                begin
1330                   Alt := First (Alternatives (N));
1331                   while Present (Alt) loop
1332                      Traverse_Declarations_Or_Statements
1333                        (Statements (Alt), Process, Inside_Stubs);
1334                      Next (Alt);
1335                   end loop;
1336                end;
1337
1338             --  Extended return statement
1339
1340             when N_Extended_Return_Statement =>
1341                Traverse_Handled_Statement_Sequence
1342                  (Handled_Statement_Sequence (N), Process, Inside_Stubs);
1343
1344             --  Loop
1345
1346             when N_Loop_Statement =>
1347                Traverse_Declarations_Or_Statements
1348                  (Statements (N), Process, Inside_Stubs);
1349
1350             --  Generic declarations are ignored
1351
1352             when others =>
1353                null;
1354          end case;
1355
1356          Next (N);
1357       end loop;
1358    end Traverse_Declarations_Or_Statements;
1359
1360    -----------------------------------------
1361    -- Traverse_Handled_Statement_Sequence --
1362    -----------------------------------------
1363
1364    procedure Traverse_Handled_Statement_Sequence
1365      (N            : Node_Id;
1366       Process      : Node_Processing;
1367       Inside_Stubs : Boolean)
1368    is
1369       Handler : Node_Id;
1370
1371    begin
1372       if Present (N) then
1373          Traverse_Declarations_Or_Statements
1374            (Statements (N), Process, Inside_Stubs);
1375
1376          if Present (Exception_Handlers (N)) then
1377             Handler := First (Exception_Handlers (N));
1378             while Present (Handler) loop
1379                Traverse_Declarations_Or_Statements
1380                  (Statements (Handler), Process, Inside_Stubs);
1381                Next (Handler);
1382             end loop;
1383          end if;
1384       end if;
1385    end Traverse_Handled_Statement_Sequence;
1386
1387    ---------------------------
1388    -- Traverse_Package_Body --
1389    ---------------------------
1390
1391    procedure Traverse_Package_Body
1392      (N            : Node_Id;
1393       Process      : Node_Processing;
1394       Inside_Stubs : Boolean) is
1395    begin
1396       Traverse_Declarations_Or_Statements
1397         (Declarations (N), Process, Inside_Stubs);
1398       Traverse_Handled_Statement_Sequence
1399         (Handled_Statement_Sequence (N), Process, Inside_Stubs);
1400    end Traverse_Package_Body;
1401
1402    ----------------------------------
1403    -- Traverse_Package_Declaration --
1404    ----------------------------------
1405
1406    procedure Traverse_Package_Declaration
1407      (N            : Node_Id;
1408       Process      : Node_Processing;
1409       Inside_Stubs : Boolean)
1410    is
1411       Spec : constant Node_Id := Specification (N);
1412    begin
1413       Traverse_Declarations_Or_Statements
1414         (Visible_Declarations (Spec), Process, Inside_Stubs);
1415       Traverse_Declarations_Or_Statements
1416         (Private_Declarations (Spec), Process, Inside_Stubs);
1417    end Traverse_Package_Declaration;
1418
1419    ------------------------------
1420    -- Traverse_Subprogram_Body --
1421    ------------------------------
1422
1423    procedure Traverse_Subprogram_Body
1424      (N            : Node_Id;
1425       Process      : Node_Processing;
1426       Inside_Stubs : Boolean)
1427    is
1428    begin
1429       Traverse_Declarations_Or_Statements
1430         (Declarations (N), Process, Inside_Stubs);
1431       Traverse_Handled_Statement_Sequence
1432         (Handled_Statement_Sequence (N), Process, Inside_Stubs);
1433    end Traverse_Subprogram_Body;
1434
1435 end Alfa;