Improve max_insns_skipped logic

[official-gcc.git] / gcc / ada / par_sco.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              P A R _ S C O                               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2009-2017, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Aspects;  use Aspects;
with Atree;    use Atree;
with Debug;    use Debug;
with Errout;   use Errout;
with Lib;      use Lib;
with Lib.Util; use Lib.Util;
with Namet;    use Namet;
with Nlists;   use Nlists;
with Opt;      use Opt;
with Output;   use Output;
with Put_SCOs;
with SCOs;     use SCOs;
with Sem;      use Sem;
with Sem_Util; use Sem_Util;
with Sinfo;    use Sinfo;
with Sinput;   use Sinput;
with Snames;   use Snames;
with Table;

with GNAT.HTable;      use GNAT.HTable;
with GNAT.Heap_Sort_G;
with GNAT.Table;

package body Par_SCO is

   --------------------------
   -- First-pass SCO table --
   --------------------------

   --  The Short_Circuit_And_Or pragma enables one to use AND and OR operators
   --  in source code while the ones used with booleans will be interpreted as
   --  their short circuit alternatives (AND THEN and OR ELSE). Thus, the true
   --  meaning of these operators is known only after the semantic analysis.

   --  However, decision SCOs include short circuit operators only. The SCO
   --  information generation pass must be done before expansion, hence before
   --  the semantic analysis. Because of this, the SCO information generation
   --  is done in two passes.

   --  The first one (SCO_Record_Raw, before semantic analysis) completes the
   --  SCO_Raw_Table assuming all AND/OR operators are short circuit ones.
   --  Then, the semantic analysis determines which operators are promoted to
   --  short circuit ones. Finally, the second pass (SCO_Record_Filtered)
   --  translates the SCO_Raw_Table to SCO_Table, taking care of removing the
   --  remaining AND/OR operators and of adjusting decisions accordingly
   --  (splitting decisions, removing empty ones, etc.).

   type SCO_Generation_State_Type is (None, Raw, Filtered);
   SCO_Generation_State : SCO_Generation_State_Type := None;
   --  Keep track of the SCO generation state: this will prevent us from
   --  running some steps multiple times (the second pass has to be started
   --  from multiple places).

   package SCO_Raw_Table is new GNAT.Table
     (Table_Component_Type => SCO_Table_Entry,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => 500,
      Table_Increment      => 300);

   -----------------------
   -- Unit Number Table --
   -----------------------

   --  This table parallels the SCO_Unit_Table, keeping track of the unit
   --  numbers corresponding to the entries made in this table, so that before
   --  writing out the SCO information to the ALI file, we can fill in the
   --  proper dependency numbers and file names.

   --  Note that the zero'th entry is here for convenience in sorting the
   --  table, the real lower bound is 1.

   package SCO_Unit_Number_Table is new Table.Table
     (Table_Component_Type => Unit_Number_Type,
      Table_Index_Type     => SCO_Unit_Index,
      Table_Low_Bound      => 0, -- see note above on sort
      Table_Initial        => 20,
      Table_Increment      => 200,
      Table_Name           => "SCO_Unit_Number_Entry");

   ------------------------------------------
   -- Condition/Operator/Pragma Hash Table --
   ------------------------------------------

   --  We need to be able to get to conditions quickly for handling the calls
   --  to Set_SCO_Condition efficiently, and similarly to get to pragmas to
   --  handle calls to Set_SCO_Pragma_Enabled (the same holds for operators and
   --  Set_SCO_Logical_Operator). For this purpose we identify the conditions,
   --  operators and pragmas in the table by their starting sloc, and use this
   --  hash table to map from these sloc values to SCO_Table indexes.

   type Header_Num is new Integer range 0 .. 996;
   --  Type for hash table headers

   function Hash (F : Source_Ptr) return Header_Num;
   --  Function to Hash source pointer value

   function Equal (F1 : Source_Ptr; F2 : Source_Ptr) return Boolean;
   --  Function to test two keys for equality

   function "<" (S1 : Source_Location; S2 : Source_Location) return Boolean;
   --  Function to test for source locations order

   package SCO_Raw_Hash_Table is new Simple_HTable
     (Header_Num, Int, 0, Source_Ptr, Hash, Equal);
   --  The actual hash table

   --------------------------
   -- Internal Subprograms --
   --------------------------

   function Has_Decision (N : Node_Id) return Boolean;
   --  N is the node for a subexpression. Returns True if the subexpression
   --  contains a nested decision (i.e. either is a logical operator, or
   --  contains a logical operator in its subtree).
   --
   --  This must be used in the first pass (SCO_Record_Raw) only: here AND/OR
   --  operators are considered as short circuit, just in case the
   --  Short_Circuit_And_Or pragma is used: only real short circuit operations
   --  will be kept in the secord pass.

   type Tristate is (False, True, Unknown);

   function Is_Logical_Operator (N : Node_Id) return Tristate;
   --  N is the node for a subexpression. This procedure determines whether N
   --  is a logical operator: True for short circuit conditions, Unknown for OR
   --  and AND (the Short_Circuit_And_Or pragma may be used) and False
   --  otherwise. Note that in cases where True is returned, callers assume
   --  Nkind (N) in N_Op.

   function To_Source_Location (S : Source_Ptr) return Source_Location;
   --  Converts Source_Ptr value to Source_Location (line/col) format

   procedure Process_Decisions
     (N           : Node_Id;
      T           : Character;
      Pragma_Sloc : Source_Ptr);
   --  If N is Empty, has no effect. Otherwise scans the tree for the node N,
   --  to output any decisions it contains. T is one of IEGPWX (for context of
   --  expression: if/exit when/entry guard/pragma/while/expression). If T is
   --  other than X, the node N is the if expression involved, and a decision
   --  is always present (at the very least a simple decision is present at the
   --  top level).

   procedure Process_Decisions
     (L           : List_Id;
      T           : Character;
      Pragma_Sloc : Source_Ptr);
   --  Calls above procedure for each element of the list L

   procedure Set_Raw_Table_Entry
     (C1                 : Character;
      C2                 : Character;
      From               : Source_Ptr;
      To                 : Source_Ptr;
      Last               : Boolean;
      Pragma_Sloc        : Source_Ptr := No_Location;
      Pragma_Aspect_Name : Name_Id    := No_Name);
   --  Append an entry to SCO_Raw_Table with fields set as per arguments

   type Dominant_Info is record
      K : Character;
      --  F/T/S/E for a valid dominance marker, or ' ' for no dominant

      N : Node_Id;
      --  Node providing the Sloc(s) for the dominance marker
   end record;
   No_Dominant : constant Dominant_Info := (' ', Empty);

   procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr);
   --  Add one entry from the instance table to the corresponding SCO table

   procedure Traverse_Declarations_Or_Statements
     (L : List_Id;
      D : Dominant_Info := No_Dominant;
      P : Node_Id       := Empty);
   --  Process L, a list of statements or declarations dominated by D. If P is
   --  present, it is processed as though it had been prepended to L.

   function Traverse_Declarations_Or_Statements
     (L : List_Id;
      D : Dominant_Info := No_Dominant;
      P : Node_Id       := Empty) return Dominant_Info;
   --  Same as above, and returns dominant information corresponding to the
   --  last node with SCO in L.

   --  The following Traverse_* routines perform appropriate calls to
   --  Traverse_Declarations_Or_Statements to traverse specific node kinds.
   --  Parameter D, when present, indicates the dominant of the first
   --  declaration or statement within N.

   --  Why is Traverse_Sync_Definition commented specificaly and
   --   the others are not???

   procedure Traverse_Generic_Package_Declaration (N : Node_Id);

   procedure Traverse_Handled_Statement_Sequence
     (N : Node_Id;
      D : Dominant_Info := No_Dominant);

   procedure Traverse_Package_Body (N : Node_Id);

   procedure Traverse_Package_Declaration
     (N : Node_Id;
      D : Dominant_Info := No_Dominant);

   procedure Traverse_Subprogram_Or_Task_Body
     (N : Node_Id;
      D : Dominant_Info := No_Dominant);

   procedure Traverse_Sync_Definition (N : Node_Id);
   --  Traverse a protected definition or task definition

   --  Note regarding traversals: In a few cases where an Alternatives list is
   --  involved, pragmas such as "pragma Page" may show up before the first
   --  alternative. We skip them because we're out of statement or declaration
   --  context, so these can't be pragmas of interest for SCO purposes, and
   --  the regular alternative processing typically involves attribute queries
   --  which aren't valid for a pragma.

   procedure Write_SCOs_To_ALI_File is new Put_SCOs;
   --  Write SCO information to the ALI file using routines in Lib.Util

   ----------
   -- dsco --
   ----------

   procedure dsco is
      procedure Dump_Entry (Index : Nat; T : SCO_Table_Entry);
      --  Dump a SCO table entry

      ----------------
      -- Dump_Entry --
      ----------------

      procedure Dump_Entry (Index : Nat; T : SCO_Table_Entry) is
      begin
         Write_Str  ("  ");
         Write_Int  (Index);
         Write_Char ('.');

         if T.C1 /= ' ' then
            Write_Str  ("  C1 = '");
            Write_Char (T.C1);
            Write_Char (''');
         end if;

         if T.C2 /= ' ' then
            Write_Str  ("  C2 = '");
            Write_Char (T.C2);
            Write_Char (''');
         end if;

         if T.From /= No_Source_Location then
            Write_Str ("  From = ");
            Write_Int (Int (T.From.Line));
            Write_Char (':');
            Write_Int (Int (T.From.Col));
         end if;

         if T.To /= No_Source_Location then
            Write_Str ("  To = ");
            Write_Int (Int (T.To.Line));
            Write_Char (':');
            Write_Int (Int (T.To.Col));
         end if;

         if T.Last then
            Write_Str ("  True");
         else
            Write_Str ("  False");
         end if;

         Write_Eol;
      end Dump_Entry;

   --  Start of processing for dsco

   begin
      --  Dump SCO unit table

      Write_Line ("SCO Unit Table");
      Write_Line ("--------------");

      for Index in 1 .. SCO_Unit_Table.Last loop
         declare
            UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);

         begin
            Write_Str ("  ");
            Write_Int (Int (Index));
            Write_Str ("  Dep_Num = ");
            Write_Int (Int (UTE.Dep_Num));
            Write_Str ("  From = ");
            Write_Int (Int (UTE.From));
            Write_Str ("  To = ");
            Write_Int (Int (UTE.To));

            Write_Str ("  File_Name = """);

            if UTE.File_Name /= null then
               Write_Str (UTE.File_Name.all);
            end if;

            Write_Char ('"');
            Write_Eol;
         end;
      end loop;

      --  Dump SCO Unit number table if it contains any entries

      if SCO_Unit_Number_Table.Last >= 1 then
         Write_Eol;
         Write_Line ("SCO Unit Number Table");
         Write_Line ("---------------------");

         for Index in 1 .. SCO_Unit_Number_Table.Last loop
            Write_Str ("  ");
            Write_Int (Int (Index));
            Write_Str (". Unit_Number = ");
            Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
            Write_Eol;
         end loop;
      end if;

      --  Dump SCO raw-table

      Write_Eol;
      Write_Line ("SCO Raw Table");
      Write_Line ("---------");

      if SCO_Generation_State = Filtered then
         Write_Line ("Empty (free'd after second pass)");
      else
         for Index in 1 .. SCO_Raw_Table.Last loop
            Dump_Entry (Index, SCO_Raw_Table.Table (Index));
         end loop;
      end if;

      --  Dump SCO table itself

      Write_Eol;
      Write_Line ("SCO Filtered Table");
      Write_Line ("---------");

      for Index in 1 .. SCO_Table.Last loop
         Dump_Entry (Index, SCO_Table.Table (Index));
      end loop;
   end dsco;

   -----------
   -- Equal --
   -----------

   function Equal (F1 : Source_Ptr; F2 : Source_Ptr) return Boolean is
   begin
      return F1 = F2;
   end Equal;

   -------
   -- < --
   -------

   function "<" (S1 : Source_Location; S2 : Source_Location) return Boolean is
   begin
      return S1.Line < S2.Line
        or else (S1.Line = S2.Line and then S1.Col < S2.Col);
   end "<";

   ------------------
   -- Has_Decision --
   ------------------

   function Has_Decision (N : Node_Id) return Boolean is
      function Check_Node (N : Node_Id) return Traverse_Result;
      --  Determine if Nkind (N) indicates the presence of a decision (i.e. N
      --  is a logical operator, which is a decision in itself, or an
      --  IF-expression whose Condition attribute is a decision).

      ----------------
      -- Check_Node --
      ----------------

      function Check_Node (N : Node_Id) return Traverse_Result is
      begin
         --  If we are not sure this is a logical operator (AND and OR may be
         --  turned into logical operators with the Short_Circuit_And_Or
         --  pragma), assume it is. Putative decisions will be discarded if
         --  needed in the secord pass.

         if Is_Logical_Operator (N) /= False
           or else Nkind (N) = N_If_Expression
         then
            return Abandon;
         else
            return OK;
         end if;
      end Check_Node;

      function Traverse is new Traverse_Func (Check_Node);

   --  Start of processing for Has_Decision

   begin
      return Traverse (N) = Abandon;
   end Has_Decision;

   ----------
   -- Hash --
   ----------

   function Hash (F : Source_Ptr) return Header_Num is
   begin
      return Header_Num (Nat (F) mod 997);
   end Hash;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      SCO_Unit_Number_Table.Init;

      --  The SCO_Unit_Number_Table entry with index 0 is intentionally set
      --  aside to be used as temporary for sorting.

      SCO_Unit_Number_Table.Increment_Last;
   end Initialize;

   -------------------------
   -- Is_Logical_Operator --
   -------------------------

   function Is_Logical_Operator (N : Node_Id) return Tristate is
   begin
      if Nkind_In (N, N_And_Then, N_Op_Not, N_Or_Else) then
         return True;
      elsif Nkind_In (N, N_Op_And, N_Op_Or) then
         return Unknown;
      else
         return False;
      end if;
   end Is_Logical_Operator;

   -----------------------
   -- Process_Decisions --
   -----------------------

   --  Version taking a list

   procedure Process_Decisions
     (L           : List_Id;
      T           : Character;
      Pragma_Sloc : Source_Ptr)
   is
      N : Node_Id;

   begin
      if L /= No_List then
         N := First (L);
         while Present (N) loop
            Process_Decisions (N, T, Pragma_Sloc);
            Next (N);
         end loop;
      end if;
   end Process_Decisions;

   --  Version taking a node

   Current_Pragma_Sloc : Source_Ptr := No_Location;
   --  While processing a pragma, this is set to the sloc of the N_Pragma node

   procedure Process_Decisions
     (N           : Node_Id;
      T           : Character;
      Pragma_Sloc : Source_Ptr)
   is
      Mark : Nat;
      --  This is used to mark the location of a decision sequence in the SCO
      --  table. We use it for backing out a simple decision in an expression
      --  context that contains only NOT operators.

      Mark_Hash : Nat;
      --  Likewise for the putative SCO_Raw_Hash_Table entries: see below

      type Hash_Entry is record
         Sloc      : Source_Ptr;
         SCO_Index : Nat;
      end record;
      --  We must register all conditions/pragmas in SCO_Raw_Hash_Table.
      --  However we cannot register them in the same time we are adding the
      --  corresponding SCO entries to the raw table since we may discard them
      --  later on. So instead we put all putative conditions into Hash_Entries
      --  (see below) and register them once we are sure we keep them.
      --
      --  This data structure holds the conditions/pragmas to register in
      --  SCO_Raw_Hash_Table.

      package Hash_Entries is new Table.Table
        (Table_Component_Type => Hash_Entry,
         Table_Index_Type     => Nat,
         Table_Low_Bound      => 1,
         Table_Initial        => 10,
         Table_Increment      => 10,
         Table_Name           => "Hash_Entries");
      --  Hold temporarily (i.e. free'd before returning) the Hash_Entry before
      --  they are registered in SCO_Raw_Hash_Table.

      X_Not_Decision : Boolean;
      --  This flag keeps track of whether a decision sequence in the SCO table
      --  contains only NOT operators, and is for an expression context (T=X).
      --  The flag will be set False if T is other than X, or if an operator
      --  other than NOT is in the sequence.

      procedure Output_Decision_Operand (N : Node_Id);
      --  The node N is the top level logical operator of a decision, or it is
      --  one of the operands of a logical operator belonging to a single
      --  complex decision. This routine outputs the sequence of table entries
      --  corresponding to the node. Note that we do not process the sub-
      --  operands to look for further decisions, that processing is done in
      --  Process_Decision_Operand, because we can't get decisions mixed up in
      --  the global table. Call has no effect if N is Empty.

      procedure Output_Element (N : Node_Id);
      --  Node N is an operand of a logical operator that is not itself a
      --  logical operator, or it is a simple decision. This routine outputs
      --  the table entry for the element, with C1 set to ' '. Last is set
      --  False, and an entry is made in the condition hash table.

      procedure Output_Header (T : Character);
      --  Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
      --  PRAGMA, and 'X' for the expression case.

      procedure Process_Decision_Operand (N : Node_Id);
      --  This is called on node N, the top level node of a decision, or on one
      --  of its operands or suboperands after generating the full output for
      --  the complex decision. It process the suboperands of the decision
      --  looking for nested decisions.

      function Process_Node (N : Node_Id) return Traverse_Result;
      --  Processes one node in the traversal, looking for logical operators,
      --  and if one is found, outputs the appropriate table entries.

      -----------------------------
      -- Output_Decision_Operand --
      -----------------------------

      procedure Output_Decision_Operand (N : Node_Id) is
         C1 : Character;
         C2 : Character;
         --  C1 holds a character that identifies the operation while C2
         --  indicates whether we are sure (' ') or not ('?') this operation
         --  belongs to the decision. '?' entries will be filtered out in the
         --  second (SCO_Record_Filtered) pass.

         L : Node_Id;
         T : Tristate;

      begin
         if No (N) then
            return;
         end if;

         T := Is_Logical_Operator (N);

         --  Logical operator

         if T /= False then
            if Nkind (N) = N_Op_Not then
               C1 := '!';
               L := Empty;

            else
               L := Left_Opnd (N);

               if Nkind_In (N, N_Op_Or, N_Or_Else) then
                  C1 := '|';
               else pragma Assert (Nkind_In (N, N_Op_And, N_And_Then));
                  C1 := '&';
               end if;
            end if;

            if T = True then
               C2 := ' ';
            else
               C2 := '?';
            end if;

            Set_Raw_Table_Entry
              (C1   => C1,
               C2   => C2,
               From => Sloc (N),
               To   => No_Location,
               Last => False);

            Hash_Entries.Append ((Sloc (N), SCO_Raw_Table.Last));

            Output_Decision_Operand (L);
            Output_Decision_Operand (Right_Opnd (N));

         --  Not a logical operator

         else
            Output_Element (N);
         end if;
      end Output_Decision_Operand;

      --------------------
      -- Output_Element --
      --------------------

      procedure Output_Element (N : Node_Id) is
         FSloc : Source_Ptr;
         LSloc : Source_Ptr;
      begin
         Sloc_Range (N, FSloc, LSloc);
         Set_Raw_Table_Entry
           (C1   => ' ',
            C2   => 'c',
            From => FSloc,
            To   => LSloc,
            Last => False);
         Hash_Entries.Append ((FSloc, SCO_Raw_Table.Last));
      end Output_Element;

      -------------------
      -- Output_Header --
      -------------------

      procedure Output_Header (T : Character) is
         Loc : Source_Ptr := No_Location;
         --  Node whose Sloc is used for the decision

         Nam : Name_Id := No_Name;
         --  For the case of an aspect, aspect name

      begin
         case T is
            when 'I' | 'E' | 'W' | 'a' | 'A' =>

               --  For IF, EXIT, WHILE, or aspects, the token SLOC is that of
               --  the parent of the expression.

               Loc := Sloc (Parent (N));

               if T = 'a' or else T = 'A' then
                  Nam := Chars (Identifier (Parent (N)));
               end if;

            when 'G' | 'P' =>

               --  For entry guard, the token sloc is from the N_Entry_Body.
               --  For PRAGMA, we must get the location from the pragma node.
               --  Argument N is the pragma argument, and we have to go up
               --  two levels (through the pragma argument association) to
               --  get to the pragma node itself. For the guard on a select
               --  alternative, we do not have access to the token location for
               --  the WHEN, so we use the first sloc of the condition itself
               --  (note: we use First_Sloc, not Sloc, because this is what is
               --  referenced by dominance markers).

               --  Doesn't this requirement of using First_Sloc need to be
               --  documented in the spec ???

               if Nkind_In (Parent (N), N_Accept_Alternative,
                                        N_Delay_Alternative,
                                        N_Terminate_Alternative)
               then
                  Loc := First_Sloc (N);
               else
                  Loc := Sloc (Parent (Parent (N)));
               end if;

            when 'X' =>

               --  For an expression, no Sloc

               null;

            --  No other possibilities

            when others =>
               raise Program_Error;
         end case;

         Set_Raw_Table_Entry
           (C1                 => T,
            C2                 => ' ',
            From               => Loc,
            To                 => No_Location,
            Last               => False,
            Pragma_Sloc        => Pragma_Sloc,
            Pragma_Aspect_Name => Nam);

         --  For an aspect specification, which will be rewritten into a
         --  pragma, enter a hash table entry now.

         if T = 'a' then
            Hash_Entries.Append ((Loc, SCO_Raw_Table.Last));
         end if;
      end Output_Header;

      ------------------------------
      -- Process_Decision_Operand --
      ------------------------------

      procedure Process_Decision_Operand (N : Node_Id) is
      begin
         if Is_Logical_Operator (N) /= False then
            if Nkind (N) /= N_Op_Not then
               Process_Decision_Operand (Left_Opnd (N));
               X_Not_Decision := False;
            end if;

            Process_Decision_Operand (Right_Opnd (N));

         else
            Process_Decisions (N, 'X', Pragma_Sloc);
         end if;
      end Process_Decision_Operand;

      ------------------
      -- Process_Node --
      ------------------

      function Process_Node (N : Node_Id) return Traverse_Result is
      begin
         case Nkind (N) is

            --  Logical operators, output table entries and then process
            --  operands recursively to deal with nested conditions.

            when N_And_Then
               | N_Op_And
               | N_Op_Not
               | N_Op_Or
               | N_Or_Else
            =>
               declare
                  T : Character;

               begin
                  --  If outer level, then type comes from call, otherwise it
                  --  is more deeply nested and counts as X for expression.

                  if N = Process_Decisions.N then
                     T := Process_Decisions.T;
                  else
                     T := 'X';
                  end if;

                  --  Output header for sequence

                  X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
                  Mark      := SCO_Raw_Table.Last;
                  Mark_Hash := Hash_Entries.Last;
                  Output_Header (T);

                  --  Output the decision

                  Output_Decision_Operand (N);

                  --  If the decision was in an expression context (T = 'X')
                  --  and contained only NOT operators, then we don't output
                  --  it, so delete it.

                  if X_Not_Decision then
                     SCO_Raw_Table.Set_Last (Mark);
                     Hash_Entries.Set_Last (Mark_Hash);

                  --  Otherwise, set Last in last table entry to mark end

                  else
                     SCO_Raw_Table.Table (SCO_Raw_Table.Last).Last := True;
                  end if;

                  --  Process any embedded decisions

                  Process_Decision_Operand (N);
                  return Skip;
               end;

            --  Case expression

            --  Really hard to believe this is correct given the special
            --  handling for if expressions below ???

            when N_Case_Expression =>
               return OK; -- ???

            --  If expression, processed like an if statement

            when N_If_Expression =>
               declare
                  Cond : constant Node_Id := First (Expressions (N));
                  Thnx : constant Node_Id := Next (Cond);
                  Elsx : constant Node_Id := Next (Thnx);

               begin
                  Process_Decisions (Cond, 'I', Pragma_Sloc);
                  Process_Decisions (Thnx, 'X', Pragma_Sloc);
                  Process_Decisions (Elsx, 'X', Pragma_Sloc);
                  return Skip;
               end;

            --  All other cases, continue scan

            when others =>
               return OK;
         end case;
      end Process_Node;

      procedure Traverse is new Traverse_Proc (Process_Node);

   --  Start of processing for Process_Decisions

   begin
      if No (N) then
         return;
      end if;

      Hash_Entries.Init;

      --  See if we have simple decision at outer level and if so then
      --  generate the decision entry for this simple decision. A simple
      --  decision is a boolean expression (which is not a logical operator
      --  or short circuit form) appearing as the operand of an IF, WHILE,
      --  EXIT WHEN, or special PRAGMA construct.

      if T /= 'X' and then Is_Logical_Operator (N) = False then
         Output_Header (T);
         Output_Element (N);

         --  Change Last in last table entry to True to mark end of
         --  sequence, which is this case is only one element long.

         SCO_Raw_Table.Table (SCO_Raw_Table.Last).Last := True;
      end if;

      Traverse (N);

      --  Now we have the definitive set of SCO entries, register them in the
      --  corresponding hash table.

      for J in 1 .. Hash_Entries.Last loop
         SCO_Raw_Hash_Table.Set
           (Hash_Entries.Table (J).Sloc,
            Hash_Entries.Table (J).SCO_Index);
      end loop;

      Hash_Entries.Free;
   end Process_Decisions;

   -----------
   -- pscos --
   -----------

   procedure pscos is
      procedure Write_Info_Char (C : Character) renames Write_Char;
      --  Write one character;

      procedure Write_Info_Initiate (Key : Character) renames Write_Char;
      --  Start new one and write one character;

      procedure Write_Info_Nat (N : Nat);
      --  Write value of N

      procedure Write_Info_Terminate renames Write_Eol;
      --  Terminate current line

      --------------------
      -- Write_Info_Nat --
      --------------------

      procedure Write_Info_Nat (N : Nat) is
      begin
         Write_Int (N);
      end Write_Info_Nat;

      procedure Debug_Put_SCOs is new Put_SCOs;

   --  Start of processing for pscos

   begin
      Debug_Put_SCOs;
   end pscos;

   ---------------------
   -- Record_Instance --
   ---------------------

   procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr) is
      Inst_Src  : constant Source_File_Index :=
                    Get_Source_File_Index (Inst_Sloc);
   begin
      SCO_Instance_Table.Append
        ((Inst_Dep_Num       => Dependency_Num (Unit (Inst_Src)),
          Inst_Loc           => To_Source_Location (Inst_Sloc),
          Enclosing_Instance => SCO_Instance_Index (Instance (Inst_Src))));

      pragma Assert
        (SCO_Instance_Table.Last = SCO_Instance_Index (Id));
   end Record_Instance;

   ----------------
   -- SCO_Output --
   ----------------

   procedure SCO_Output is
      procedure Populate_SCO_Instance_Table is
        new Sinput.Iterate_On_Instances (Record_Instance);

   begin
      pragma Assert (SCO_Generation_State = Filtered);

      if Debug_Flag_Dot_OO then
         dsco;
      end if;

      Populate_SCO_Instance_Table;

      --  Sort the unit tables based on dependency numbers

      Unit_Table_Sort : declare
         function Lt (Op1 : Natural; Op2 : Natural) return Boolean;
         --  Comparison routine for sort call

         procedure Move (From : Natural; To : Natural);
         --  Move routine for sort call

         --------
         -- Lt --
         --------

         function Lt (Op1 : Natural; Op2 : Natural) return Boolean is
         begin
            return
              Dependency_Num
                (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
                     <
              Dependency_Num
                (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
         end Lt;

         ----------
         -- Move --
         ----------

         procedure Move (From : Natural; To : Natural) is
         begin
            SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
              SCO_Unit_Table.Table (SCO_Unit_Index (From));
            SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
              SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
         end Move;

         package Sorting is new GNAT.Heap_Sort_G (Move, Lt);

      --  Start of processing for Unit_Table_Sort

      begin
         Sorting.Sort (Integer (SCO_Unit_Table.Last));
      end Unit_Table_Sort;

      --  Loop through entries in the unit table to set file name and
      --  dependency number entries.

      for J in 1 .. SCO_Unit_Table.Last loop
         declare
            U   : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
            UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);

         begin
            Get_Name_String (Reference_Name (Source_Index (U)));
            UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
            UTE.Dep_Num := Dependency_Num (U);
         end;
      end loop;

      --  Now the tables are all setup for output to the ALI file

      Write_SCOs_To_ALI_File;
   end SCO_Output;

   -------------------------
   -- SCO_Pragma_Disabled --
   -------------------------

   function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is
      Index : Nat;

   begin
      if Loc = No_Location then
         return False;
      end if;

      Index := SCO_Raw_Hash_Table.Get (Loc);

      --  The test here for zero is to deal with possible previous errors, and
      --  for the case of pragma statement SCOs, for which we always set the
      --  Pragma_Sloc even if the particular pragma cannot be specifically
      --  disabled.

      if Index /= 0 then
         declare
            T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);

         begin
            case T.C1 is
               when 'S' =>
                  --  Pragma statement

                  return T.C2 = 'p';

               when 'A' =>
                  --  Aspect decision (enabled)

                  return False;

               when 'a' =>
                  --  Aspect decision (not enabled)

                  return True;

               when ASCII.NUL =>
                  --  Nullified disabled SCO

                  return True;

               when others =>
                  raise Program_Error;
            end case;
         end;

      else
         return False;
      end if;
   end SCO_Pragma_Disabled;

   --------------------
   -- SCO_Record_Raw --
   --------------------

   procedure SCO_Record_Raw (U : Unit_Number_Type) is
      procedure Traverse_Aux_Decls (N : Node_Id);
      --  Traverse the Aux_Decls_Node of compilation unit N

      ------------------------
      -- Traverse_Aux_Decls --
      ------------------------

      procedure Traverse_Aux_Decls (N : Node_Id) is
         ADN : constant Node_Id := Aux_Decls_Node (N);

      begin
         Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
         Traverse_Declarations_Or_Statements (Pragmas_After  (ADN));

         --  Declarations and Actions do not correspond to source constructs,
         --  they contain only nodes from expansion, so at this point they
         --  should still be empty:

         pragma Assert (No (Declarations (ADN)));
         pragma Assert (No (Actions (ADN)));
      end Traverse_Aux_Decls;

      --  Local variables

      From : Nat;
      Lu   : Node_Id;

   --  Start of processing for SCO_Record_Raw

   begin
      --  It is legitimate to run this pass multiple times (once per unit) so
      --  run it even if it was already run before.

      pragma Assert (SCO_Generation_State in None .. Raw);
      SCO_Generation_State := Raw;

      --  Ignore call if not generating code and generating SCO's

      if not (Generate_SCO and then Operating_Mode = Generate_Code) then
         return;
      end if;

      --  Ignore call if this unit already recorded

      for J in 1 .. SCO_Unit_Number_Table.Last loop
         if U = SCO_Unit_Number_Table.Table (J) then
            return;
         end if;
      end loop;

      --  Otherwise record starting entry

      From := SCO_Raw_Table.Last + 1;

      --  Get Unit (checking case of subunit)

      Lu := Unit (Cunit (U));

      if Nkind (Lu) = N_Subunit then
         Lu := Proper_Body (Lu);
      end if;

      --  Traverse the unit

      Traverse_Aux_Decls (Cunit (U));

      case Nkind (Lu) is
         when N_Generic_Instantiation
            | N_Generic_Package_Declaration
            | N_Package_Body
            | N_Package_Declaration
            | N_Protected_Body
            | N_Subprogram_Body
            | N_Subprogram_Declaration
            | N_Task_Body
         =>
            Traverse_Declarations_Or_Statements (L => No_List, P => Lu);

         --  All other cases of compilation units (e.g. renamings), generate no
         --  SCO information.

         when others =>
            null;
      end case;

      --  Make entry for new unit in unit tables, we will fill in the file
      --  name and dependency numbers later.

      SCO_Unit_Table.Append (
        (Dep_Num    => 0,
         File_Name  => null,
         File_Index => Get_Source_File_Index (Sloc (Lu)),
         From       => From,
         To         => SCO_Raw_Table.Last));

      SCO_Unit_Number_Table.Append (U);
   end SCO_Record_Raw;

   -----------------------
   -- Set_SCO_Condition --
   -----------------------

   procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is

      --  SCO annotations are not processed after the filtering pass

      pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);

      Constant_Condition_Code : constant array (Boolean) of Character :=
                                  (False => 'f', True => 't');

      Orig  : constant Node_Id := Original_Node (Cond);
      Dummy : Source_Ptr;
      Index : Nat;
      Start : Source_Ptr;

   begin
      Sloc_Range (Orig, Start, Dummy);
      Index := SCO_Raw_Hash_Table.Get (Start);

      --  Index can be zero for boolean expressions that do not have SCOs
      --  (simple decisions outside of a control flow structure), or in case
      --  of a previous error.

      if Index = 0 then
         return;

      else
         pragma Assert (SCO_Raw_Table.Table (Index).C1 = ' ');
         SCO_Raw_Table.Table (Index).C2 := Constant_Condition_Code (Val);
      end if;
   end Set_SCO_Condition;

   ------------------------------
   -- Set_SCO_Logical_Operator --
   ------------------------------

   procedure Set_SCO_Logical_Operator (Op : Node_Id) is

      --  SCO annotations are not processed after the filtering pass

      pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);

      Orig      : constant Node_Id    := Original_Node (Op);
      Orig_Sloc : constant Source_Ptr := Sloc (Orig);
      Index     : constant Nat        := SCO_Raw_Hash_Table.Get (Orig_Sloc);

   begin
      --  All (putative) logical operators are supposed to have their own entry
      --  in the SCOs table. However, the semantic analysis may invoke this
      --  subprogram with nodes that are out of the SCO generation scope.

      if Index /= 0 then
         SCO_Raw_Table.Table (Index).C2 := ' ';
      end if;
   end Set_SCO_Logical_Operator;

   ----------------------------
   -- Set_SCO_Pragma_Enabled --
   ----------------------------

   procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is

      --  SCO annotations are not processed after the filtering pass

      pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);

      Index : Nat;

   begin
      --  Nothing to do if not generating SCO, or if we're not processing the
      --  original source occurrence of the pragma.

      if not (Generate_SCO
               and then In_Extended_Main_Source_Unit (Loc)
               and then not (In_Instance or In_Inlined_Body))
      then
         return;
      end if;

      --  Note: the reason we use the Sloc value as the key is that in the
      --  generic case, the call to this procedure is made on a copy of the
      --  original node, so we can't use the Node_Id value.

      Index := SCO_Raw_Hash_Table.Get (Loc);

      --  A zero index here indicates that semantic analysis found an
      --  activated pragma at Loc which does not have a corresponding pragma
      --  or aspect at the syntax level. This may occur in legitimate cases
      --  because of expanded code (such are Pre/Post conditions generated for
      --  formal parameter validity checks), or as a consequence of a previous
      --  error.

      if Index = 0 then
         return;

      else
         declare
            T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);

         begin
            --  Note: may be called multiple times for the same sloc, so
            --  account for the fact that the entry may already have been
            --  marked enabled.

            case T.C1 is
               --  Aspect (decision SCO)

               when 'a' =>
                  T.C1 := 'A';

               when 'A' =>
                  null;

               --  Pragma (statement SCO)

               when 'S' =>
                  pragma Assert (T.C2 = 'p' or else T.C2 = 'P');
                  T.C2 := 'P';

               when others =>
                  raise Program_Error;
            end case;
         end;
      end if;
   end Set_SCO_Pragma_Enabled;

   -------------------------
   -- Set_Raw_Table_Entry --
   -------------------------

   procedure Set_Raw_Table_Entry
     (C1                 : Character;
      C2                 : Character;
      From               : Source_Ptr;
      To                 : Source_Ptr;
      Last               : Boolean;
      Pragma_Sloc        : Source_Ptr := No_Location;
      Pragma_Aspect_Name : Name_Id    := No_Name)
   is
      pragma Assert (SCO_Generation_State = Raw);
   begin
      SCO_Raw_Table.Append
        ((C1                 => C1,
          C2                 => C2,
          From               => To_Source_Location (From),
          To                 => To_Source_Location (To),
          Last               => Last,
          Pragma_Sloc        => Pragma_Sloc,
          Pragma_Aspect_Name => Pragma_Aspect_Name));
   end Set_Raw_Table_Entry;

   ------------------------
   -- To_Source_Location --
   ------------------------

   function To_Source_Location (S : Source_Ptr) return Source_Location is
   begin
      if S = No_Location then
         return No_Source_Location;
      else
         return
           (Line => Get_Logical_Line_Number (S),
            Col  => Get_Column_Number (S));
      end if;
   end To_Source_Location;

   -----------------------------------------
   -- Traverse_Declarations_Or_Statements --
   -----------------------------------------

   --  Tables used by Traverse_Declarations_Or_Statements for temporarily
   --  holding statement and decision entries. These are declared globally
   --  since they are shared by recursive calls to this procedure.

   type SC_Entry is record
      N    : Node_Id;
      From : Source_Ptr;
      To   : Source_Ptr;
      Typ  : Character;
   end record;
   --  Used to store a single entry in the following table, From:To represents
   --  the range of entries in the CS line entry, and typ is the type, with
   --  space meaning that no type letter will accompany the entry.

   package SC is new Table.Table
     (Table_Component_Type => SC_Entry,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => 1000,
      Table_Increment      => 200,
      Table_Name           => "SCO_SC");
   --  Used to store statement components for a CS entry to be output as a
   --  result of the call to this procedure. SC.Last is the last entry stored,
   --  so the current statement sequence is represented by SC_Array (SC_First
   --  .. SC.Last), where SC_First is saved on entry to each recursive call to
   --  the routine.
   --
   --  Extend_Statement_Sequence adds an entry to this array, and then
   --  Set_Statement_Entry clears the entries starting with SC_First, copying
   --  these entries to the main SCO output table. The reason that we do the
   --  temporary caching of results in this array is that we want the SCO table
   --  entries for a given CS line to be contiguous, and the processing may
   --  output intermediate entries such as decision entries.

   type SD_Entry is record
      Nod : Node_Id;
      Lst : List_Id;
      Typ : Character;
      Plo : Source_Ptr;
   end record;
   --  Used to store a single entry in the following table. Nod is the node to
   --  be searched for decisions for the case of Process_Decisions_Defer with a
   --  node argument (with Lst set to No_List. Lst is the list to be searched
   --  for decisions for the case of Process_Decisions_Defer with a List
   --  argument (in which case Nod is set to Empty). Plo is the sloc of the
   --  enclosing pragma, if any.

   package SD is new Table.Table
     (Table_Component_Type => SD_Entry,
      Table_Index_Type     => Nat,
      Table_Low_Bound      => 1,
      Table_Initial        => 1000,
      Table_Increment      => 200,
      Table_Name           => "SCO_SD");
   --  Used to store possible decision information. Instead of calling the
   --  Process_Decisions procedures directly, we call Process_Decisions_Defer,
   --  which simply stores the arguments in this table. Then when we clear
   --  out a statement sequence using Set_Statement_Entry, after generating
   --  the CS lines for the statements, the entries in this table result in
   --  calls to Process_Decision. The reason for doing things this way is to
   --  ensure that decisions are output after the CS line for the statements
   --  in which the decisions occur.

   procedure Traverse_Declarations_Or_Statements
     (L : List_Id;
      D : Dominant_Info := No_Dominant;
      P : Node_Id       := Empty)
   is
      Discard_Dom : Dominant_Info;
      pragma Warnings (Off, Discard_Dom);
   begin
      Discard_Dom := Traverse_Declarations_Or_Statements (L, D, P);
   end Traverse_Declarations_Or_Statements;

   function Traverse_Declarations_Or_Statements
     (L : List_Id;
      D : Dominant_Info := No_Dominant;
      P : Node_Id       := Empty) return Dominant_Info
   is
      Current_Dominant : Dominant_Info := D;
      --  Dominance information for the current basic block

      Current_Test : Node_Id;
      --  Conditional node (N_If_Statement or N_Elsiif being processed

      N : Node_Id;

      SC_First : constant Nat := SC.Last + 1;
      SD_First : constant Nat := SD.Last + 1;
      --  Record first entries used in SC/SD at this recursive level

      procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
      --  Extend the current statement sequence to encompass the node N. Typ is
      --  the letter that identifies the type of statement/declaration that is
      --  being added to the sequence.

      procedure Process_Decisions_Defer (N : Node_Id; T : Character);
      pragma Inline (Process_Decisions_Defer);
      --  This routine is logically the same as Process_Decisions, except that
      --  the arguments are saved in the SD table for later processing when
      --  Set_Statement_Entry is called, which goes through the saved entries
      --  making the corresponding calls to Process_Decision. Note: the
      --  enclosing statement must have already been added to the current
      --  statement sequence, so that nested decisions are properly
      --  identified as such.

      procedure Process_Decisions_Defer (L : List_Id; T : Character);
      pragma Inline (Process_Decisions_Defer);
      --  Same case for list arguments, deferred call to Process_Decisions

      procedure Set_Statement_Entry;
      --  Output CS entries for all statements saved in table SC, and end the
      --  current CS sequence. Then output entries for all decisions nested in
      --  these statements, which have been deferred so far.

      procedure Traverse_One (N : Node_Id);
      --  Traverse one declaration or statement

      procedure Traverse_Aspects (N : Node_Id);
      --  Helper for Traverse_One: traverse N's aspect specifications

      procedure Traverse_Degenerate_Subprogram (N : Node_Id);
      --  Common code to handle null procedures and expression functions. Emit
      --  a SCO of the given Kind and N outside of the dominance flow.

      -------------------------------
      -- Extend_Statement_Sequence --
      -------------------------------

      procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
         Dummy   : Source_Ptr;
         F       : Source_Ptr;
         T       : Source_Ptr;
         To_Node : Node_Id := Empty;

      begin
         Sloc_Range (N, F, T);

         case Nkind (N) is
            when N_Accept_Statement =>
               if Present (Parameter_Specifications (N)) then
                  To_Node := Last (Parameter_Specifications (N));
               elsif Present (Entry_Index (N)) then
                  To_Node := Entry_Index (N);
               end if;

            when N_Case_Statement =>
               To_Node := Expression (N);

            when N_Elsif_Part
               | N_If_Statement
            =>
               To_Node := Condition (N);

            when N_Extended_Return_Statement =>
               To_Node := Last (Return_Object_Declarations (N));

            when N_Loop_Statement =>
               To_Node := Iteration_Scheme (N);

            when N_Asynchronous_Select
               | N_Conditional_Entry_Call
               | N_Selective_Accept
               | N_Single_Protected_Declaration
               | N_Single_Task_Declaration
               | N_Timed_Entry_Call
            =>
               T := F;

            when N_Protected_Type_Declaration
               | N_Task_Type_Declaration
            =>
               if Has_Aspects (N) then
                  To_Node := Last (Aspect_Specifications (N));

               elsif Present (Discriminant_Specifications (N)) then
                  To_Node := Last (Discriminant_Specifications (N));

               else
                  To_Node := Defining_Identifier (N);
               end if;

            when N_Subexpr =>
               To_Node := N;

            when others =>
               null;
         end case;

         if Present (To_Node) then
            Sloc_Range (To_Node, Dummy, T);
         end if;

         SC.Append ((N, F, T, Typ));
      end Extend_Statement_Sequence;

      -----------------------------
      -- Process_Decisions_Defer --
      -----------------------------

      procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
      begin
         SD.Append ((N, No_List, T, Current_Pragma_Sloc));
      end Process_Decisions_Defer;

      procedure Process_Decisions_Defer (L : List_Id; T : Character) is
      begin
         SD.Append ((Empty, L, T, Current_Pragma_Sloc));
      end Process_Decisions_Defer;

      -------------------------
      -- Set_Statement_Entry --
      -------------------------

      procedure Set_Statement_Entry is
         SC_Last : constant Int := SC.Last;
         SD_Last : constant Int := SD.Last;

      begin
         --  Output statement entries from saved entries in SC table

         for J in SC_First .. SC_Last loop
            if J = SC_First then

               if Current_Dominant /= No_Dominant then
                  declare
                     From : Source_Ptr;
                     To   : Source_Ptr;

                  begin
                     Sloc_Range (Current_Dominant.N, From, To);

                     if Current_Dominant.K /= 'E' then
                        To := No_Location;
                     end if;

                     Set_Raw_Table_Entry
                       (C1                 => '>',
                        C2                 => Current_Dominant.K,
                        From               => From,
                        To                 => To,
                        Last               => False,
                        Pragma_Sloc        => No_Location,
                        Pragma_Aspect_Name => No_Name);
                  end;
               end if;
            end if;

            declare
               SCE                : SC_Entry renames SC.Table (J);
               Pragma_Sloc        : Source_Ptr := No_Location;
               Pragma_Aspect_Name : Name_Id    := No_Name;

            begin
               --  For the case of a statement SCO for a pragma controlled by
               --  Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
               --  those of any nested decision) is emitted only if the pragma
               --  is enabled.

               if SCE.Typ = 'p' then
                  Pragma_Sloc := SCE.From;
                  SCO_Raw_Hash_Table.Set
                    (Pragma_Sloc, SCO_Raw_Table.Last + 1);
                  Pragma_Aspect_Name := Pragma_Name_Unmapped (SCE.N);
                  pragma Assert (Pragma_Aspect_Name /= No_Name);

               elsif SCE.Typ = 'P' then
                  Pragma_Aspect_Name := Pragma_Name_Unmapped (SCE.N);
                  pragma Assert (Pragma_Aspect_Name /= No_Name);
               end if;

               Set_Raw_Table_Entry
                 (C1                 => 'S',
                  C2                 => SCE.Typ,
                  From               => SCE.From,
                  To                 => SCE.To,
                  Last               => (J = SC_Last),
                  Pragma_Sloc        => Pragma_Sloc,
                  Pragma_Aspect_Name => Pragma_Aspect_Name);
            end;
         end loop;

         --  Last statement of basic block, if present, becomes new current
         --  dominant.

         if SC_Last >= SC_First then
            Current_Dominant := ('S', SC.Table (SC_Last).N);
         end if;

         --  Clear out used section of SC table

         SC.Set_Last (SC_First - 1);

         --  Output any embedded decisions

         for J in SD_First .. SD_Last loop
            declare
               SDE : SD_Entry renames SD.Table (J);

            begin
               if Present (SDE.Nod) then
                  Process_Decisions (SDE.Nod, SDE.Typ, SDE.Plo);
               else
                  Process_Decisions (SDE.Lst, SDE.Typ, SDE.Plo);
               end if;
            end;
         end loop;

         --  Clear out used section of SD table

         SD.Set_Last (SD_First - 1);
      end Set_Statement_Entry;

      ----------------------
      -- Traverse_Aspects --
      ----------------------

      procedure Traverse_Aspects (N : Node_Id) is
         AE : Node_Id;
         AN : Node_Id;
         C1 : Character;

      begin
         AN := First (Aspect_Specifications (N));
         while Present (AN) loop
            AE := Expression (AN);

            --  SCOs are generated before semantic analysis/expansion:
            --  PPCs are not split yet.

            pragma Assert (not Split_PPC (AN));

            C1 := ASCII.NUL;

            case Get_Aspect_Id (AN) is

               --  Aspects rewritten into pragmas controlled by a Check_Policy:
               --  Current_Pragma_Sloc must be set to the sloc of the aspect
               --  specification. The corresponding pragma will have the same
               --  sloc. Note that Invariant, Pre, and Post will be enabled if
               --  the policy is Check; on the other hand, predicate aspects
               --  will be enabled for Check and Ignore (when Add_Predicate
               --  is called) because the actual checks occur in client units.
               --  When the assertion policy for Predicate is Disable, the
               --  SCO remains disabled, because Add_Predicate is never called.

               --  Pre/post can have checks in client units too because of
               --  inheritance, so should they receive the same treatment???

               when Aspect_Dynamic_Predicate
                  | Aspect_Invariant
                  | Aspect_Post
                  | Aspect_Postcondition
                  | Aspect_Pre
                  | Aspect_Precondition
                  | Aspect_Predicate
                  | Aspect_Static_Predicate
                  | Aspect_Type_Invariant
               =>
                  C1 := 'a';

               --  Other aspects: just process any decision nested in the
               --  aspect expression.

               when others =>
                  if Has_Decision (AE) then
                     C1 := 'X';
                  end if;
            end case;

            if C1 /= ASCII.NUL then
               pragma Assert (Current_Pragma_Sloc = No_Location);

               if C1 = 'a' or else C1 = 'A' then
                  Current_Pragma_Sloc := Sloc (AN);
               end if;

               Process_Decisions_Defer (AE, C1);

               Current_Pragma_Sloc := No_Location;
            end if;

            Next (AN);
         end loop;
      end Traverse_Aspects;

      ------------------------------------
      -- Traverse_Degenerate_Subprogram --
      ------------------------------------

      procedure Traverse_Degenerate_Subprogram (N : Node_Id) is
      begin
         --  Complete current sequence of statements

         Set_Statement_Entry;

         declare
            Saved_Dominant : constant Dominant_Info := Current_Dominant;
            --  Save last statement in current sequence as dominant

         begin
            --  Output statement SCO for degenerate subprogram body (null
            --  statement or freestanding expression) outside of the dominance
            --  chain.

            Current_Dominant := No_Dominant;
            Extend_Statement_Sequence (N, Typ => ' ');

            --  For the case of an expression-function, collect decisions
            --  embedded in the expression now.

            if Nkind (N) in N_Subexpr then
               Process_Decisions_Defer (N, 'X');
            end if;

            Set_Statement_Entry;

            --  Restore current dominant information designating last statement
            --  in previous sequence (i.e. make the dominance chain skip over
            --  the degenerate body).

            Current_Dominant := Saved_Dominant;
         end;
      end Traverse_Degenerate_Subprogram;

      ------------------
      -- Traverse_One --
      ------------------

      procedure Traverse_One (N : Node_Id) is
      begin
         --  Initialize or extend current statement sequence. Note that for
         --  special cases such as IF and Case statements we will modify
         --  the range to exclude internal statements that should not be
         --  counted as part of the current statement sequence.

         case Nkind (N) is

            --  Package declaration

            when N_Package_Declaration =>
               Set_Statement_Entry;
               Traverse_Package_Declaration (N, Current_Dominant);

            --  Generic package declaration

            when N_Generic_Package_Declaration =>
               Set_Statement_Entry;
               Traverse_Generic_Package_Declaration (N);

            --  Package body

            when N_Package_Body =>
               Set_Statement_Entry;
               Traverse_Package_Body (N);

            --  Subprogram declaration or subprogram body stub

            when N_Expression_Function
               | N_Subprogram_Body_Stub
               | N_Subprogram_Declaration
            =>
               declare
                  Spec : constant Node_Id := Specification (N);
               begin
                  Process_Decisions_Defer
                    (Parameter_Specifications (Spec), 'X');

                  --  Case of a null procedure: generate SCO for fictitious
                  --  NULL statement located at the NULL keyword in the
                  --  procedure specification.

                  if Nkind (N) = N_Subprogram_Declaration
                    and then Nkind (Spec) = N_Procedure_Specification
                    and then Null_Present (Spec)
                  then
                     Traverse_Degenerate_Subprogram (Null_Statement (Spec));

                  --  Case of an expression function: generate a statement SCO
                  --  for the expression (and then decision SCOs for any nested
                  --  decisions).

                  elsif Nkind (N) = N_Expression_Function then
                     Traverse_Degenerate_Subprogram (Expression (N));
                  end if;
               end;

            --  Entry declaration

            when N_Entry_Declaration =>
               Process_Decisions_Defer (Parameter_Specifications (N), 'X');

            --  Generic subprogram declaration

            when N_Generic_Subprogram_Declaration =>
               Process_Decisions_Defer
                 (Generic_Formal_Declarations (N), 'X');
               Process_Decisions_Defer
                 (Parameter_Specifications (Specification (N)), 'X');

            --  Task or subprogram body

            when N_Subprogram_Body
               | N_Task_Body
            =>
               Set_Statement_Entry;
               Traverse_Subprogram_Or_Task_Body (N);

            --  Entry body

            when N_Entry_Body =>
               declare
                  Cond : constant Node_Id :=
                           Condition (Entry_Body_Formal_Part (N));

                  Inner_Dominant : Dominant_Info := No_Dominant;

               begin
                  Set_Statement_Entry;

                  if Present (Cond) then
                     Process_Decisions_Defer (Cond, 'G');

                     --  For an entry body with a barrier, the entry body
                     --  is dominanted by a True evaluation of the barrier.

                     Inner_Dominant := ('T', N);
                  end if;

                  Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
               end;

            --  Protected body

            when N_Protected_Body =>
               Set_Statement_Entry;
               Traverse_Declarations_Or_Statements (Declarations (N));

            --  Exit statement, which is an exit statement in the SCO sense,
            --  so it is included in the current statement sequence, but
            --  then it terminates this sequence. We also have to process
            --  any decisions in the exit statement expression.

            when N_Exit_Statement =>
               Extend_Statement_Sequence (N, 'E');
               Process_Decisions_Defer (Condition (N), 'E');
               Set_Statement_Entry;

               --  If condition is present, then following statement is
               --  only executed if the condition evaluates to False.

               if Present (Condition (N)) then
                  Current_Dominant := ('F', N);
               else
                  Current_Dominant := No_Dominant;
               end if;

            --  Label, which breaks the current statement sequence, but the
            --  label itself is not included in the next statement sequence,
            --  since it generates no code.

            when N_Label =>
               Set_Statement_Entry;
               Current_Dominant := No_Dominant;

            --  Block statement, which breaks the current statement sequence

            when N_Block_Statement =>
               Set_Statement_Entry;

               --  The first statement in the handled sequence of statements
               --  is dominated by the elaboration of the last declaration.

               Current_Dominant := Traverse_Declarations_Or_Statements
                                     (L => Declarations (N),
                                      D => Current_Dominant);

               Traverse_Handled_Statement_Sequence
                 (N => Handled_Statement_Sequence (N),
                  D => Current_Dominant);

            --  If statement, which breaks the current statement sequence,
            --  but we include the condition in the current sequence.

            when N_If_Statement =>
               Current_Test := N;
               Extend_Statement_Sequence (N, 'I');
               Process_Decisions_Defer (Condition (N), 'I');
               Set_Statement_Entry;

               --  Now we traverse the statements in the THEN part

               Traverse_Declarations_Or_Statements
                 (L => Then_Statements (N),
                  D => ('T', N));

               --  Loop through ELSIF parts if present

               if Present (Elsif_Parts (N)) then
                  declare
                     Saved_Dominant : constant Dominant_Info :=
                                        Current_Dominant;

                     Elif : Node_Id := First (Elsif_Parts (N));

                  begin
                     while Present (Elif) loop

                        --  An Elsif is executed only if the previous test
                        --  got a FALSE outcome.

                        Current_Dominant := ('F', Current_Test);

                        --  Now update current test information

                        Current_Test := Elif;

                        --  We generate a statement sequence for the
                        --  construct "ELSIF condition", so that we have
                        --  a statement for the resulting decisions.

                        Extend_Statement_Sequence (Elif, 'I');
                        Process_Decisions_Defer (Condition (Elif), 'I');
                        Set_Statement_Entry;

                        --  An ELSIF part is never guaranteed to have
                        --  been executed, following statements are only
                        --  dominated by the initial IF statement.

                        Current_Dominant := Saved_Dominant;

                        --  Traverse the statements in the ELSIF

                        Traverse_Declarations_Or_Statements
                          (L => Then_Statements (Elif),
                           D => ('T', Elif));
                        Next (Elif);
                     end loop;
                  end;
               end if;

               --  Finally traverse the ELSE statements if present

               Traverse_Declarations_Or_Statements
                 (L => Else_Statements (N),
                  D => ('F', Current_Test));

            --  CASE statement, which breaks the current statement sequence,
            --  but we include the expression in the current sequence.

            when N_Case_Statement =>
               Extend_Statement_Sequence (N, 'C');
               Process_Decisions_Defer (Expression (N), 'X');
               Set_Statement_Entry;

               --  Process case branches, all of which are dominated by the
               --  CASE statement.

               declare
                  Alt : Node_Id;
               begin
                  Alt := First_Non_Pragma (Alternatives (N));
                  while Present (Alt) loop
                     Traverse_Declarations_Or_Statements
                       (L => Statements (Alt),
                        D => Current_Dominant);
                     Next (Alt);
                  end loop;
               end;

            --  ACCEPT statement

            when N_Accept_Statement =>
               Extend_Statement_Sequence (N, 'A');
               Set_Statement_Entry;

               --  Process sequence of statements, dominant is the ACCEPT
               --  statement.

               Traverse_Handled_Statement_Sequence
                 (N => Handled_Statement_Sequence (N),
                  D => Current_Dominant);

            --  SELECT

            when N_Selective_Accept =>
               Extend_Statement_Sequence (N, 'S');
               Set_Statement_Entry;

               --  Process alternatives

               declare
                  Alt   : Node_Id;
                  Guard : Node_Id;
                  S_Dom : Dominant_Info;

               begin
                  Alt := First (Select_Alternatives (N));
                  while Present (Alt) loop
                     S_Dom := Current_Dominant;
                     Guard := Condition (Alt);

                     if Present (Guard) then
                        Process_Decisions
                          (Guard,
                           'G',
                           Pragma_Sloc => No_Location);
                        Current_Dominant := ('T', Guard);
                     end if;

                     Traverse_One (Alt);

                     Current_Dominant := S_Dom;
                     Next (Alt);
                  end loop;
               end;

               Traverse_Declarations_Or_Statements
                 (L => Else_Statements (N),
                  D => Current_Dominant);

            when N_Conditional_Entry_Call
               | N_Timed_Entry_Call
            =>
               Extend_Statement_Sequence (N, 'S');
               Set_Statement_Entry;

               --  Process alternatives

               Traverse_One (Entry_Call_Alternative (N));

               if Nkind (N) = N_Timed_Entry_Call then
                  Traverse_One (Delay_Alternative (N));
               else
                  Traverse_Declarations_Or_Statements
                    (L => Else_Statements (N),
                     D => Current_Dominant);
               end if;

            when N_Asynchronous_Select =>
               Extend_Statement_Sequence (N, 'S');
               Set_Statement_Entry;

               Traverse_One (Triggering_Alternative (N));
               Traverse_Declarations_Or_Statements
                 (L => Statements (Abortable_Part (N)),
                  D => Current_Dominant);

            when N_Accept_Alternative =>
               Traverse_Declarations_Or_Statements
                 (L => Statements (N),
                  D => Current_Dominant,
                  P => Accept_Statement (N));

            when N_Entry_Call_Alternative =>
               Traverse_Declarations_Or_Statements
                 (L => Statements (N),
                  D => Current_Dominant,
                  P => Entry_Call_Statement (N));

            when N_Delay_Alternative =>
               Traverse_Declarations_Or_Statements
                 (L => Statements (N),
                  D => Current_Dominant,
                  P => Delay_Statement (N));

            when N_Triggering_Alternative =>
               Traverse_Declarations_Or_Statements
                 (L => Statements (N),
                  D => Current_Dominant,
                  P => Triggering_Statement (N));

            when N_Terminate_Alternative =>

               --  It is dubious to emit a statement SCO for a TERMINATE
               --  alternative, since no code is actually executed if the
               --  alternative is selected -- the tasking runtime call just
               --  never returns???

               Extend_Statement_Sequence (N, ' ');
               Set_Statement_Entry;

            --  Unconditional exit points, which are included in the current
            --  statement sequence, but then terminate it

            when N_Goto_Statement
               | N_Raise_Statement
               | N_Requeue_Statement
            =>
               Extend_Statement_Sequence (N, ' ');
               Set_Statement_Entry;
               Current_Dominant := No_Dominant;

            --  Simple return statement. which is an exit point, but we
            --  have to process the return expression for decisions.

            when N_Simple_Return_Statement =>
               Extend_Statement_Sequence (N, ' ');
               Process_Decisions_Defer (Expression (N), 'X');
               Set_Statement_Entry;
               Current_Dominant := No_Dominant;

            --  Extended return statement

            when N_Extended_Return_Statement =>
               Extend_Statement_Sequence (N, 'R');
               Process_Decisions_Defer (Return_Object_Declarations (N), 'X');
               Set_Statement_Entry;

               Traverse_Handled_Statement_Sequence
                 (N => Handled_Statement_Sequence (N),
                  D => Current_Dominant);

               Current_Dominant := No_Dominant;

            --  Loop ends the current statement sequence, but we include
            --  the iteration scheme if present in the current sequence.
            --  But the body of the loop starts a new sequence, since it
            --  may not be executed as part of the current sequence.

            when N_Loop_Statement =>
               declare
                  ISC            : constant Node_Id := Iteration_Scheme (N);
                  Inner_Dominant : Dominant_Info    := No_Dominant;

               begin
                  if Present (ISC) then

                     --  If iteration scheme present, extend the current
                     --  statement sequence to include the iteration scheme
                     --  and process any decisions it contains.

                     --  While loop

                     if Present (Condition (ISC)) then
                        Extend_Statement_Sequence (N, 'W');
                        Process_Decisions_Defer (Condition (ISC), 'W');

                        --  Set more specific dominant for inner statements
                        --  (the control sloc for the decision is that of
                        --  the WHILE token).

                        Inner_Dominant := ('T', ISC);

                     --  For loop

                     else
                        Extend_Statement_Sequence (N, 'F');
                        Process_Decisions_Defer
                          (Loop_Parameter_Specification (ISC), 'X');
                     end if;
                  end if;

                  Set_Statement_Entry;

                  if Inner_Dominant = No_Dominant then
                     Inner_Dominant := Current_Dominant;
                  end if;

                  Traverse_Declarations_Or_Statements
                    (L => Statements (N),
                     D => Inner_Dominant);
               end;

            --  Pragma

            when N_Pragma =>

               --  Record sloc of pragma (pragmas don't nest)

               pragma Assert (Current_Pragma_Sloc = No_Location);
               Current_Pragma_Sloc := Sloc (N);

               --  Processing depends on the kind of pragma

               declare
                  Nam : constant Name_Id := Pragma_Name_Unmapped (N);
                  Arg : Node_Id          :=
                          First (Pragma_Argument_Associations (N));
                  Typ : Character;

               begin
                  case Nam is
                     when Name_Assert
                        | Name_Assert_And_Cut
                        | Name_Assume
                        | Name_Check
                        | Name_Loop_Invariant
                        | Name_Postcondition
                        | Name_Precondition
                     =>
                        --  For Assert/Check/Precondition/Postcondition, we
                        --  must generate a P entry for the decision. Note
                        --  that this is done unconditionally at this stage.
                        --  Output for disabled pragmas is suppressed later
                        --  on when we output the decision line in Put_SCOs,
                        --  depending on setting by Set_SCO_Pragma_Enabled.

                        if Nam = Name_Check then
                           Next (Arg);
                        end if;

                        Process_Decisions_Defer (Expression (Arg), 'P');
                        Typ := 'p';

                        --  Pre/postconditions can be inherited so SCO should
                        --  never be deactivated???

                     when Name_Debug =>
                        if Present (Arg) and then Present (Next (Arg)) then

                           --  Case of a dyadic pragma Debug: first argument
                           --  is a P decision, any nested decision in the
                           --  second argument is an X decision.

                           Process_Decisions_Defer (Expression (Arg), 'P');
                           Next (Arg);
                        end if;

                        Process_Decisions_Defer (Expression (Arg), 'X');
                        Typ := 'p';

                     --  For all other pragmas, we generate decision entries
                     --  for any embedded expressions, and the pragma is
                     --  never disabled.

                     --  Should generate P decisions (not X) for assertion
                     --  related pragmas: [Type_]Invariant,
                     --  [{Static,Dynamic}_]Predicate???

                     when others =>
                        Process_Decisions_Defer (N, 'X');
                        Typ := 'P';
                  end case;

                  --  Add statement SCO

                  Extend_Statement_Sequence (N, Typ);

                  Current_Pragma_Sloc := No_Location;
               end;

            --  Object declaration. Ignored if Prev_Ids is set, since the
            --  parser generates multiple instances of the whole declaration
            --  if there is more than one identifier declared, and we only
            --  want one entry in the SCOs, so we take the first, for which
            --  Prev_Ids is False.

            when N_Number_Declaration
               | N_Object_Declaration
            =>
               if not Prev_Ids (N) then
                  Extend_Statement_Sequence (N, 'o');

                  if Has_Decision (N) then
                     Process_Decisions_Defer (N, 'X');
                  end if;
               end if;

            --  All other cases, which extend the current statement sequence
            --  but do not terminate it, even if they have nested decisions.

            when N_Protected_Type_Declaration
               | N_Task_Type_Declaration
            =>
               Extend_Statement_Sequence (N, 't');
               Process_Decisions_Defer (Discriminant_Specifications (N), 'X');
               Set_Statement_Entry;

               Traverse_Sync_Definition (N);

            when N_Single_Protected_Declaration
               | N_Single_Task_Declaration
            =>
               Extend_Statement_Sequence (N, 'o');
               Set_Statement_Entry;

               Traverse_Sync_Definition (N);

            when others =>

               --  Determine required type character code, or ASCII.NUL if
               --  no SCO should be generated for this node.

               declare
                  NK  : constant Node_Kind := Nkind (N);
                  Typ : Character;

               begin
                  case NK is
                     when N_Full_Type_Declaration
                        | N_Incomplete_Type_Declaration
                        | N_Private_Extension_Declaration
                        | N_Private_Type_Declaration
                     =>
                        Typ := 't';

                     when N_Subtype_Declaration =>
                        Typ := 's';

                     when N_Renaming_Declaration =>
                        Typ := 'r';

                     when N_Generic_Instantiation =>
                        Typ := 'i';

                     when N_Package_Body_Stub
                        | N_Protected_Body_Stub
                        | N_Representation_Clause
                        | N_Task_Body_Stub
                        | N_Use_Package_Clause
                        | N_Use_Type_Clause
                     =>
                        Typ := ASCII.NUL;

                     when N_Procedure_Call_Statement =>
                        Typ := ' ';

                     when others =>
                        if NK in N_Statement_Other_Than_Procedure_Call then
                           Typ := ' ';
                        else
                           Typ := 'd';
                        end if;
                  end case;

                  if Typ /= ASCII.NUL then
                     Extend_Statement_Sequence (N, Typ);
                  end if;
               end;

               --  Process any embedded decisions

               if Has_Decision (N) then
                  Process_Decisions_Defer (N, 'X');
               end if;
         end case;

         --  Process aspects if present

         Traverse_Aspects (N);
      end Traverse_One;

   --  Start of processing for Traverse_Declarations_Or_Statements

   begin
      --  Process single prefixed node

      if Present (P) then
         Traverse_One (P);
      end if;

      --  Loop through statements or declarations

      if Is_Non_Empty_List (L) then
         N := First (L);
         while Present (N) loop

            --  Note: For separate bodies, we see the tree after Par.Labl has
            --  introduced implicit labels, so we need to ignore those nodes.

            if Nkind (N) /= N_Implicit_Label_Declaration then
               Traverse_One (N);
            end if;

            Next (N);
         end loop;

      end if;

      --  End sequence of statements and flush deferred decisions

      if Present (P) or else Is_Non_Empty_List (L) then
         Set_Statement_Entry;
      end if;

      return Current_Dominant;
   end Traverse_Declarations_Or_Statements;

   ------------------------------------------
   -- Traverse_Generic_Package_Declaration --
   ------------------------------------------

   procedure Traverse_Generic_Package_Declaration (N : Node_Id) is
   begin
      Process_Decisions (Generic_Formal_Declarations (N), 'X', No_Location);
      Traverse_Package_Declaration (N);
   end Traverse_Generic_Package_Declaration;

   -----------------------------------------
   -- Traverse_Handled_Statement_Sequence --
   -----------------------------------------

   procedure Traverse_Handled_Statement_Sequence
     (N : Node_Id;
      D : Dominant_Info := No_Dominant)
   is
      Handler : Node_Id;

   begin
      --  For package bodies without a statement part, the parser adds an empty
      --  one, to normalize the representation. The null statement therein,
      --  which does not come from source, does not get a SCO.

      if Present (N) and then Comes_From_Source (N) then
         Traverse_Declarations_Or_Statements (Statements (N), D);

         if Present (Exception_Handlers (N)) then
            Handler := First_Non_Pragma (Exception_Handlers (N));
            while Present (Handler) loop
               Traverse_Declarations_Or_Statements
                 (L => Statements (Handler),
                  D => ('E', Handler));
               Next (Handler);
            end loop;
         end if;
      end if;
   end Traverse_Handled_Statement_Sequence;

   ---------------------------
   -- Traverse_Package_Body --
   ---------------------------

   procedure Traverse_Package_Body (N : Node_Id) is
      Dom : Dominant_Info;
   begin
      --  The first statement in the handled sequence of statements is
      --  dominated by the elaboration of the last declaration.

      Dom := Traverse_Declarations_Or_Statements (Declarations (N));

      Traverse_Handled_Statement_Sequence
        (Handled_Statement_Sequence (N), Dom);
   end Traverse_Package_Body;

   ----------------------------------
   -- Traverse_Package_Declaration --
   ----------------------------------

   procedure Traverse_Package_Declaration
     (N : Node_Id;
      D : Dominant_Info := No_Dominant)
   is
      Spec : constant Node_Id := Specification (N);
      Dom  : Dominant_Info;

   begin
      Dom :=
        Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);

      --  First private declaration is dominated by last visible declaration

      Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
   end Traverse_Package_Declaration;

   ------------------------------
   -- Traverse_Sync_Definition --
   ------------------------------

   procedure Traverse_Sync_Definition (N : Node_Id) is
      Dom_Info : Dominant_Info := ('S', N);
      --  The first declaration is dominated by the protected or task [type]
      --  declaration.

      Sync_Def : Node_Id;
      --  N's protected or task definition

      Priv_Decl : List_Id;
      Vis_Decl  : List_Id;
      --  Sync_Def's Visible_Declarations and Private_Declarations

   begin
      case Nkind (N) is
         when N_Protected_Type_Declaration
            | N_Single_Protected_Declaration
         =>
            Sync_Def := Protected_Definition (N);

         when N_Single_Task_Declaration
            | N_Task_Type_Declaration
         =>
            Sync_Def := Task_Definition (N);

         when others =>
            raise Program_Error;
      end case;

      --  Sync_Def may be Empty at least for empty Task_Type_Declarations.
      --  Querying Visible or Private_Declarations is invalid in this case.

      if Present (Sync_Def) then
         Vis_Decl  := Visible_Declarations (Sync_Def);
         Priv_Decl := Private_Declarations (Sync_Def);
      else
         Vis_Decl  := No_List;
         Priv_Decl := No_List;
      end if;

      Dom_Info := Traverse_Declarations_Or_Statements
                    (L => Vis_Decl,
                     D => Dom_Info);

      --  If visible declarations are present, the first private declaration
      --  is dominated by the last visible declaration.

      Traverse_Declarations_Or_Statements
        (L => Priv_Decl,
         D => Dom_Info);
   end Traverse_Sync_Definition;

   --------------------------------------
   -- Traverse_Subprogram_Or_Task_Body --
   --------------------------------------

   procedure Traverse_Subprogram_Or_Task_Body
     (N : Node_Id;
      D : Dominant_Info := No_Dominant)
   is
      Decls    : constant List_Id := Declarations (N);
      Dom_Info : Dominant_Info    := D;

   begin
      --  If declarations are present, the first statement is dominated by the
      --  last declaration.

      Dom_Info := Traverse_Declarations_Or_Statements
                    (L => Decls, D => Dom_Info);

      Traverse_Handled_Statement_Sequence
        (N => Handled_Statement_Sequence (N),
         D => Dom_Info);
   end Traverse_Subprogram_Or_Task_Body;

   -------------------------
   -- SCO_Record_Filtered --
   -------------------------

   procedure SCO_Record_Filtered is
      type Decision is record
         Kind : Character;
         --  Type of the SCO decision (see comments for SCO_Table_Entry.C1)

         Sloc : Source_Location;

         Top  : Nat;
         --  Index in the SCO_Raw_Table for the root operator/condition for the
         --  expression that controls the decision.
      end record;
      --  Decision descriptor: used to gather information about a candidate
      --  SCO decision.

      package Pending_Decisions is new Table.Table
        (Table_Component_Type => Decision,
         Table_Index_Type     => Nat,
         Table_Low_Bound      => 1,
         Table_Initial        => 1000,
         Table_Increment      => 200,
         Table_Name           => "Filter_Pending_Decisions");
      --  Table used to hold decisions to process during the collection pass

      procedure Add_Expression_Tree (Idx : in out Nat);
      --  Add SCO raw table entries for the decision controlling expression
      --  tree starting at Idx to the filtered SCO table.

      procedure Collect_Decisions
        (D    : Decision;
         Next : out Nat);
      --  Collect decisions to add to the filtered SCO table starting at the
      --  D decision (including it and its nested operators/conditions). Set
      --  Next to the first node index passed the whole decision.

      procedure Compute_Range
        (Idx  : in out Nat;
         From : out Source_Location;
         To   : out Source_Location);
      --  Compute the source location range for the expression tree starting at
      --  Idx in the SCO raw table. Store its bounds in From and To.

      function Is_Decision (Idx : Nat) return Boolean;
      --  Return if the expression tree starting at Idx has adjacent nested
      --  nodes that make a decision.

      procedure Process_Pending_Decisions
        (Original_Decision : SCO_Table_Entry);
      --  Complete the filtered SCO table using collected decisions. Output
      --  decisions inherit the pragma information from the original decision.

      procedure Search_Nested_Decisions (Idx : in out Nat);
      --  Collect decisions to add to the filtered SCO table starting at the
      --  node at Idx in the SCO raw table. This node must not be part of an
      --  already-processed decision. Set Idx to the first node index passed
      --  the whole expression tree.

      procedure Skip_Decision
        (Idx                      : in out Nat;
         Process_Nested_Decisions : Boolean);
      --  Skip all the nodes that belong to the decision starting at Idx. If
      --  Process_Nested_Decision, call Search_Nested_Decisions on the first
      --  nested nodes that do not belong to the decision. Set Idx to the first
      --  node index passed the whole expression tree.

      -------------------------
      -- Add_Expression_Tree --
      -------------------------

      procedure Add_Expression_Tree (Idx : in out Nat) is
         Node_Idx : constant Nat := Idx;
         T        : SCO_Table_Entry renames SCO_Raw_Table.Table (Node_Idx);
         From     : Source_Location;
         To       : Source_Location;

      begin
         case T.C1 is
            when ' ' =>

               --  This is a single condition. Add an entry for it and move on

               SCO_Table.Append (T);
               Idx := Idx + 1;

            when '!' =>

               --  This is a NOT operator: add an entry for it and browse its
               --  only child.

               SCO_Table.Append (T);
               Idx := Idx + 1;
               Add_Expression_Tree (Idx);

            when others =>

               --  This must be an AND/OR/AND THEN/OR ELSE operator

               if T.C2 = '?' then

                  --  This is not a short circuit operator: consider this one
                  --  and all its children as a single condition.

                  Compute_Range (Idx, From, To);
                  SCO_Table.Append
                    ((From               => From,
                      To                 => To,
                      C1                 => ' ',
                      C2                 => 'c',
                      Last               => False,
                      Pragma_Sloc        => No_Location,
                      Pragma_Aspect_Name => No_Name));

               else
                  --  This is a real short circuit operator: add an entry for
                  --  it and browse its children.

                  SCO_Table.Append (T);
                  Idx := Idx + 1;
                  Add_Expression_Tree (Idx);
                  Add_Expression_Tree (Idx);
               end if;
         end case;
      end Add_Expression_Tree;

      -----------------------
      -- Collect_Decisions --
      -----------------------

      procedure Collect_Decisions
        (D    : Decision;
         Next : out Nat)
      is
         Idx : Nat := D.Top;

      begin
         if D.Kind /= 'X' or else Is_Decision (D.Top) then
            Pending_Decisions.Append (D);
         end if;

         Skip_Decision (Idx, True);
         Next := Idx;
      end Collect_Decisions;

      -------------------
      -- Compute_Range --
      -------------------

      procedure Compute_Range
        (Idx  : in out Nat;
         From : out Source_Location;
         To   : out Source_Location)
      is
         Sloc_F : Source_Location := No_Source_Location;
         Sloc_T : Source_Location := No_Source_Location;

         procedure Process_One;
         --  Process one node of the tree, and recurse over children. Update
         --  Idx during the traversal.

         -----------------
         -- Process_One --
         -----------------

         procedure Process_One is
         begin
            if Sloc_F = No_Source_Location
                 or else
               SCO_Raw_Table.Table (Idx).From < Sloc_F
            then
               Sloc_F := SCO_Raw_Table.Table (Idx).From;
            end if;

            if Sloc_T = No_Source_Location
                 or else
               Sloc_T < SCO_Raw_Table.Table (Idx).To
            then
               Sloc_T := SCO_Raw_Table.Table (Idx).To;
            end if;

            if SCO_Raw_Table.Table (Idx).C1 = ' ' then

               --  This is a condition: nothing special to do

               Idx := Idx + 1;

            elsif SCO_Raw_Table.Table (Idx).C1 = '!' then

               --  The "not" operator has only one operand

               Idx := Idx + 1;
               Process_One;

            else
               --  This is an AND THEN or OR ELSE logical operator: follow the
               --  left, then the right operands.

               Idx := Idx + 1;

               Process_One;
               Process_One;
            end if;
         end Process_One;

      --  Start of processing for Compute_Range

      begin
         Process_One;
         From := Sloc_F;
         To   := Sloc_T;
      end Compute_Range;

      -----------------
      -- Is_Decision --
      -----------------

      function Is_Decision (Idx : Nat) return Boolean is
         Index : Nat := Idx;

      begin
         loop
            declare
               T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);

            begin
               case T.C1 is
                  when ' ' =>
                     return False;

                  when '!' =>

                     --  This is a decision iff the only operand of the NOT
                     --  operator could be a standalone decision.

                     Index := Idx + 1;

                  when others =>

                     --  This node is a logical operator (and thus could be a
                     --  standalone decision) iff it is a short circuit
                     --  operator.

                     return T.C2 /= '?';
               end case;
            end;
         end loop;
      end Is_Decision;

      -------------------------------
      -- Process_Pending_Decisions --
      -------------------------------

      procedure Process_Pending_Decisions
        (Original_Decision : SCO_Table_Entry)
      is
      begin
         for Index in 1 .. Pending_Decisions.Last loop
            declare
               D   : Decision renames Pending_Decisions.Table (Index);
               Idx : Nat := D.Top;

            begin
               --  Add a SCO table entry for the decision itself

               pragma Assert (D.Kind /= ' ');

               SCO_Table.Append
                 ((To                 => No_Source_Location,
                   From               => D.Sloc,
                   C1                 => D.Kind,
                   C2                 => ' ',
                   Last               => False,
                   Pragma_Sloc        => Original_Decision.Pragma_Sloc,
                   Pragma_Aspect_Name =>
                      Original_Decision.Pragma_Aspect_Name));

               --  Then add ones for its nested operators/operands. Do not
               --  forget to tag its *last* entry as such.

               Add_Expression_Tree (Idx);
               SCO_Table.Table (SCO_Table.Last).Last := True;
            end;
         end loop;

         --  Clear the pending decisions list
         Pending_Decisions.Set_Last (0);
      end Process_Pending_Decisions;

      -----------------------------
      -- Search_Nested_Decisions --
      -----------------------------

      procedure Search_Nested_Decisions (Idx : in out Nat) is
      begin
         loop
            declare
               T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);

            begin
               case T.C1 is
                  when ' ' =>
                     Idx := Idx + 1;
                     exit;

                  when '!' =>
                     Collect_Decisions
                       ((Kind => 'X',
                         Sloc => T.From,
                         Top  => Idx),
                        Idx);
                     exit;

                  when others =>
                     if T.C2 = '?' then

                        --  This is not a logical operator: start looking for
                        --  nested decisions from here. Recurse over the left
                        --  child and let the loop take care of the right one.

                        Idx := Idx + 1;
                        Search_Nested_Decisions (Idx);

                     else
                        --  We found a nested decision

                        Collect_Decisions
                          ((Kind => 'X',
                            Sloc => T.From,
                            Top  => Idx),
                            Idx);
                        exit;
                     end if;
               end case;
            end;
         end loop;
      end Search_Nested_Decisions;

      -------------------
      -- Skip_Decision --
      -------------------

      procedure Skip_Decision
        (Idx                      : in out Nat;
         Process_Nested_Decisions : Boolean)
      is
      begin
         loop
            declare
               T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);

            begin
               Idx := Idx + 1;

               case T.C1 is
                  when ' ' =>
                     exit;

                  when '!' =>

                     --  This NOT operator belongs to the outside decision:
                     --  just skip it.

                     null;

                  when others =>
                     if T.C2 = '?' and then Process_Nested_Decisions then

                        --  This is not a logical operator: start looking for
                        --  nested decisions from here. Recurse over the left
                        --  child and let the loop take care of the right one.

                        Search_Nested_Decisions (Idx);

                     else
                        --  This is a logical operator, so it belongs to the
                        --  outside decision: skip its left child, then let the
                        --  loop take care of the right one.

                        Skip_Decision (Idx, Process_Nested_Decisions);
                     end if;
               end case;
            end;
         end loop;
      end Skip_Decision;

   --  Start of processing for SCO_Record_Filtered

   begin
      --  Filtering must happen only once: do nothing if it this pass was
      --  already run.

      if SCO_Generation_State = Filtered then
         return;
      else
         pragma Assert (SCO_Generation_State = Raw);
         SCO_Generation_State := Filtered;
      end if;

      --  Loop through all SCO entries under SCO units

      for Unit_Idx in 1 .. SCO_Unit_Table.Last loop
         declare
            Unit : SCO_Unit_Table_Entry
                     renames SCO_Unit_Table.Table (Unit_Idx);

            Idx : Nat := Unit.From;
            --  Index of the current SCO raw table entry

            New_From : constant Nat := SCO_Table.Last + 1;
            --  After copying SCO enties of interest to the final table, we
            --  will have to change the From/To indexes this unit targets.
            --  This constant keeps track of the new From index.

         begin
            while Idx <= Unit.To loop
               declare
                  T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);

               begin
                  case T.C1 is

                     --  Decision (of any kind, including pragmas and aspects)

                     when 'E' | 'G' | 'I' | 'W' | 'X' | 'P' | 'a' | 'A' =>
                        if SCO_Pragma_Disabled (T.Pragma_Sloc) then

                           --  Skip SCO entries for decisions in disabled
                           --  constructs (pragmas or aspects).

                           Idx := Idx + 1;
                           Skip_Decision (Idx, False);

                        else
                           Collect_Decisions
                             ((Kind => T.C1,
                               Sloc => T.From,
                               Top  => Idx + 1),
                              Idx);
                           Process_Pending_Decisions (T);
                        end if;

                     --  There is no translation/filtering to do for other kind
                     --  of SCO items (statements, dominance markers, etc.).

                     when '|' | '&' | '!' | ' ' =>

                        --  SCO logical operators and conditions cannot exist
                        --  on their own: they must be inside a decision (such
                        --  entries must have been skipped by
                        --  Collect_Decisions).

                        raise Program_Error;

                     when others =>
                        SCO_Table.Append (T);
                        Idx := Idx + 1;
                  end case;
               end;
            end loop;

            --  Now, update the SCO entry indexes in the unit entry

            Unit.From := New_From;
            Unit.To   := SCO_Table.Last;
         end;
      end loop;

      --  Then clear the raw table to free bytes

      SCO_Raw_Table.Free;
   end SCO_Record_Filtered;

end Par_SCO;