gcc/ada/par_sco.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              P A R _ S C O                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2009-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 Atree;    use Atree;
  27 with Debug;    use Debug;
  28 with Lib;      use Lib;
  29 with Lib.Util; use Lib.Util;
  30 with Namet;    use Namet;
  31 with Nlists;   use Nlists;
  32 with Opt;      use Opt;
  33 with Output;   use Output;
  34 with Put_SCOs;
  35 with SCOs;     use SCOs;
  36 with Sinfo;    use Sinfo;
  37 with Sinput;   use Sinput;
  38 with Snames;   use Snames;
  39 with Table;
  40
  41 with GNAT.HTable;      use GNAT.HTable;
  42 with GNAT.Heap_Sort_G;
  43
  44 package body Par_SCO is
  45
  46    -----------------------
  47    -- Unit Number Table --
  48    -----------------------
  49
  50    --  This table parallels the SCO_Unit_Table, keeping track of the unit
  51    --  numbers corresponding to the entries made in this table, so that before
  52    --  writing out the SCO information to the ALI file, we can fill in the
  53    --  proper dependency numbers and file names.
  54
  55    --  Note that the zero'th entry is here for convenience in sorting the
  56    --  table, the real lower bound is 1.
  57
  58    package SCO_Unit_Number_Table is new Table.Table (
  59      Table_Component_Type => Unit_Number_Type,
  60      Table_Index_Type     => SCO_Unit_Index,
  61      Table_Low_Bound      => 0, -- see note above on sort
  62      Table_Initial        => 20,
  63      Table_Increment      => 200,
  64      Table_Name           => "SCO_Unit_Number_Entry");
  65
  66    ---------------------------------
  67    -- Condition/Pragma Hash Table --
  68    ---------------------------------
  69
  70    --  We need to be able to get to conditions quickly for handling the calls
  71    --  to Set_SCO_Condition efficiently, and similarly to get to pragmas to
  72    --  handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify the
  73    --  conditions and pragmas in the table by their starting sloc, and use this
  74    --  hash table to map from these starting sloc values to SCO_Table indexes.
  75
  76    type Header_Num is new Integer range 0 .. 996;
  77    --  Type for hash table headers
  78
  79    function Hash (F : Source_Ptr) return Header_Num;
  80    --  Function to Hash source pointer value
  81
  82    function Equal (F1, F2 : Source_Ptr) return Boolean;
  83    --  Function to test two keys for equality
  84
  85    package Condition_Pragma_Hash_Table is new Simple_HTable
  86      (Header_Num, Int, 0, Source_Ptr, Hash, Equal);
  87    --  The actual hash table
  88
  89    --------------------------
  90    -- Internal Subprograms --
  91    --------------------------
  92
  93    function Has_Decision (N : Node_Id) return Boolean;
  94    --  N is the node for a subexpression. Returns True if the subexpression
  95    --  contains a nested decision (i.e. either is a logical operator, or
  96    --  contains a logical operator in its subtree).
  97
  98    function Is_Logical_Operator (N : Node_Id) return Boolean;
  99    --  N is the node for a subexpression. This procedure just tests N to see
 100    --  if it is a logical operator (including short circuit conditions, but
 101    --  excluding OR and AND) and returns True if so, False otherwise, it does
 102    --  no other processing.
 103
 104    procedure Process_Decisions (N : Node_Id; T : Character);
 105    --  If N is Empty, has no effect. Otherwise scans the tree for the node N,
 106    --  to output any decisions it contains. T is one of IEPWX (for context of
 107    --  expression: if/exit when/pragma/while/expression). If T is other than X,
 108    --  the node N is the conditional expression involved, and a decision is
 109    --  always present (at the very least a simple decision is present at the
 110    --  top level).
 111
 112    procedure Process_Decisions (L : List_Id; T : Character);
 113    --  Calls above procedure for each element of the list L
 114
 115    procedure Set_Table_Entry
 116      (C1   : Character;
 117       C2   : Character;
 118       From : Source_Ptr;
 119       To   : Source_Ptr;
 120       Last : Boolean);
 121    --  Append an entry to SCO_Table with fields set as per arguments
 122
 123    procedure Traverse_Declarations_Or_Statements  (L : List_Id);
 124    procedure Traverse_Generic_Instantiation       (N : Node_Id);
 125    procedure Traverse_Generic_Package_Declaration (N : Node_Id);
 126    procedure Traverse_Handled_Statement_Sequence  (N : Node_Id);
 127    procedure Traverse_Package_Body                (N : Node_Id);
 128    procedure Traverse_Package_Declaration         (N : Node_Id);
 129    procedure Traverse_Protected_Body              (N : Node_Id);
 130    procedure Traverse_Subprogram_Or_Task_Body     (N : Node_Id);
 131    procedure Traverse_Subprogram_Declaration      (N : Node_Id);
 132    --  Traverse the corresponding construct, generating SCO table entries
 133
 134    procedure Write_SCOs_To_ALI_File is new Put_SCOs;
 135    --  Write SCO information to the ALI file using routines in Lib.Util
 136
 137    ----------
 138    -- dsco --
 139    ----------
 140
 141    procedure dsco is
 142    begin
 143       --  Dump SCO unit table
 144
 145       Write_Line ("SCO Unit Table");
 146       Write_Line ("--------------");
 147
 148       for Index in 1 .. SCO_Unit_Table.Last loop
 149          declare
 150             UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
 151
 152          begin
 153             Write_Str ("  ");
 154             Write_Int (Int (Index));
 155             Write_Str (".  Dep_Num = ");
 156             Write_Int (Int (UTE.Dep_Num));
 157             Write_Str ("  From = ");
 158             Write_Int (Int (UTE.From));
 159             Write_Str ("  To = ");
 160             Write_Int (Int (UTE.To));
 161
 162             Write_Str ("  File_Name = """);
 163
 164             if UTE.File_Name /= null then
 165                Write_Str (UTE.File_Name.all);
 166             end if;
 167
 168             Write_Char ('"');
 169             Write_Eol;
 170          end;
 171       end loop;
 172
 173       --  Dump SCO Unit number table if it contains any entries
 174
 175       if SCO_Unit_Number_Table.Last >= 1 then
 176          Write_Eol;
 177          Write_Line ("SCO Unit Number Table");
 178          Write_Line ("---------------------");
 179
 180          for Index in 1 .. SCO_Unit_Number_Table.Last loop
 181             Write_Str ("  ");
 182             Write_Int (Int (Index));
 183             Write_Str (". Unit_Number = ");
 184             Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
 185             Write_Eol;
 186          end loop;
 187       end if;
 188
 189       --  Dump SCO table itself
 190
 191       Write_Eol;
 192       Write_Line ("SCO Table");
 193       Write_Line ("---------");
 194
 195       for Index in 1 .. SCO_Table.Last loop
 196          declare
 197             T : SCO_Table_Entry renames SCO_Table.Table (Index);
 198
 199          begin
 200             Write_Str  ("  ");
 201             Write_Int  (Index);
 202             Write_Char ('.');
 203
 204             if T.C1 /= ' ' then
 205                Write_Str  ("  C1 = '");
 206                Write_Char (T.C1);
 207                Write_Char (''');
 208             end if;
 209
 210             if T.C2 /= ' ' then
 211                Write_Str  ("  C2 = '");
 212                Write_Char (T.C2);
 213                Write_Char (''');
 214             end if;
 215
 216             if T.From /= No_Source_Location then
 217                Write_Str ("  From = ");
 218                Write_Int (Int (T.From.Line));
 219                Write_Char (':');
 220                Write_Int (Int (T.From.Col));
 221             end if;
 222
 223             if T.To /= No_Source_Location then
 224                Write_Str ("  To = ");
 225                Write_Int (Int (T.To.Line));
 226                Write_Char (':');
 227                Write_Int (Int (T.To.Col));
 228             end if;
 229
 230             if T.Last then
 231                Write_Str ("  True");
 232             else
 233                Write_Str ("  False");
 234             end if;
 235
 236             Write_Eol;
 237          end;
 238       end loop;
 239    end dsco;
 240
 241    -----------
 242    -- Equal --
 243    -----------
 244
 245    function Equal (F1, F2 : Source_Ptr) return Boolean is
 246    begin
 247       return F1 = F2;
 248    end Equal;
 249
 250    ------------------
 251    -- Has_Decision --
 252    ------------------
 253
 254    function Has_Decision (N : Node_Id) return Boolean is
 255
 256       function Check_Node (N : Node_Id) return Traverse_Result;
 257
 258       ----------------
 259       -- Check_Node --
 260       ----------------
 261
 262       function Check_Node (N : Node_Id) return Traverse_Result is
 263       begin
 264          if Is_Logical_Operator (N) then
 265             return Abandon;
 266          else
 267             return OK;
 268          end if;
 269       end Check_Node;
 270
 271       function Traverse is new Traverse_Func (Check_Node);
 272
 273    --  Start of processing for Has_Decision
 274
 275    begin
 276       return Traverse (N) = Abandon;
 277    end Has_Decision;
 278
 279    ----------
 280    -- Hash --
 281    ----------
 282
 283    function Hash (F : Source_Ptr) return Header_Num is
 284    begin
 285       return Header_Num (Nat (F) mod 997);
 286    end Hash;
 287
 288    ----------------
 289    -- Initialize --
 290    ----------------
 291
 292    procedure Initialize is
 293    begin
 294       SCO_Unit_Number_Table.Init;
 295
 296       --  Set dummy 0'th entry in place for sort
 297
 298       SCO_Unit_Number_Table.Increment_Last;
 299    end Initialize;
 300
 301    -------------------------
 302    -- Is_Logical_Operator --
 303    -------------------------
 304
 305    function Is_Logical_Operator (N : Node_Id) return Boolean is
 306    begin
 307       return Nkind_In (N, N_Op_Not,
 308                           N_And_Then,
 309                           N_Or_Else);
 310    end Is_Logical_Operator;
 311
 312    -----------------------
 313    -- Process_Decisions --
 314    -----------------------
 315
 316    --  Version taking a list
 317
 318    procedure Process_Decisions (L : List_Id; T : Character) is
 319       N : Node_Id;
 320    begin
 321       if L /= No_List then
 322          N := First (L);
 323          while Present (N) loop
 324             Process_Decisions (N, T);
 325             Next (N);
 326          end loop;
 327       end if;
 328    end Process_Decisions;
 329
 330    --  Version taking a node
 331
 332    procedure Process_Decisions (N : Node_Id; T : Character) is
 333
 334       Mark : Nat;
 335       --  This is used to mark the location of a decision sequence in the SCO
 336       --  table. We use it for backing out a simple decision in an expression
 337       --  context that contains only NOT operators.
 338
 339       X_Not_Decision : Boolean;
 340       --  This flag keeps track of whether a decision sequence in the SCO table
 341       --  contains only NOT operators, and is for an expression context (T=X).
 342       --  The flag will be set False if T is other than X, or if an operator
 343       --  other than NOT is in the sequence.
 344
 345       function Process_Node (N : Node_Id) return Traverse_Result;
 346       --  Processes one node in the traversal, looking for logical operators,
 347       --  and if one is found, outputs the appropriate table entries.
 348
 349       procedure Output_Decision_Operand (N : Node_Id);
 350       --  The node N is the top level logical operator of a decision, or it is
 351       --  one of the operands of a logical operator belonging to a single
 352       --  complex decision. This routine outputs the sequence of table entries
 353       --  corresponding to the node. Note that we do not process the sub-
 354       --  operands to look for further decisions, that processing is done in
 355       --  Process_Decision_Operand, because we can't get decisions mixed up in
 356       --  the global table. Call has no effect if N is Empty.
 357
 358       procedure Output_Element (N : Node_Id);
 359       --  Node N is an operand of a logical operator that is not itself a
 360       --  logical operator, or it is a simple decision. This routine outputs
 361       --  the table entry for the element, with C1 set to ' '. Last is set
 362       --  False, and an entry is made in the condition hash table.
 363
 364       procedure Output_Header (T : Character);
 365       --  Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
 366       --  PRAGMA, and 'X' for the expression case.
 367
 368       procedure Process_Decision_Operand (N : Node_Id);
 369       --  This is called on node N, the top level node of a decision, or on one
 370       --  of its operands or suboperands after generating the full output for
 371       --  the complex decision. It process the suboperands of the decision
 372       --  looking for nested decisions.
 373
 374       -----------------------------
 375       -- Output_Decision_Operand --
 376       -----------------------------
 377
 378       procedure Output_Decision_Operand (N : Node_Id) is
 379          C : Character;
 380          L : Node_Id;
 381
 382       begin
 383          if No (N) then
 384             return;
 385
 386          --  Logical operator
 387
 388          elsif Is_Logical_Operator (N) then
 389             if Nkind (N) = N_Op_Not then
 390                C := '!';
 391                L := Empty;
 392
 393             else
 394                L := Left_Opnd (N);
 395
 396                if Nkind_In (N, N_Op_Or, N_Or_Else) then
 397                   C := '|';
 398                else
 399                   C := '&';
 400                end if;
 401             end if;
 402
 403             Set_Table_Entry
 404               (C1   => C,
 405                C2   => ' ',
 406                From => Sloc (N),
 407                To   => No_Location,
 408                Last => False);
 409
 410             Output_Decision_Operand (L);
 411             Output_Decision_Operand (Right_Opnd (N));
 412
 413          --  Not a logical operator
 414
 415          else
 416             Output_Element (N);
 417          end if;
 418       end Output_Decision_Operand;
 419
 420       --------------------
 421       -- Output_Element --
 422       --------------------
 423
 424       procedure Output_Element (N : Node_Id) is
 425          FSloc : Source_Ptr;
 426          LSloc : Source_Ptr;
 427       begin
 428          Sloc_Range (N, FSloc, LSloc);
 429          Set_Table_Entry
 430            (C1   => ' ',
 431             C2   => 'c',
 432             From => FSloc,
 433             To   => LSloc,
 434             Last => False);
 435          Condition_Pragma_Hash_Table.Set (FSloc, SCO_Table.Last);
 436       end Output_Element;
 437
 438       -------------------
 439       -- Output_Header --
 440       -------------------
 441
 442       procedure Output_Header (T : Character) is
 443          Loc : Source_Ptr := No_Location;
 444          --  Node whose sloc is used for the decision
 445
 446       begin
 447          case T is
 448             when 'I' | 'E' | 'W' =>
 449
 450                --  For IF, EXIT, WHILE, the token SLOC can be found from
 451                --  the SLOC of the parent of the expression.
 452
 453                Loc := Sloc (Parent (N));
 454
 455             when 'G' | 'P' =>
 456
 457                --  For entry, the token sloc is from the N_Entry_Body. For
 458                --  PRAGMA, we must get the location from the pragma node.
 459                --  Argument N is the pragma argument, and we have to go up two
 460                --  levels (through the pragma argument association) to get to
 461                --  the pragma node itself.
 462
 463                Loc := Sloc (Parent (Parent (N)));
 464
 465             when 'X' =>
 466
 467                --  For an expression, no Sloc
 468
 469                null;
 470
 471             --  No other possibilities
 472
 473             when others =>
 474                raise Program_Error;
 475          end case;
 476
 477          Set_Table_Entry
 478            (C1   => T,
 479             C2   => ' ',
 480             From => Loc,
 481             To   => No_Location,
 482             Last => False);
 483
 484          if T = 'P' then
 485
 486             --  For pragmas we also must make an entry in the hash table for
 487             --  later access by Set_SCO_Pragma_Enabled. We set the pragma as
 488             --  disabled now, the call will change C2 to 'e' to enable the
 489             --  pragma header entry.
 490
 491             SCO_Table.Table (SCO_Table.Last).C2 := 'd';
 492             Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
 493          end if;
 494
 495       end Output_Header;
 496
 497       ------------------------------
 498       -- Process_Decision_Operand --
 499       ------------------------------
 500
 501       procedure Process_Decision_Operand (N : Node_Id) is
 502       begin
 503          if Is_Logical_Operator (N) then
 504             if Nkind (N) /= N_Op_Not then
 505                Process_Decision_Operand (Left_Opnd (N));
 506                X_Not_Decision := False;
 507             end if;
 508
 509             Process_Decision_Operand (Right_Opnd (N));
 510
 511          else
 512             Process_Decisions (N, 'X');
 513          end if;
 514       end Process_Decision_Operand;
 515
 516       ------------------
 517       -- Process_Node --
 518       ------------------
 519
 520       function Process_Node (N : Node_Id) return Traverse_Result is
 521       begin
 522          case Nkind (N) is
 523
 524                --  Logical operators, output table entries and then process
 525                --  operands recursively to deal with nested conditions.
 526
 527             when N_And_Then |
 528                  N_Or_Else  |
 529                  N_Op_Not   =>
 530
 531                declare
 532                   T : Character;
 533
 534                begin
 535                   --  If outer level, then type comes from call, otherwise it
 536                   --  is more deeply nested and counts as X for expression.
 537
 538                   if N = Process_Decisions.N then
 539                      T := Process_Decisions.T;
 540                   else
 541                      T := 'X';
 542                   end if;
 543
 544                   --  Output header for sequence
 545
 546                   X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
 547                   Mark := SCO_Table.Last;
 548                   Output_Header (T);
 549
 550                   --  Output the decision
 551
 552                   Output_Decision_Operand (N);
 553
 554                   --  If the decision was in an expression context (T = 'X')
 555                   --  and contained only NOT operators, then we don't output
 556                   --  it, so delete it.
 557
 558                   if X_Not_Decision then
 559                      SCO_Table.Set_Last (Mark);
 560
 561                   --  Otherwise, set Last in last table entry to mark end
 562
 563                   else
 564                      SCO_Table.Table (SCO_Table.Last).Last := True;
 565                   end if;
 566
 567                   --  Process any embedded decisions
 568
 569                   Process_Decision_Operand (N);
 570                   return Skip;
 571                end;
 572
 573             --  Case expression
 574
 575             when N_Case_Expression =>
 576                return OK; -- ???
 577
 578             --  Conditional expression, processed like an if statement
 579
 580             when N_Conditional_Expression =>
 581                declare
 582                   Cond : constant Node_Id := First (Expressions (N));
 583                   Thnx : constant Node_Id := Next (Cond);
 584                   Elsx : constant Node_Id := Next (Thnx);
 585                begin
 586                   Process_Decisions (Cond, 'I');
 587                   Process_Decisions (Thnx, 'X');
 588                   Process_Decisions (Elsx, 'X');
 589                   return Skip;
 590                end;
 591
 592             --  All other cases, continue scan
 593
 594             when others =>
 595                return OK;
 596
 597          end case;
 598       end Process_Node;
 599
 600       procedure Traverse is new Traverse_Proc (Process_Node);
 601
 602    --  Start of processing for Process_Decisions
 603
 604    begin
 605       if No (N) then
 606          return;
 607       end if;
 608
 609       --  See if we have simple decision at outer level and if so then
 610       --  generate the decision entry for this simple decision. A simple
 611       --  decision is a boolean expression (which is not a logical operator
 612       --  or short circuit form) appearing as the operand of an IF, WHILE,
 613       --  EXIT WHEN, or special PRAGMA construct.
 614
 615       if T /= 'X' and then not Is_Logical_Operator (N) then
 616          Output_Header (T);
 617          Output_Element (N);
 618
 619          --  Change Last in last table entry to True to mark end of
 620          --  sequence, which is this case is only one element long.
 621
 622          SCO_Table.Table (SCO_Table.Last).Last := True;
 623       end if;
 624
 625       Traverse (N);
 626    end Process_Decisions;
 627
 628    -----------
 629    -- pscos --
 630    -----------
 631
 632    procedure pscos is
 633
 634       procedure Write_Info_Char (C : Character) renames Write_Char;
 635       --  Write one character;
 636
 637       procedure Write_Info_Initiate (Key : Character) renames Write_Char;
 638       --  Start new one and write one character;
 639
 640       procedure Write_Info_Nat (N : Nat);
 641       --  Write value of N
 642
 643       procedure Write_Info_Terminate renames Write_Eol;
 644       --  Terminate current line
 645
 646       --------------------
 647       -- Write_Info_Nat --
 648       --------------------
 649
 650       procedure Write_Info_Nat (N : Nat) is
 651       begin
 652          Write_Int (N);
 653       end Write_Info_Nat;
 654
 655       procedure Debug_Put_SCOs is new Put_SCOs;
 656
 657       --  Start of processing for pscos
 658
 659    begin
 660       Debug_Put_SCOs;
 661    end pscos;
 662
 663    ----------------
 664    -- SCO_Output --
 665    ----------------
 666
 667    procedure SCO_Output is
 668    begin
 669       if Debug_Flag_Dot_OO then
 670          dsco;
 671       end if;
 672
 673       --  Sort the unit tables based on dependency numbers
 674
 675       Unit_Table_Sort : declare
 676
 677          function Lt (Op1, Op2 : Natural) return Boolean;
 678          --  Comparison routine for sort call
 679
 680          procedure Move (From : Natural; To : Natural);
 681          --  Move routine for sort call
 682
 683          --------
 684          -- Lt --
 685          --------
 686
 687          function Lt (Op1, Op2 : Natural) return Boolean is
 688          begin
 689             return
 690               Dependency_Num
 691                 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
 692                      <
 693               Dependency_Num
 694                 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
 695          end Lt;
 696
 697          ----------
 698          -- Move --
 699          ----------
 700
 701          procedure Move (From : Natural; To : Natural) is
 702          begin
 703             SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
 704               SCO_Unit_Table.Table (SCO_Unit_Index (From));
 705             SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
 706               SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
 707          end Move;
 708
 709          package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
 710
 711       --  Start of processing for Unit_Table_Sort
 712
 713       begin
 714          Sorting.Sort (Integer (SCO_Unit_Table.Last));
 715       end Unit_Table_Sort;
 716
 717       --  Loop through entries in the unit table to set file name and
 718       --  dependency number entries.
 719
 720       for J in 1 .. SCO_Unit_Table.Last loop
 721          declare
 722             U   : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
 723             UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
 724          begin
 725             Get_Name_String (Reference_Name (Source_Index (U)));
 726             UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
 727             UTE.Dep_Num := Dependency_Num (U);
 728          end;
 729       end loop;
 730
 731       --  Now the tables are all setup for output to the ALI file
 732
 733       Write_SCOs_To_ALI_File;
 734    end SCO_Output;
 735
 736    ----------------
 737    -- SCO_Record --
 738    ----------------
 739
 740    procedure SCO_Record (U : Unit_Number_Type) is
 741       Lu   : Node_Id;
 742       From : Nat;
 743
 744    begin
 745       --  Ignore call if not generating code and generating SCO's
 746
 747       if not (Generate_SCO and then Operating_Mode = Generate_Code) then
 748          return;
 749       end if;
 750
 751       --  Ignore call if this unit already recorded
 752
 753       for J in 1 .. SCO_Unit_Number_Table.Last loop
 754          if U = SCO_Unit_Number_Table.Table (J) then
 755             return;
 756          end if;
 757       end loop;
 758
 759       --  Otherwise record starting entry
 760
 761       From := SCO_Table.Last + 1;
 762
 763       --  Get Unit (checking case of subunit)
 764
 765       Lu := Unit (Cunit (U));
 766
 767       if Nkind (Lu) = N_Subunit then
 768          Lu := Proper_Body (Lu);
 769       end if;
 770
 771       --  Traverse the unit
 772
 773       case Nkind (Lu) is
 774          when N_Protected_Body =>
 775             Traverse_Protected_Body (Lu);
 776
 777          when N_Subprogram_Body | N_Task_Body =>
 778             Traverse_Subprogram_Or_Task_Body (Lu);
 779
 780          when N_Subprogram_Declaration =>
 781             Traverse_Subprogram_Declaration (Lu);
 782
 783          when N_Package_Declaration =>
 784             Traverse_Package_Declaration (Lu);
 785
 786          when N_Package_Body =>
 787             Traverse_Package_Body (Lu);
 788
 789          when N_Generic_Package_Declaration =>
 790             Traverse_Generic_Package_Declaration (Lu);
 791
 792          when N_Generic_Instantiation =>
 793             Traverse_Generic_Instantiation (Lu);
 794
 795          when others =>
 796
 797             --  All other cases of compilation units (e.g. renamings), generate
 798             --  no SCO information.
 799
 800             null;
 801       end case;
 802
 803       --  Make entry for new unit in unit tables, we will fill in the file
 804       --  name and dependency numbers later.
 805
 806       SCO_Unit_Table.Append (
 807         (Dep_Num   => 0,
 808          File_Name => null,
 809          From      => From,
 810          To        => SCO_Table.Last));
 811
 812       SCO_Unit_Number_Table.Append (U);
 813    end SCO_Record;
 814
 815    -----------------------
 816    -- Set_SCO_Condition --
 817    -----------------------
 818
 819    procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is
 820       Orig  : constant Node_Id := Original_Node (Cond);
 821       Index : Nat;
 822       Start : Source_Ptr;
 823       Dummy : Source_Ptr;
 824
 825       Constant_Condition_Code : constant array (Boolean) of Character :=
 826                                   (False => 'f', True => 't');
 827    begin
 828       Sloc_Range (Orig, Start, Dummy);
 829       Index := Condition_Pragma_Hash_Table.Get (Start);
 830
 831       --  The test here for zero is to deal with possible previous errors
 832
 833       if Index /= 0 then
 834          pragma Assert (SCO_Table.Table (Index).C1 = ' ');
 835          SCO_Table.Table (Index).C2 := Constant_Condition_Code (Val);
 836       end if;
 837    end Set_SCO_Condition;
 838
 839    ----------------------------
 840    -- Set_SCO_Pragma_Enabled --
 841    ----------------------------
 842
 843    procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is
 844       Index : Nat;
 845
 846    begin
 847       --  Note: the reason we use the Sloc value as the key is that in the
 848       --  generic case, the call to this procedure is made on a copy of the
 849       --  original node, so we can't use the Node_Id value.
 850
 851       Index := Condition_Pragma_Hash_Table.Get (Loc);
 852
 853       --  The test here for zero is to deal with possible previous errors
 854
 855       if Index /= 0 then
 856          pragma Assert (SCO_Table.Table (Index).C1 = 'P');
 857          SCO_Table.Table (Index).C2 := 'e';
 858       end if;
 859    end Set_SCO_Pragma_Enabled;
 860
 861    ---------------------
 862    -- Set_Table_Entry --
 863    ---------------------
 864
 865    procedure Set_Table_Entry
 866      (C1   : Character;
 867       C2   : Character;
 868       From : Source_Ptr;
 869       To   : Source_Ptr;
 870       Last : Boolean)
 871    is
 872       function To_Source_Location (S : Source_Ptr) return Source_Location;
 873       --  Converts Source_Ptr value to Source_Location (line/col) format
 874
 875       ------------------------
 876       -- To_Source_Location --
 877       ------------------------
 878
 879       function To_Source_Location (S : Source_Ptr) return Source_Location is
 880       begin
 881          if S = No_Location then
 882             return No_Source_Location;
 883          else
 884             return
 885               (Line => Get_Logical_Line_Number (S),
 886                Col  => Get_Column_Number (S));
 887          end if;
 888       end To_Source_Location;
 889
 890    --  Start of processing for Set_Table_Entry
 891
 892    begin
 893       Add_SCO
 894         (C1   => C1,
 895          C2   => C2,
 896          From => To_Source_Location (From),
 897          To   => To_Source_Location (To),
 898          Last => Last);
 899    end Set_Table_Entry;
 900
 901    -----------------------------------------
 902    -- Traverse_Declarations_Or_Statements --
 903    -----------------------------------------
 904
 905    --  Tables used by Traverse_Declarations_Or_Statements for temporarily
 906    --  holding statement and decision entries. These are declared globally
 907    --  since they are shared by recursive calls to this procedure.
 908
 909    type SC_Entry is record
 910       From : Source_Ptr;
 911       To   : Source_Ptr;
 912       Typ  : Character;
 913    end record;
 914    --  Used to store a single entry in the following table, From:To represents
 915    --  the range of entries in the CS line entry, and typ is the type, with
 916    --  space meaning that no type letter will accompany the entry.
 917
 918    package SC is new Table.Table (
 919      Table_Component_Type => SC_Entry,
 920      Table_Index_Type     => Nat,
 921      Table_Low_Bound      => 1,
 922      Table_Initial        => 1000,
 923      Table_Increment      => 200,
 924      Table_Name           => "SCO_SC");
 925       --  Used to store statement components for a CS entry to be output
 926       --  as a result of the call to this procedure. SC.Last is the last
 927       --  entry stored, so the current statement sequence is represented
 928       --  by SC_Array (SC_First .. SC.Last), where SC_First is saved on
 929       --  entry to each recursive call to the routine.
 930       --
 931       --  Extend_Statement_Sequence adds an entry to this array, and then
 932       --  Set_Statement_Entry clears the entries starting with SC_First,
 933       --  copying these entries to the main SCO output table. The reason that
 934       --  we do the temporary caching of results in this array is that we want
 935       --  the SCO table entries for a given CS line to be contiguous, and the
 936       --  processing may output intermediate entries such as decision entries.
 937
 938    type SD_Entry is record
 939       Nod : Node_Id;
 940       Lst : List_Id;
 941       Typ : Character;
 942    end record;
 943    --  Used to store a single entry in the following table. Nod is the node to
 944    --  be searched for decisions for the case of Process_Decisions_Defer with a
 945    --  node argument (with Lst set to No_List. Lst is the list to be searched
 946    --  for decisions for the case of Process_Decisions_Defer with a List
 947    --  argument (in which case Nod is set to Empty).
 948
 949    package SD is new Table.Table (
 950      Table_Component_Type => SD_Entry,
 951      Table_Index_Type     => Nat,
 952      Table_Low_Bound      => 1,
 953      Table_Initial        => 1000,
 954      Table_Increment      => 200,
 955      Table_Name           => "SCO_SD");
 956    --  Used to store possible decision information. Instead of calling the
 957    --  Process_Decisions procedures directly, we call Process_Decisions_Defer,
 958    --  which simply stores the arguments in this table. Then when we clear
 959    --  out a statement sequence using Set_Statement_Entry, after generating
 960    --  the CS lines for the statements, the entries in this table result in
 961    --  calls to Process_Decision. The reason for doing things this way is to
 962    --  ensure that decisions are output after the CS line for the statements
 963    --  in which the decisions occur.
 964
 965    procedure Traverse_Declarations_Or_Statements (L : List_Id) is
 966       N     : Node_Id;
 967       Dummy : Source_Ptr;
 968
 969       SC_First : constant Nat := SC.Last + 1;
 970       SD_First : constant Nat := SD.Last + 1;
 971       --  Record first entries used in SC/SD at this recursive level
 972
 973       procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
 974       --  Extend the current statement sequence to encompass the node N. Typ
 975       --  is the letter that identifies the type of statement/declaration that
 976       --  is being added to the sequence.
 977
 978       procedure Extend_Statement_Sequence
 979         (From : Node_Id;
 980          To   : Node_Id;
 981          Typ  : Character);
 982       --  This version extends the current statement sequence with an entry
 983       --  that starts with the first token of From, and ends with the last
 984       --  token of To. It is used for example in a CASE statement to cover
 985       --  the range from the CASE token to the last token of the expression.
 986
 987       procedure Set_Statement_Entry;
 988       --  If Start is No_Location, does nothing, otherwise outputs a SCO_Table
 989       --  statement entry for the range Start-Stop and then sets both Start
 990       --  and Stop to No_Location.
 991       --  What are Start and Stop??? This comment seems completely unrelated
 992       --  to the implementation!???
 993       --  Unconditionally sets Term to True. What is Term???
 994       --  This is called when we find a statement or declaration that generates
 995       --  its own table entry, so that we must end the current statement
 996       --  sequence.
 997
 998       procedure Process_Decisions_Defer (N : Node_Id; T : Character);
 999       pragma Inline (Process_Decisions_Defer);
1000       --  This routine is logically the same as Process_Decisions, except that
1001       --  the arguments are saved in the SD table, for later processing when
1002       --  Set_Statement_Entry is called, which goes through the saved entries
1003       --  making the corresponding calls to Process_Decision.
1004
1005       procedure Process_Decisions_Defer (L : List_Id; T : Character);
1006       pragma Inline (Process_Decisions_Defer);
1007       --  Same case for list arguments, deferred call to Process_Decisions
1008
1009       -------------------------
1010       -- Set_Statement_Entry --
1011       -------------------------
1012
1013       procedure Set_Statement_Entry is
1014          C1      : Character;
1015          SC_Last : constant Int := SC.Last;
1016          SD_Last : constant Int := SD.Last;
1017
1018       begin
1019          --  Output statement entries from saved entries in SC table
1020
1021          for J in SC_First .. SC_Last loop
1022             if J = SC_First then
1023                C1 := 'S';
1024             else
1025                C1 := 's';
1026             end if;
1027
1028             declare
1029                SCE : SC_Entry renames SC.Table (J);
1030             begin
1031                Set_Table_Entry
1032                  (C1   => C1,
1033                   C2   => SCE.Typ,
1034                   From => SCE.From,
1035                   To   => SCE.To,
1036                   Last => (J = SC_Last));
1037             end;
1038          end loop;
1039
1040          --  Clear out used section of SC table
1041
1042          SC.Set_Last (SC_First - 1);
1043
1044          --  Output any embedded decisions
1045
1046          for J in SD_First .. SD_Last loop
1047             declare
1048                SDE : SD_Entry renames SD.Table (J);
1049             begin
1050                if Present (SDE.Nod) then
1051                   Process_Decisions (SDE.Nod, SDE.Typ);
1052                else
1053                   Process_Decisions (SDE.Lst, SDE.Typ);
1054                end if;
1055             end;
1056          end loop;
1057
1058          --  Clear out used section of SD table
1059
1060          SD.Set_Last (SD_First - 1);
1061       end Set_Statement_Entry;
1062
1063       -------------------------------
1064       -- Extend_Statement_Sequence --
1065       -------------------------------
1066
1067       procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
1068          F : Source_Ptr;
1069          T : Source_Ptr;
1070       begin
1071          Sloc_Range (N, F, T);
1072          SC.Append ((F, T, Typ));
1073       end Extend_Statement_Sequence;
1074
1075       procedure Extend_Statement_Sequence
1076         (From : Node_Id;
1077          To   : Node_Id;
1078          Typ  : Character)
1079       is
1080          F : Source_Ptr;
1081          T : Source_Ptr;
1082       begin
1083          Sloc_Range (From, F, Dummy);
1084          Sloc_Range (To, Dummy, T);
1085          SC.Append ((F, T, Typ));
1086       end Extend_Statement_Sequence;
1087
1088       -----------------------------
1089       -- Process_Decisions_Defer --
1090       -----------------------------
1091
1092       procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
1093       begin
1094          SD.Append ((N, No_List, T));
1095       end Process_Decisions_Defer;
1096
1097       procedure Process_Decisions_Defer (L : List_Id; T : Character) is
1098       begin
1099          SD.Append ((Empty, L, T));
1100       end Process_Decisions_Defer;
1101
1102    --  Start of processing for Traverse_Declarations_Or_Statements
1103
1104    begin
1105       if Is_Non_Empty_List (L) then
1106
1107          --  Loop through statements or declarations
1108
1109          N := First (L);
1110          while Present (N) loop
1111
1112             --  Initialize or extend current statement sequence. Note that for
1113             --  special cases such as IF and Case statements we will modify
1114             --  the range to exclude internal statements that should not be
1115             --  counted as part of the current statement sequence.
1116
1117             case Nkind (N) is
1118
1119                --  Package declaration
1120
1121                when N_Package_Declaration =>
1122                   Set_Statement_Entry;
1123                   Traverse_Package_Declaration (N);
1124
1125                --  Generic package declaration
1126
1127                when N_Generic_Package_Declaration =>
1128                   Set_Statement_Entry;
1129                   Traverse_Generic_Package_Declaration (N);
1130
1131                --  Package body
1132
1133                when N_Package_Body =>
1134                   Set_Statement_Entry;
1135                   Traverse_Package_Body (N);
1136
1137                --  Subprogram declaration
1138
1139                when N_Subprogram_Declaration =>
1140                   Process_Decisions_Defer
1141                     (Parameter_Specifications (Specification (N)), 'X');
1142                   Set_Statement_Entry;
1143
1144                --  Generic subprogram declaration
1145
1146                when N_Generic_Subprogram_Declaration =>
1147                   Process_Decisions_Defer
1148                     (Generic_Formal_Declarations (N), 'X');
1149                   Process_Decisions_Defer
1150                     (Parameter_Specifications (Specification (N)), 'X');
1151                   Set_Statement_Entry;
1152
1153                --  Task or subprogram body
1154
1155                when N_Task_Body | N_Subprogram_Body =>
1156                   Set_Statement_Entry;
1157                   Traverse_Subprogram_Or_Task_Body (N);
1158
1159                --  Entry body
1160
1161                when N_Entry_Body =>
1162                   declare
1163                      Cond : constant Node_Id :=
1164                               Condition (Entry_Body_Formal_Part (N));
1165
1166                   begin
1167                      Set_Statement_Entry;
1168
1169                      if Present (Cond) then
1170                         Process_Decisions_Defer (Cond, 'G');
1171                      end if;
1172
1173                      Traverse_Subprogram_Or_Task_Body (N);
1174                   end;
1175
1176                --  Protected body
1177
1178                when N_Protected_Body =>
1179                   Set_Statement_Entry;
1180                   Traverse_Protected_Body (N);
1181
1182                --  Exit statement, which is an exit statement in the SCO sense,
1183                --  so it is included in the current statement sequence, but
1184                --  then it terminates this sequence. We also have to process
1185                --  any decisions in the exit statement expression.
1186
1187                when N_Exit_Statement =>
1188                   Extend_Statement_Sequence (N, ' ');
1189                   Process_Decisions_Defer (Condition (N), 'E');
1190                   Set_Statement_Entry;
1191
1192                --  Label, which breaks the current statement sequence, but the
1193                --  label itself is not included in the next statement sequence,
1194                --  since it generates no code.
1195
1196                when N_Label =>
1197                   Set_Statement_Entry;
1198
1199                --  Block statement, which breaks the current statement sequence
1200
1201                when N_Block_Statement =>
1202                   Set_Statement_Entry;
1203                   Traverse_Declarations_Or_Statements (Declarations (N));
1204                   Traverse_Handled_Statement_Sequence
1205                     (Handled_Statement_Sequence (N));
1206
1207                --  If statement, which breaks the current statement sequence,
1208                --  but we include the condition in the current sequence.
1209
1210                when N_If_Statement =>
1211                   Extend_Statement_Sequence (N, Condition (N), 'I');
1212                   Process_Decisions_Defer (Condition (N), 'I');
1213                   Set_Statement_Entry;
1214
1215                   --  Now we traverse the statements in the THEN part
1216
1217                   Traverse_Declarations_Or_Statements (Then_Statements (N));
1218
1219                   --  Loop through ELSIF parts if present
1220
1221                   if Present (Elsif_Parts (N)) then
1222                      declare
1223                         Elif : Node_Id := First (Elsif_Parts (N));
1224
1225                      begin
1226                         while Present (Elif) loop
1227
1228                            --  We generate a statement sequence for the
1229                            --  construct "ELSIF condition", so that we have
1230                            --  a statement for the resulting decisions.
1231
1232                            Extend_Statement_Sequence
1233                              (Elif, Condition (Elif), 'I');
1234                            Process_Decisions_Defer (Condition (Elif), 'I');
1235                            Set_Statement_Entry;
1236
1237                            --  Traverse the statements in the ELSIF
1238
1239                            Traverse_Declarations_Or_Statements
1240                              (Then_Statements (Elif));
1241                            Next (Elif);
1242                         end loop;
1243                      end;
1244                   end if;
1245
1246                   --  Finally traverse the ELSE statements if present
1247
1248                   Traverse_Declarations_Or_Statements (Else_Statements (N));
1249
1250                --  Case statement, which breaks the current statement sequence,
1251                --  but we include the expression in the current sequence.
1252
1253                when N_Case_Statement =>
1254                   Extend_Statement_Sequence (N, Expression (N), 'C');
1255                   Process_Decisions_Defer (Expression (N), 'X');
1256                   Set_Statement_Entry;
1257
1258                   --  Process case branches
1259
1260                   declare
1261                      Alt : Node_Id;
1262                   begin
1263                      Alt := First (Alternatives (N));
1264                      while Present (Alt) loop
1265                         Traverse_Declarations_Or_Statements (Statements (Alt));
1266                         Next (Alt);
1267                      end loop;
1268                   end;
1269
1270                --  Unconditional exit points, which are included in the current
1271                --  statement sequence, but then terminate it
1272
1273                when N_Requeue_Statement |
1274                     N_Goto_Statement    |
1275                     N_Raise_Statement   =>
1276                   Extend_Statement_Sequence (N, ' ');
1277                   Set_Statement_Entry;
1278
1279                --  Simple return statement. which is an exit point, but we
1280                --  have to process the return expression for decisions.
1281
1282                when N_Simple_Return_Statement =>
1283                   Extend_Statement_Sequence (N, ' ');
1284                   Process_Decisions_Defer (Expression (N), 'X');
1285                   Set_Statement_Entry;
1286
1287                --  Extended return statement
1288
1289                when N_Extended_Return_Statement =>
1290                   Extend_Statement_Sequence
1291                     (N, Last (Return_Object_Declarations (N)), 'R');
1292                   Process_Decisions_Defer
1293                     (Return_Object_Declarations (N), 'X');
1294                   Set_Statement_Entry;
1295
1296                   Traverse_Handled_Statement_Sequence
1297                     (Handled_Statement_Sequence (N));
1298
1299                --  Loop ends the current statement sequence, but we include
1300                --  the iteration scheme if present in the current sequence.
1301                --  But the body of the loop starts a new sequence, since it
1302                --  may not be executed as part of the current sequence.
1303
1304                when N_Loop_Statement =>
1305                   if Present (Iteration_Scheme (N)) then
1306
1307                      --  If iteration scheme present, extend the current
1308                      --  statement sequence to include the iteration scheme
1309                      --  and process any decisions it contains.
1310
1311                      declare
1312                         ISC : constant Node_Id := Iteration_Scheme (N);
1313
1314                      begin
1315                         --  While statement
1316
1317                         if Present (Condition (ISC)) then
1318                            Extend_Statement_Sequence (N, ISC, 'W');
1319                            Process_Decisions_Defer (Condition (ISC), 'W');
1320
1321                         --  For statement
1322
1323                         else
1324                            Extend_Statement_Sequence (N, ISC, 'F');
1325                            Process_Decisions_Defer
1326                              (Loop_Parameter_Specification (ISC), 'X');
1327                         end if;
1328                      end;
1329                   end if;
1330
1331                   Set_Statement_Entry;
1332                   Traverse_Declarations_Or_Statements (Statements (N));
1333
1334                --  Pragma
1335
1336                when N_Pragma =>
1337                   Extend_Statement_Sequence (N, 'P');
1338
1339                   --  Processing depends on the kind of pragma
1340
1341                   case Pragma_Name (N) is
1342                      when Name_Assert        |
1343                           Name_Check         |
1344                           Name_Precondition  |
1345                           Name_Postcondition =>
1346
1347                         --  For Assert/Check/Precondition/Postcondition, we
1348                         --  must generate a P entry for the decision. Note that
1349                         --  this is done unconditionally at this stage. Output
1350                         --  for disabled pragmas is suppressed later on, when
1351                         --  we output the decision line in Put_SCOs.
1352
1353                         declare
1354                            Nam : constant Name_Id :=
1355                                    Chars (Pragma_Identifier (N));
1356                            Arg : Node_Id :=
1357                                    First (Pragma_Argument_Associations (N));
1358
1359                         begin
1360                            if Nam = Name_Check then
1361                               Next (Arg);
1362                            end if;
1363
1364                            Process_Decisions_Defer (Expression (Arg), 'P');
1365                         end;
1366
1367                      --  For all other pragmas, we generate decision entries
1368                      --  for any embedded expressions.
1369
1370                      when others =>
1371                         Process_Decisions_Defer (N, 'X');
1372                   end case;
1373
1374                --  Object declaration. Ignored if Prev_Ids is set, since the
1375                --  parser generates multiple instances of the whole declaration
1376                --  if there is more than one identifier declared, and we only
1377                --  want one entry in the SCO's, so we take the first, for which
1378                --  Prev_Ids is False.
1379
1380                when N_Object_Declaration =>
1381                   if not Prev_Ids (N) then
1382                      Extend_Statement_Sequence (N, 'o');
1383
1384                      if Has_Decision (N) then
1385                         Process_Decisions_Defer (N, 'X');
1386                      end if;
1387                   end if;
1388
1389                --  All other cases, which extend the current statement sequence
1390                --  but do not terminate it, even if they have nested decisions.
1391
1392                when others =>
1393
1394                   --  Determine required type character code
1395
1396                   declare
1397                      Typ : Character;
1398
1399                   begin
1400                      case Nkind (N) is
1401                         when N_Full_Type_Declaration         |
1402                              N_Incomplete_Type_Declaration   |
1403                              N_Private_Type_Declaration      |
1404                              N_Private_Extension_Declaration =>
1405                            Typ := 't';
1406
1407                         when N_Subtype_Declaration           =>
1408                            Typ := 's';
1409
1410                         when N_Renaming_Declaration          =>
1411                            Typ := 'r';
1412
1413                         when N_Generic_Instantiation         =>
1414                            Typ := 'i';
1415
1416                         when others                          =>
1417                            Typ := ' ';
1418                      end case;
1419
1420                      Extend_Statement_Sequence (N, Typ);
1421                   end;
1422
1423                   --  Process any embedded decisions
1424
1425                   if Has_Decision (N) then
1426                      Process_Decisions_Defer (N, 'X');
1427                   end if;
1428             end case;
1429
1430             Next (N);
1431          end loop;
1432
1433          Set_Statement_Entry;
1434       end if;
1435    end Traverse_Declarations_Or_Statements;
1436
1437    ------------------------------------
1438    -- Traverse_Generic_Instantiation --
1439    ------------------------------------
1440
1441    procedure Traverse_Generic_Instantiation (N : Node_Id) is
1442       First : Source_Ptr;
1443       Last  : Source_Ptr;
1444
1445    begin
1446       --  First we need a statement entry to cover the instantiation
1447
1448       Sloc_Range (N, First, Last);
1449       Set_Table_Entry
1450         (C1   => 'S',
1451          C2   => ' ',
1452          From => First,
1453          To   => Last,
1454          Last => True);
1455
1456       --  Now output any embedded decisions
1457
1458       Process_Decisions (N, 'X');
1459    end Traverse_Generic_Instantiation;
1460
1461    ------------------------------------------
1462    -- Traverse_Generic_Package_Declaration --
1463    ------------------------------------------
1464
1465    procedure Traverse_Generic_Package_Declaration (N : Node_Id) is
1466    begin
1467       Process_Decisions (Generic_Formal_Declarations (N), 'X');
1468       Traverse_Package_Declaration (N);
1469    end Traverse_Generic_Package_Declaration;
1470
1471    -----------------------------------------
1472    -- Traverse_Handled_Statement_Sequence --
1473    -----------------------------------------
1474
1475    procedure Traverse_Handled_Statement_Sequence (N : Node_Id) is
1476       Handler : Node_Id;
1477
1478    begin
1479       --  For package bodies without a statement part, the parser adds an empty
1480       --  one, to normalize the representation. The null statement therein,
1481       --  which does not come from source, does not get a SCO.
1482
1483       if Present (N) and then Comes_From_Source (N) then
1484          Traverse_Declarations_Or_Statements (Statements (N));
1485
1486          if Present (Exception_Handlers (N)) then
1487             Handler := First (Exception_Handlers (N));
1488             while Present (Handler) loop
1489                Traverse_Declarations_Or_Statements (Statements (Handler));
1490                Next (Handler);
1491             end loop;
1492          end if;
1493       end if;
1494    end Traverse_Handled_Statement_Sequence;
1495
1496    ---------------------------
1497    -- Traverse_Package_Body --
1498    ---------------------------
1499
1500    procedure Traverse_Package_Body (N : Node_Id) is
1501    begin
1502       Traverse_Declarations_Or_Statements (Declarations (N));
1503       Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N));
1504    end Traverse_Package_Body;
1505
1506    ----------------------------------
1507    -- Traverse_Package_Declaration --
1508    ----------------------------------
1509
1510    procedure Traverse_Package_Declaration (N : Node_Id) is
1511       Spec : constant Node_Id := Specification (N);
1512    begin
1513       Traverse_Declarations_Or_Statements (Visible_Declarations (Spec));
1514       Traverse_Declarations_Or_Statements (Private_Declarations (Spec));
1515    end Traverse_Package_Declaration;
1516
1517    -----------------------------
1518    -- Traverse_Protected_Body --
1519    -----------------------------
1520
1521    procedure Traverse_Protected_Body (N : Node_Id) is
1522    begin
1523       Traverse_Declarations_Or_Statements (Declarations (N));
1524    end Traverse_Protected_Body;
1525
1526    --------------------------------------
1527    -- Traverse_Subprogram_Or_Task_Body --
1528    --------------------------------------
1529
1530    procedure Traverse_Subprogram_Or_Task_Body (N : Node_Id) is
1531    begin
1532       Traverse_Declarations_Or_Statements (Declarations (N));
1533       Traverse_Handled_Statement_Sequence (Handled_Statement_Sequence (N));
1534    end Traverse_Subprogram_Or_Task_Body;
1535
1536    -------------------------------------
1537    -- Traverse_Subprogram_Declaration --
1538    -------------------------------------
1539
1540    procedure Traverse_Subprogram_Declaration (N : Node_Id) is
1541       ADN : constant Node_Id := Aux_Decls_Node (Parent (N));
1542    begin
1543       Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
1544       Traverse_Declarations_Or_Statements (Declarations   (ADN));
1545       Traverse_Declarations_Or_Statements (Pragmas_After  (ADN));
1546    end Traverse_Subprogram_Declaration;
1547
1548 end Par_SCO;