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