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