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