1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009-2016, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Aspects; use Aspects;
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Errout; use Errout;
31 with Lib.Util; use Lib.Util;
32 with Namet; use Namet;
33 with Nlists; use Nlists;
35 with Output; use Output;
39 with Sem_Util; use Sem_Util;
40 with Sinfo; use Sinfo;
41 with Sinput; use Sinput;
42 with Snames; use Snames;
45 with GNAT.HTable; use GNAT.HTable;
46 with GNAT.Heap_Sort_G;
49 package body Par_SCO is
51 --------------------------
52 -- First-pass SCO table --
53 --------------------------
55 -- The Short_Circuit_And_Or pragma enables one to use AND and OR operators
56 -- in source code while the ones used with booleans will be interpreted as
57 -- their short circuit alternatives (AND THEN and OR ELSE). Thus, the true
58 -- meaning of these operators is known only after the semantic analysis.
60 -- However, decision SCOs include short circuit operators only. The SCO
61 -- information generation pass must be done before expansion, hence before
62 -- the semantic analysis. Because of this, the SCO information generation
63 -- is done in two passes.
65 -- The first one (SCO_Record_Raw, before semantic analysis) completes the
66 -- SCO_Raw_Table assuming all AND/OR operators are short circuit ones.
67 -- Then, the semantic analysis determines which operators are promoted to
68 -- short circuit ones. Finally, the second pass (SCO_Record_Filtered)
69 -- translates the SCO_Raw_Table to SCO_Table, taking care of removing the
70 -- remaining AND/OR operators and of adjusting decisions accordingly
71 -- (splitting decisions, removing empty ones, etc.).
73 type SCO_Generation_State_Type is (None, Raw, Filtered);
74 SCO_Generation_State : SCO_Generation_State_Type := None;
75 -- Keep track of the SCO generation state: this will prevent us from
76 -- running some steps multiple times (the second pass has to be started
77 -- from multiple places).
79 package SCO_Raw_Table is new GNAT.Table
80 (Table_Component_Type => SCO_Table_Entry,
81 Table_Index_Type => Nat,
84 Table_Increment => 300);
86 -----------------------
87 -- Unit Number Table --
88 -----------------------
90 -- This table parallels the SCO_Unit_Table, keeping track of the unit
91 -- numbers corresponding to the entries made in this table, so that before
92 -- writing out the SCO information to the ALI file, we can fill in the
93 -- proper dependency numbers and file names.
95 -- Note that the zero'th entry is here for convenience in sorting the
96 -- table, the real lower bound is 1.
98 package SCO_Unit_Number_Table is new Table.Table
99 (Table_Component_Type => Unit_Number_Type,
100 Table_Index_Type => SCO_Unit_Index,
101 Table_Low_Bound => 0, -- see note above on sort
103 Table_Increment => 200,
104 Table_Name => "SCO_Unit_Number_Entry");
106 ------------------------------------------
107 -- Condition/Operator/Pragma Hash Table --
108 ------------------------------------------
110 -- We need to be able to get to conditions quickly for handling the calls
111 -- to Set_SCO_Condition efficiently, and similarly to get to pragmas to
112 -- handle calls to Set_SCO_Pragma_Enabled (the same holds for operators and
113 -- Set_SCO_Logical_Operator). For this purpose we identify the conditions,
114 -- operators and pragmas in the table by their starting sloc, and use this
115 -- hash table to map from these sloc values to SCO_Table indexes.
117 type Header_Num is new Integer range 0 .. 996;
118 -- Type for hash table headers
120 function Hash (F : Source_Ptr) return Header_Num;
121 -- Function to Hash source pointer value
123 function Equal (F1 : Source_Ptr; F2 : Source_Ptr) return Boolean;
124 -- Function to test two keys for equality
126 function "<" (S1 : Source_Location; S2 : Source_Location) return Boolean;
127 -- Function to test for source locations order
129 package SCO_Raw_Hash_Table is new Simple_HTable
130 (Header_Num, Int, 0, Source_Ptr, Hash, Equal);
131 -- The actual hash table
133 --------------------------
134 -- Internal Subprograms --
135 --------------------------
137 function Has_Decision (N : Node_Id) return Boolean;
138 -- N is the node for a subexpression. Returns True if the subexpression
139 -- contains a nested decision (i.e. either is a logical operator, or
140 -- contains a logical operator in its subtree).
142 -- This must be used in the first pass (SCO_Record_Raw) only: here AND/OR
143 -- operators are considered as short circuit, just in case the
144 -- Short_Circuit_And_Or pragma is used: only real short circuit operations
145 -- will be kept in the secord pass.
147 type Tristate is (False, True, Unknown);
149 function Is_Logical_Operator (N : Node_Id) return Tristate;
150 -- N is the node for a subexpression. This procedure determines whether N
151 -- is a logical operator: True for short circuit conditions, Unknown for OR
152 -- and AND (the Short_Circuit_And_Or pragma may be used) and False
153 -- otherwise. Note that in cases where True is returned, callers assume
154 -- Nkind (N) in N_Op.
156 function To_Source_Location (S : Source_Ptr) return Source_Location;
157 -- Converts Source_Ptr value to Source_Location (line/col) format
159 procedure Process_Decisions
162 Pragma_Sloc : Source_Ptr);
163 -- If N is Empty, has no effect. Otherwise scans the tree for the node N,
164 -- to output any decisions it contains. T is one of IEGPWX (for context of
165 -- expression: if/exit when/entry guard/pragma/while/expression). If T is
166 -- other than X, the node N is the if expression involved, and a decision
167 -- is always present (at the very least a simple decision is present at the
170 procedure Process_Decisions
173 Pragma_Sloc : Source_Ptr);
174 -- Calls above procedure for each element of the list L
176 procedure Set_Raw_Table_Entry
182 Pragma_Sloc : Source_Ptr := No_Location;
183 Pragma_Aspect_Name : Name_Id := No_Name);
184 -- Append an entry to SCO_Raw_Table with fields set as per arguments
186 type Dominant_Info is record
188 -- F/T/S/E for a valid dominance marker, or ' ' for no dominant
191 -- Node providing the Sloc(s) for the dominance marker
193 No_Dominant : constant Dominant_Info := (' ', Empty);
195 procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr);
196 -- Add one entry from the instance table to the corresponding SCO table
198 procedure Traverse_Declarations_Or_Statements
200 D : Dominant_Info := No_Dominant;
201 P : Node_Id := Empty);
202 -- Process L, a list of statements or declarations dominated by D. If P is
203 -- present, it is processed as though it had been prepended to L.
205 function Traverse_Declarations_Or_Statements
207 D : Dominant_Info := No_Dominant;
208 P : Node_Id := Empty) return Dominant_Info;
209 -- Same as above, and returns dominant information corresponding to the
210 -- last node with SCO in L.
212 -- The following Traverse_* routines perform appropriate calls to
213 -- Traverse_Declarations_Or_Statements to traverse specific node kinds.
214 -- Parameter D, when present, indicates the dominant of the first
215 -- declaration or statement within N.
217 -- Why is Traverse_Sync_Definition commented specificaly and
218 -- the others are not???
220 procedure Traverse_Generic_Package_Declaration (N : Node_Id);
222 procedure Traverse_Handled_Statement_Sequence
224 D : Dominant_Info := No_Dominant);
226 procedure Traverse_Package_Body (N : Node_Id);
228 procedure Traverse_Package_Declaration
230 D : Dominant_Info := No_Dominant);
232 procedure Traverse_Subprogram_Or_Task_Body
234 D : Dominant_Info := No_Dominant);
236 procedure Traverse_Sync_Definition (N : Node_Id);
237 -- Traverse a protected definition or task definition
239 -- Note regarding traversals: In a few cases where an Alternatives list is
240 -- involved, pragmas such as "pragma Page" may show up before the first
241 -- alternative. We skip them because we're out of statement or declaration
242 -- context, so these can't be pragmas of interest for SCO purposes, and
243 -- the regular alternative processing typically involves attribute queries
244 -- which aren't valid for a pragma.
246 procedure Write_SCOs_To_ALI_File is new Put_SCOs;
247 -- Write SCO information to the ALI file using routines in Lib.Util
254 procedure Dump_Entry (Index : Nat; T : SCO_Table_Entry);
255 -- Dump a SCO table entry
261 procedure Dump_Entry (Index : Nat; T : SCO_Table_Entry) is
268 Write_Str (" C1 = '");
274 Write_Str (" C2 = '");
279 if T.From /= No_Source_Location then
280 Write_Str (" From = ");
281 Write_Int (Int (T.From.Line));
283 Write_Int (Int (T.From.Col));
286 if T.To /= No_Source_Location then
287 Write_Str (" To = ");
288 Write_Int (Int (T.To.Line));
290 Write_Int (Int (T.To.Col));
296 Write_Str (" False");
302 -- Start of processing for dsco
305 -- Dump SCO unit table
307 Write_Line ("SCO Unit Table");
308 Write_Line ("--------------");
310 for Index in 1 .. SCO_Unit_Table.Last loop
312 UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
316 Write_Int (Int (Index));
317 Write_Str (" Dep_Num = ");
318 Write_Int (Int (UTE.Dep_Num));
319 Write_Str (" From = ");
320 Write_Int (Int (UTE.From));
321 Write_Str (" To = ");
322 Write_Int (Int (UTE.To));
324 Write_Str (" File_Name = """);
326 if UTE.File_Name /= null then
327 Write_Str (UTE.File_Name.all);
335 -- Dump SCO Unit number table if it contains any entries
337 if SCO_Unit_Number_Table.Last >= 1 then
339 Write_Line ("SCO Unit Number Table");
340 Write_Line ("---------------------");
342 for Index in 1 .. SCO_Unit_Number_Table.Last loop
344 Write_Int (Int (Index));
345 Write_Str (". Unit_Number = ");
346 Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
351 -- Dump SCO raw-table
354 Write_Line ("SCO Raw Table");
355 Write_Line ("---------");
357 if SCO_Generation_State = Filtered then
358 Write_Line ("Empty (free'd after second pass)");
360 for Index in 1 .. SCO_Raw_Table.Last loop
361 Dump_Entry (Index, SCO_Raw_Table.Table (Index));
365 -- Dump SCO table itself
368 Write_Line ("SCO Filtered Table");
369 Write_Line ("---------");
371 for Index in 1 .. SCO_Table.Last loop
372 Dump_Entry (Index, SCO_Table.Table (Index));
380 function Equal (F1 : Source_Ptr; F2 : Source_Ptr) return Boolean is
389 function "<" (S1 : Source_Location; S2 : Source_Location) return Boolean is
391 return S1.Line < S2.Line
392 or else (S1.Line = S2.Line and then S1.Col < S2.Col);
399 function Has_Decision (N : Node_Id) return Boolean is
400 function Check_Node (N : Node_Id) return Traverse_Result;
401 -- Determine if Nkind (N) indicates the presence of a decision (i.e. N
402 -- is a logical operator, which is a decision in itself, or an
403 -- IF-expression whose Condition attribute is a decision).
409 function Check_Node (N : Node_Id) return Traverse_Result is
411 -- If we are not sure this is a logical operator (AND and OR may be
412 -- turned into logical operators with the Short_Circuit_And_Or
413 -- pragma), assume it is. Putative decisions will be discarded if
414 -- needed in the secord pass.
416 if Is_Logical_Operator (N) /= False
417 or else Nkind (N) = N_If_Expression
425 function Traverse is new Traverse_Func (Check_Node);
427 -- Start of processing for Has_Decision
430 return Traverse (N) = Abandon;
437 function Hash (F : Source_Ptr) return Header_Num is
439 return Header_Num (Nat (F) mod 997);
446 procedure Initialize is
448 SCO_Unit_Number_Table.Init;
450 -- The SCO_Unit_Number_Table entry with index 0 is intentionally set
451 -- aside to be used as temporary for sorting.
453 SCO_Unit_Number_Table.Increment_Last;
456 -------------------------
457 -- Is_Logical_Operator --
458 -------------------------
460 function Is_Logical_Operator (N : Node_Id) return Tristate is
462 if Nkind_In (N, N_And_Then, N_Op_Not, N_Or_Else) then
464 elsif Nkind_In (N, N_Op_And, N_Op_Or) then
469 end Is_Logical_Operator;
471 -----------------------
472 -- Process_Decisions --
473 -----------------------
475 -- Version taking a list
477 procedure Process_Decisions
480 Pragma_Sloc : Source_Ptr)
487 while Present (N) loop
488 Process_Decisions (N, T, Pragma_Sloc);
492 end Process_Decisions;
494 -- Version taking a node
496 Current_Pragma_Sloc : Source_Ptr := No_Location;
497 -- While processing a pragma, this is set to the sloc of the N_Pragma node
499 procedure Process_Decisions
502 Pragma_Sloc : Source_Ptr)
505 -- This is used to mark the location of a decision sequence in the SCO
506 -- table. We use it for backing out a simple decision in an expression
507 -- context that contains only NOT operators.
510 -- Likewise for the putative SCO_Raw_Hash_Table entries: see below
512 type Hash_Entry is record
516 -- We must register all conditions/pragmas in SCO_Raw_Hash_Table.
517 -- However we cannot register them in the same time we are adding the
518 -- corresponding SCO entries to the raw table since we may discard them
519 -- later on. So instead we put all putative conditions into Hash_Entries
520 -- (see below) and register them once we are sure we keep them.
522 -- This data structure holds the conditions/pragmas to register in
523 -- SCO_Raw_Hash_Table.
525 package Hash_Entries is new Table.Table
526 (Table_Component_Type => Hash_Entry,
527 Table_Index_Type => Nat,
528 Table_Low_Bound => 1,
530 Table_Increment => 10,
531 Table_Name => "Hash_Entries");
532 -- Hold temporarily (i.e. free'd before returning) the Hash_Entry before
533 -- they are registered in SCO_Raw_Hash_Table.
535 X_Not_Decision : Boolean;
536 -- This flag keeps track of whether a decision sequence in the SCO table
537 -- contains only NOT operators, and is for an expression context (T=X).
538 -- The flag will be set False if T is other than X, or if an operator
539 -- other than NOT is in the sequence.
541 procedure Output_Decision_Operand (N : Node_Id);
542 -- The node N is the top level logical operator of a decision, or it is
543 -- one of the operands of a logical operator belonging to a single
544 -- complex decision. This routine outputs the sequence of table entries
545 -- corresponding to the node. Note that we do not process the sub-
546 -- operands to look for further decisions, that processing is done in
547 -- Process_Decision_Operand, because we can't get decisions mixed up in
548 -- the global table. Call has no effect if N is Empty.
550 procedure Output_Element (N : Node_Id);
551 -- Node N is an operand of a logical operator that is not itself a
552 -- logical operator, or it is a simple decision. This routine outputs
553 -- the table entry for the element, with C1 set to ' '. Last is set
554 -- False, and an entry is made in the condition hash table.
556 procedure Output_Header (T : Character);
557 -- Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
558 -- PRAGMA, and 'X' for the expression case.
560 procedure Process_Decision_Operand (N : Node_Id);
561 -- This is called on node N, the top level node of a decision, or on one
562 -- of its operands or suboperands after generating the full output for
563 -- the complex decision. It process the suboperands of the decision
564 -- looking for nested decisions.
566 function Process_Node (N : Node_Id) return Traverse_Result;
567 -- Processes one node in the traversal, looking for logical operators,
568 -- and if one is found, outputs the appropriate table entries.
570 -----------------------------
571 -- Output_Decision_Operand --
572 -----------------------------
574 procedure Output_Decision_Operand (N : Node_Id) is
577 -- C1 holds a character that identifies the operation while C2
578 -- indicates whether we are sure (' ') or not ('?') this operation
579 -- belongs to the decision. '?' entries will be filtered out in the
580 -- second (SCO_Record_Filtered) pass.
590 T := Is_Logical_Operator (N);
595 if Nkind (N) = N_Op_Not then
602 if Nkind_In (N, N_Op_Or, N_Or_Else) then
604 else pragma Assert (Nkind_In (N, N_Op_And, N_And_Then));
622 Hash_Entries.Append ((Sloc (N), SCO_Raw_Table.Last));
624 Output_Decision_Operand (L);
625 Output_Decision_Operand (Right_Opnd (N));
627 -- Not a logical operator
632 end Output_Decision_Operand;
638 procedure Output_Element (N : Node_Id) is
642 Sloc_Range (N, FSloc, LSloc);
649 Hash_Entries.Append ((FSloc, SCO_Raw_Table.Last));
656 procedure Output_Header (T : Character) is
657 Loc : Source_Ptr := No_Location;
658 -- Node whose Sloc is used for the decision
660 Nam : Name_Id := No_Name;
661 -- For the case of an aspect, aspect name
665 when 'I' | 'E' | 'W' | 'a' | 'A' =>
667 -- For IF, EXIT, WHILE, or aspects, the token SLOC is that of
668 -- the parent of the expression.
670 Loc := Sloc (Parent (N));
672 if T = 'a' or else T = 'A' then
673 Nam := Chars (Identifier (Parent (N)));
678 -- For entry guard, the token sloc is from the N_Entry_Body.
679 -- For PRAGMA, we must get the location from the pragma node.
680 -- Argument N is the pragma argument, and we have to go up
681 -- two levels (through the pragma argument association) to
682 -- get to the pragma node itself. For the guard on a select
683 -- alternative, we do not have access to the token location for
684 -- the WHEN, so we use the first sloc of the condition itself
685 -- (note: we use First_Sloc, not Sloc, because this is what is
686 -- referenced by dominance markers).
688 -- Doesn't this requirement of using First_Sloc need to be
689 -- documented in the spec ???
691 if Nkind_In (Parent (N), N_Accept_Alternative,
693 N_Terminate_Alternative)
695 Loc := First_Sloc (N);
697 Loc := Sloc (Parent (Parent (N)));
702 -- For an expression, no Sloc
706 -- No other possibilities
718 Pragma_Sloc => Pragma_Sloc,
719 Pragma_Aspect_Name => Nam);
721 -- For an aspect specification, which will be rewritten into a
722 -- pragma, enter a hash table entry now.
725 Hash_Entries.Append ((Loc, SCO_Raw_Table.Last));
729 ------------------------------
730 -- Process_Decision_Operand --
731 ------------------------------
733 procedure Process_Decision_Operand (N : Node_Id) is
735 if Is_Logical_Operator (N) /= False then
736 if Nkind (N) /= N_Op_Not then
737 Process_Decision_Operand (Left_Opnd (N));
738 X_Not_Decision := False;
741 Process_Decision_Operand (Right_Opnd (N));
744 Process_Decisions (N, 'X', Pragma_Sloc);
746 end Process_Decision_Operand;
752 function Process_Node (N : Node_Id) return Traverse_Result is
756 -- Logical operators, output table entries and then process
757 -- operands recursively to deal with nested conditions.
769 -- If outer level, then type comes from call, otherwise it
770 -- is more deeply nested and counts as X for expression.
772 if N = Process_Decisions.N then
773 T := Process_Decisions.T;
778 -- Output header for sequence
780 X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
781 Mark := SCO_Raw_Table.Last;
782 Mark_Hash := Hash_Entries.Last;
785 -- Output the decision
787 Output_Decision_Operand (N);
789 -- If the decision was in an expression context (T = 'X')
790 -- and contained only NOT operators, then we don't output
793 if X_Not_Decision then
794 SCO_Raw_Table.Set_Last (Mark);
795 Hash_Entries.Set_Last (Mark_Hash);
797 -- Otherwise, set Last in last table entry to mark end
800 SCO_Raw_Table.Table (SCO_Raw_Table.Last).Last := True;
803 -- Process any embedded decisions
805 Process_Decision_Operand (N);
811 -- Really hard to believe this is correct given the special
812 -- handling for if expressions below ???
814 when N_Case_Expression =>
817 -- If expression, processed like an if statement
819 when N_If_Expression =>
821 Cond : constant Node_Id := First (Expressions (N));
822 Thnx : constant Node_Id := Next (Cond);
823 Elsx : constant Node_Id := Next (Thnx);
826 Process_Decisions (Cond, 'I', Pragma_Sloc);
827 Process_Decisions (Thnx, 'X', Pragma_Sloc);
828 Process_Decisions (Elsx, 'X', Pragma_Sloc);
832 -- All other cases, continue scan
839 procedure Traverse is new Traverse_Proc (Process_Node);
841 -- Start of processing for Process_Decisions
850 -- See if we have simple decision at outer level and if so then
851 -- generate the decision entry for this simple decision. A simple
852 -- decision is a boolean expression (which is not a logical operator
853 -- or short circuit form) appearing as the operand of an IF, WHILE,
854 -- EXIT WHEN, or special PRAGMA construct.
856 if T /= 'X' and then Is_Logical_Operator (N) = False then
860 -- Change Last in last table entry to True to mark end of
861 -- sequence, which is this case is only one element long.
863 SCO_Raw_Table.Table (SCO_Raw_Table.Last).Last := True;
868 -- Now we have the definitive set of SCO entries, register them in the
869 -- corresponding hash table.
871 for J in 1 .. Hash_Entries.Last loop
872 SCO_Raw_Hash_Table.Set
873 (Hash_Entries.Table (J).Sloc,
874 Hash_Entries.Table (J).SCO_Index);
878 end Process_Decisions;
885 procedure Write_Info_Char (C : Character) renames Write_Char;
886 -- Write one character;
888 procedure Write_Info_Initiate (Key : Character) renames Write_Char;
889 -- Start new one and write one character;
891 procedure Write_Info_Nat (N : Nat);
894 procedure Write_Info_Terminate renames Write_Eol;
895 -- Terminate current line
901 procedure Write_Info_Nat (N : Nat) is
906 procedure Debug_Put_SCOs is new Put_SCOs;
908 -- Start of processing for pscos
914 ---------------------
915 -- Record_Instance --
916 ---------------------
918 procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr) is
919 Inst_Src : constant Source_File_Index :=
920 Get_Source_File_Index (Inst_Sloc);
922 SCO_Instance_Table.Append
923 ((Inst_Dep_Num => Dependency_Num (Unit (Inst_Src)),
924 Inst_Loc => To_Source_Location (Inst_Sloc),
925 Enclosing_Instance => SCO_Instance_Index (Instance (Inst_Src))));
928 (SCO_Instance_Table.Last = SCO_Instance_Index (Id));
935 procedure SCO_Output is
936 procedure Populate_SCO_Instance_Table is
937 new Sinput.Iterate_On_Instances (Record_Instance);
940 pragma Assert (SCO_Generation_State = Filtered);
942 if Debug_Flag_Dot_OO then
946 Populate_SCO_Instance_Table;
948 -- Sort the unit tables based on dependency numbers
950 Unit_Table_Sort : declare
951 function Lt (Op1 : Natural; Op2 : Natural) return Boolean;
952 -- Comparison routine for sort call
954 procedure Move (From : Natural; To : Natural);
955 -- Move routine for sort call
961 function Lt (Op1 : Natural; Op2 : Natural) return Boolean is
965 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
968 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
975 procedure Move (From : Natural; To : Natural) is
977 SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
978 SCO_Unit_Table.Table (SCO_Unit_Index (From));
979 SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
980 SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
983 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
985 -- Start of processing for Unit_Table_Sort
988 Sorting.Sort (Integer (SCO_Unit_Table.Last));
991 -- Loop through entries in the unit table to set file name and
992 -- dependency number entries.
994 for J in 1 .. SCO_Unit_Table.Last loop
996 U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
997 UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
1000 Get_Name_String (Reference_Name (Source_Index (U)));
1001 UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
1002 UTE.Dep_Num := Dependency_Num (U);
1006 -- Now the tables are all setup for output to the ALI file
1008 Write_SCOs_To_ALI_File;
1011 -------------------------
1012 -- SCO_Pragma_Disabled --
1013 -------------------------
1015 function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is
1019 if Loc = No_Location then
1023 Index := SCO_Raw_Hash_Table.Get (Loc);
1025 -- The test here for zero is to deal with possible previous errors, and
1026 -- for the case of pragma statement SCOs, for which we always set the
1027 -- Pragma_Sloc even if the particular pragma cannot be specifically
1032 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
1042 -- Aspect decision (enabled)
1047 -- Aspect decision (not enabled)
1052 -- Nullified disabled SCO
1057 raise Program_Error;
1064 end SCO_Pragma_Disabled;
1066 --------------------
1067 -- SCO_Record_Raw --
1068 --------------------
1070 procedure SCO_Record_Raw (U : Unit_Number_Type) is
1071 procedure Traverse_Aux_Decls (N : Node_Id);
1072 -- Traverse the Aux_Decls_Node of compilation unit N
1074 ------------------------
1075 -- Traverse_Aux_Decls --
1076 ------------------------
1078 procedure Traverse_Aux_Decls (N : Node_Id) is
1079 ADN : constant Node_Id := Aux_Decls_Node (N);
1082 Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
1083 Traverse_Declarations_Or_Statements (Pragmas_After (ADN));
1085 -- Declarations and Actions do not correspond to source constructs,
1086 -- they contain only nodes from expansion, so at this point they
1087 -- should still be empty:
1089 pragma Assert (No (Declarations (ADN)));
1090 pragma Assert (No (Actions (ADN)));
1091 end Traverse_Aux_Decls;
1098 -- Start of processing for SCO_Record_Raw
1101 -- It is legitimate to run this pass multiple times (once per unit) so
1102 -- run it even if it was already run before.
1104 pragma Assert (SCO_Generation_State in None .. Raw);
1105 SCO_Generation_State := Raw;
1107 -- Ignore call if not generating code and generating SCO's
1109 if not (Generate_SCO and then Operating_Mode = Generate_Code) then
1113 -- Ignore call if this unit already recorded
1115 for J in 1 .. SCO_Unit_Number_Table.Last loop
1116 if U = SCO_Unit_Number_Table.Table (J) then
1121 -- Otherwise record starting entry
1123 From := SCO_Raw_Table.Last + 1;
1125 -- Get Unit (checking case of subunit)
1127 Lu := Unit (Cunit (U));
1129 if Nkind (Lu) = N_Subunit then
1130 Lu := Proper_Body (Lu);
1133 -- Traverse the unit
1135 Traverse_Aux_Decls (Cunit (U));
1138 when N_Generic_Instantiation
1139 | N_Generic_Package_Declaration
1141 | N_Package_Declaration
1144 | N_Subprogram_Declaration
1147 Traverse_Declarations_Or_Statements (L => No_List, P => Lu);
1149 -- All other cases of compilation units (e.g. renamings), generate no
1156 -- Make entry for new unit in unit tables, we will fill in the file
1157 -- name and dependency numbers later.
1159 SCO_Unit_Table.Append (
1162 File_Index => Get_Source_File_Index (Sloc (Lu)),
1164 To => SCO_Raw_Table.Last));
1166 SCO_Unit_Number_Table.Append (U);
1169 -----------------------
1170 -- Set_SCO_Condition --
1171 -----------------------
1173 procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is
1175 -- SCO annotations are not processed after the filtering pass
1177 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1179 Constant_Condition_Code : constant array (Boolean) of Character :=
1180 (False => 'f', True => 't');
1182 Orig : constant Node_Id := Original_Node (Cond);
1188 Sloc_Range (Orig, Start, Dummy);
1189 Index := SCO_Raw_Hash_Table.Get (Start);
1191 -- Index can be zero for boolean expressions that do not have SCOs
1192 -- (simple decisions outside of a control flow structure), or in case
1193 -- of a previous error.
1199 pragma Assert (SCO_Raw_Table.Table (Index).C1 = ' ');
1200 SCO_Raw_Table.Table (Index).C2 := Constant_Condition_Code (Val);
1202 end Set_SCO_Condition;
1204 ------------------------------
1205 -- Set_SCO_Logical_Operator --
1206 ------------------------------
1208 procedure Set_SCO_Logical_Operator (Op : Node_Id) is
1210 -- SCO annotations are not processed after the filtering pass
1212 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1214 Orig : constant Node_Id := Original_Node (Op);
1215 Orig_Sloc : constant Source_Ptr := Sloc (Orig);
1216 Index : constant Nat := SCO_Raw_Hash_Table.Get (Orig_Sloc);
1219 -- All (putative) logical operators are supposed to have their own entry
1220 -- in the SCOs table. However, the semantic analysis may invoke this
1221 -- subprogram with nodes that are out of the SCO generation scope.
1224 SCO_Raw_Table.Table (Index).C2 := ' ';
1226 end Set_SCO_Logical_Operator;
1228 ----------------------------
1229 -- Set_SCO_Pragma_Enabled --
1230 ----------------------------
1232 procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is
1234 -- SCO annotations are not processed after the filtering pass
1236 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1241 -- Nothing to do if not generating SCO, or if we're not processing the
1242 -- original source occurrence of the pragma.
1244 if not (Generate_SCO
1245 and then In_Extended_Main_Source_Unit (Loc)
1246 and then not (In_Instance or In_Inlined_Body))
1251 -- Note: the reason we use the Sloc value as the key is that in the
1252 -- generic case, the call to this procedure is made on a copy of the
1253 -- original node, so we can't use the Node_Id value.
1255 Index := SCO_Raw_Hash_Table.Get (Loc);
1257 -- A zero index here indicates that semantic analysis found an
1258 -- activated pragma at Loc which does not have a corresponding pragma
1259 -- or aspect at the syntax level. This may occur in legitimate cases
1260 -- because of expanded code (such are Pre/Post conditions generated for
1261 -- formal parameter validity checks), or as a consequence of a previous
1269 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
1272 -- Note: may be called multiple times for the same sloc, so
1273 -- account for the fact that the entry may already have been
1277 -- Aspect (decision SCO)
1285 -- Pragma (statement SCO)
1288 pragma Assert (T.C2 = 'p' or else T.C2 = 'P');
1292 raise Program_Error;
1296 end Set_SCO_Pragma_Enabled;
1298 -------------------------
1299 -- Set_Raw_Table_Entry --
1300 -------------------------
1302 procedure Set_Raw_Table_Entry
1308 Pragma_Sloc : Source_Ptr := No_Location;
1309 Pragma_Aspect_Name : Name_Id := No_Name)
1311 pragma Assert (SCO_Generation_State = Raw);
1313 SCO_Raw_Table.Append
1316 From => To_Source_Location (From),
1317 To => To_Source_Location (To),
1319 Pragma_Sloc => Pragma_Sloc,
1320 Pragma_Aspect_Name => Pragma_Aspect_Name));
1321 end Set_Raw_Table_Entry;
1323 ------------------------
1324 -- To_Source_Location --
1325 ------------------------
1327 function To_Source_Location (S : Source_Ptr) return Source_Location is
1329 if S = No_Location then
1330 return No_Source_Location;
1333 (Line => Get_Logical_Line_Number (S),
1334 Col => Get_Column_Number (S));
1336 end To_Source_Location;
1338 -----------------------------------------
1339 -- Traverse_Declarations_Or_Statements --
1340 -----------------------------------------
1342 -- Tables used by Traverse_Declarations_Or_Statements for temporarily
1343 -- holding statement and decision entries. These are declared globally
1344 -- since they are shared by recursive calls to this procedure.
1346 type SC_Entry is record
1352 -- Used to store a single entry in the following table, From:To represents
1353 -- the range of entries in the CS line entry, and typ is the type, with
1354 -- space meaning that no type letter will accompany the entry.
1356 package SC is new Table.Table
1357 (Table_Component_Type => SC_Entry,
1358 Table_Index_Type => Nat,
1359 Table_Low_Bound => 1,
1360 Table_Initial => 1000,
1361 Table_Increment => 200,
1362 Table_Name => "SCO_SC");
1363 -- Used to store statement components for a CS entry to be output as a
1364 -- result of the call to this procedure. SC.Last is the last entry stored,
1365 -- so the current statement sequence is represented by SC_Array (SC_First
1366 -- .. SC.Last), where SC_First is saved on entry to each recursive call to
1369 -- Extend_Statement_Sequence adds an entry to this array, and then
1370 -- Set_Statement_Entry clears the entries starting with SC_First, copying
1371 -- these entries to the main SCO output table. The reason that we do the
1372 -- temporary caching of results in this array is that we want the SCO table
1373 -- entries for a given CS line to be contiguous, and the processing may
1374 -- output intermediate entries such as decision entries.
1376 type SD_Entry is record
1382 -- Used to store a single entry in the following table. Nod is the node to
1383 -- be searched for decisions for the case of Process_Decisions_Defer with a
1384 -- node argument (with Lst set to No_List. Lst is the list to be searched
1385 -- for decisions for the case of Process_Decisions_Defer with a List
1386 -- argument (in which case Nod is set to Empty). Plo is the sloc of the
1387 -- enclosing pragma, if any.
1389 package SD is new Table.Table
1390 (Table_Component_Type => SD_Entry,
1391 Table_Index_Type => Nat,
1392 Table_Low_Bound => 1,
1393 Table_Initial => 1000,
1394 Table_Increment => 200,
1395 Table_Name => "SCO_SD");
1396 -- Used to store possible decision information. Instead of calling the
1397 -- Process_Decisions procedures directly, we call Process_Decisions_Defer,
1398 -- which simply stores the arguments in this table. Then when we clear
1399 -- out a statement sequence using Set_Statement_Entry, after generating
1400 -- the CS lines for the statements, the entries in this table result in
1401 -- calls to Process_Decision. The reason for doing things this way is to
1402 -- ensure that decisions are output after the CS line for the statements
1403 -- in which the decisions occur.
1405 procedure Traverse_Declarations_Or_Statements
1407 D : Dominant_Info := No_Dominant;
1408 P : Node_Id := Empty)
1410 Discard_Dom : Dominant_Info;
1411 pragma Warnings (Off, Discard_Dom);
1413 Discard_Dom := Traverse_Declarations_Or_Statements (L, D, P);
1414 end Traverse_Declarations_Or_Statements;
1416 function Traverse_Declarations_Or_Statements
1418 D : Dominant_Info := No_Dominant;
1419 P : Node_Id := Empty) return Dominant_Info
1421 Current_Dominant : Dominant_Info := D;
1422 -- Dominance information for the current basic block
1424 Current_Test : Node_Id;
1425 -- Conditional node (N_If_Statement or N_Elsiif being processed
1429 SC_First : constant Nat := SC.Last + 1;
1430 SD_First : constant Nat := SD.Last + 1;
1431 -- Record first entries used in SC/SD at this recursive level
1433 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
1434 -- Extend the current statement sequence to encompass the node N. Typ is
1435 -- the letter that identifies the type of statement/declaration that is
1436 -- being added to the sequence.
1438 procedure Process_Decisions_Defer (N : Node_Id; T : Character);
1439 pragma Inline (Process_Decisions_Defer);
1440 -- This routine is logically the same as Process_Decisions, except that
1441 -- the arguments are saved in the SD table for later processing when
1442 -- Set_Statement_Entry is called, which goes through the saved entries
1443 -- making the corresponding calls to Process_Decision. Note: the
1444 -- enclosing statement must have already been added to the current
1445 -- statement sequence, so that nested decisions are properly
1446 -- identified as such.
1448 procedure Process_Decisions_Defer (L : List_Id; T : Character);
1449 pragma Inline (Process_Decisions_Defer);
1450 -- Same case for list arguments, deferred call to Process_Decisions
1452 procedure Set_Statement_Entry;
1453 -- Output CS entries for all statements saved in table SC, and end the
1454 -- current CS sequence. Then output entries for all decisions nested in
1455 -- these statements, which have been deferred so far.
1457 procedure Traverse_One (N : Node_Id);
1458 -- Traverse one declaration or statement
1460 procedure Traverse_Aspects (N : Node_Id);
1461 -- Helper for Traverse_One: traverse N's aspect specifications
1463 procedure Traverse_Degenerate_Subprogram (N : Node_Id);
1464 -- Common code to handle null procedures and expression functions. Emit
1465 -- a SCO of the given Kind and N outside of the dominance flow.
1467 -------------------------------
1468 -- Extend_Statement_Sequence --
1469 -------------------------------
1471 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
1475 To_Node : Node_Id := Empty;
1478 Sloc_Range (N, F, T);
1481 when N_Accept_Statement =>
1482 if Present (Parameter_Specifications (N)) then
1483 To_Node := Last (Parameter_Specifications (N));
1484 elsif Present (Entry_Index (N)) then
1485 To_Node := Entry_Index (N);
1488 when N_Case_Statement =>
1489 To_Node := Expression (N);
1494 To_Node := Condition (N);
1496 when N_Extended_Return_Statement =>
1497 To_Node := Last (Return_Object_Declarations (N));
1499 when N_Loop_Statement =>
1500 To_Node := Iteration_Scheme (N);
1502 when N_Asynchronous_Select
1503 | N_Conditional_Entry_Call
1504 | N_Selective_Accept
1505 | N_Single_Protected_Declaration
1506 | N_Single_Task_Declaration
1507 | N_Timed_Entry_Call
1511 when N_Protected_Type_Declaration
1512 | N_Task_Type_Declaration
1514 if Has_Aspects (N) then
1515 To_Node := Last (Aspect_Specifications (N));
1517 elsif Present (Discriminant_Specifications (N)) then
1518 To_Node := Last (Discriminant_Specifications (N));
1521 To_Node := Defining_Identifier (N);
1531 if Present (To_Node) then
1532 Sloc_Range (To_Node, Dummy, T);
1535 SC.Append ((N, F, T, Typ));
1536 end Extend_Statement_Sequence;
1538 -----------------------------
1539 -- Process_Decisions_Defer --
1540 -----------------------------
1542 procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
1544 SD.Append ((N, No_List, T, Current_Pragma_Sloc));
1545 end Process_Decisions_Defer;
1547 procedure Process_Decisions_Defer (L : List_Id; T : Character) is
1549 SD.Append ((Empty, L, T, Current_Pragma_Sloc));
1550 end Process_Decisions_Defer;
1552 -------------------------
1553 -- Set_Statement_Entry --
1554 -------------------------
1556 procedure Set_Statement_Entry is
1557 SC_Last : constant Int := SC.Last;
1558 SD_Last : constant Int := SD.Last;
1561 -- Output statement entries from saved entries in SC table
1563 for J in SC_First .. SC_Last loop
1564 if J = SC_First then
1566 if Current_Dominant /= No_Dominant then
1572 Sloc_Range (Current_Dominant.N, From, To);
1574 if Current_Dominant.K /= 'E' then
1580 C2 => Current_Dominant.K,
1584 Pragma_Sloc => No_Location,
1585 Pragma_Aspect_Name => No_Name);
1591 SCE : SC_Entry renames SC.Table (J);
1592 Pragma_Sloc : Source_Ptr := No_Location;
1593 Pragma_Aspect_Name : Name_Id := No_Name;
1596 -- For the case of a statement SCO for a pragma controlled by
1597 -- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
1598 -- those of any nested decision) is emitted only if the pragma
1601 if SCE.Typ = 'p' then
1602 Pragma_Sloc := SCE.From;
1603 SCO_Raw_Hash_Table.Set
1604 (Pragma_Sloc, SCO_Raw_Table.Last + 1);
1605 Pragma_Aspect_Name := Pragma_Name_Unmapped (SCE.N);
1606 pragma Assert (Pragma_Aspect_Name /= No_Name);
1608 elsif SCE.Typ = 'P' then
1609 Pragma_Aspect_Name := Pragma_Name_Unmapped (SCE.N);
1610 pragma Assert (Pragma_Aspect_Name /= No_Name);
1618 Last => (J = SC_Last),
1619 Pragma_Sloc => Pragma_Sloc,
1620 Pragma_Aspect_Name => Pragma_Aspect_Name);
1624 -- Last statement of basic block, if present, becomes new current
1627 if SC_Last >= SC_First then
1628 Current_Dominant := ('S', SC.Table (SC_Last).N);
1631 -- Clear out used section of SC table
1633 SC.Set_Last (SC_First - 1);
1635 -- Output any embedded decisions
1637 for J in SD_First .. SD_Last loop
1639 SDE : SD_Entry renames SD.Table (J);
1642 if Present (SDE.Nod) then
1643 Process_Decisions (SDE.Nod, SDE.Typ, SDE.Plo);
1645 Process_Decisions (SDE.Lst, SDE.Typ, SDE.Plo);
1650 -- Clear out used section of SD table
1652 SD.Set_Last (SD_First - 1);
1653 end Set_Statement_Entry;
1655 ----------------------
1656 -- Traverse_Aspects --
1657 ----------------------
1659 procedure Traverse_Aspects (N : Node_Id) is
1665 AN := First (Aspect_Specifications (N));
1666 while Present (AN) loop
1667 AE := Expression (AN);
1669 -- SCOs are generated before semantic analysis/expansion:
1670 -- PPCs are not split yet.
1672 pragma Assert (not Split_PPC (AN));
1676 case Get_Aspect_Id (AN) is
1678 -- Aspects rewritten into pragmas controlled by a Check_Policy:
1679 -- Current_Pragma_Sloc must be set to the sloc of the aspect
1680 -- specification. The corresponding pragma will have the same
1683 when Aspect_Invariant
1685 | Aspect_Postcondition
1687 | Aspect_Precondition
1688 | Aspect_Type_Invariant
1692 -- Aspects whose checks are generated in client units,
1693 -- regardless of whether or not the check is activated in the
1694 -- unit which contains the declaration: create decision as
1695 -- unconditionally enabled aspect (but still make a pragma
1696 -- entry since Set_SCO_Pragma_Enabled will be called when
1697 -- analyzing actual checks, possibly in other units).
1699 -- Pre/post can have checks in client units too because of
1700 -- inheritance, so should they be moved here???
1702 when Aspect_Dynamic_Predicate
1704 | Aspect_Static_Predicate
1708 -- Other aspects: just process any decision nested in the
1709 -- aspect expression.
1712 if Has_Decision (AE) then
1717 if C1 /= ASCII.NUL then
1718 pragma Assert (Current_Pragma_Sloc = No_Location);
1720 if C1 = 'a' or else C1 = 'A' then
1721 Current_Pragma_Sloc := Sloc (AN);
1724 Process_Decisions_Defer (AE, C1);
1726 Current_Pragma_Sloc := No_Location;
1731 end Traverse_Aspects;
1733 ------------------------------------
1734 -- Traverse_Degenerate_Subprogram --
1735 ------------------------------------
1737 procedure Traverse_Degenerate_Subprogram (N : Node_Id) is
1739 -- Complete current sequence of statements
1741 Set_Statement_Entry;
1744 Saved_Dominant : constant Dominant_Info := Current_Dominant;
1745 -- Save last statement in current sequence as dominant
1748 -- Output statement SCO for degenerate subprogram body (null
1749 -- statement or freestanding expression) outside of the dominance
1752 Current_Dominant := No_Dominant;
1753 Extend_Statement_Sequence (N, Typ => ' ');
1755 -- For the case of an expression-function, collect decisions
1756 -- embedded in the expression now.
1758 if Nkind (N) in N_Subexpr then
1759 Process_Decisions_Defer (N, 'X');
1762 Set_Statement_Entry;
1764 -- Restore current dominant information designating last statement
1765 -- in previous sequence (i.e. make the dominance chain skip over
1766 -- the degenerate body).
1768 Current_Dominant := Saved_Dominant;
1770 end Traverse_Degenerate_Subprogram;
1776 procedure Traverse_One (N : Node_Id) is
1778 -- Initialize or extend current statement sequence. Note that for
1779 -- special cases such as IF and Case statements we will modify
1780 -- the range to exclude internal statements that should not be
1781 -- counted as part of the current statement sequence.
1785 -- Package declaration
1787 when N_Package_Declaration =>
1788 Set_Statement_Entry;
1789 Traverse_Package_Declaration (N, Current_Dominant);
1791 -- Generic package declaration
1793 when N_Generic_Package_Declaration =>
1794 Set_Statement_Entry;
1795 Traverse_Generic_Package_Declaration (N);
1799 when N_Package_Body =>
1800 Set_Statement_Entry;
1801 Traverse_Package_Body (N);
1803 -- Subprogram declaration or subprogram body stub
1805 when N_Expression_Function
1806 | N_Subprogram_Body_Stub
1807 | N_Subprogram_Declaration
1810 Spec : constant Node_Id := Specification (N);
1812 Process_Decisions_Defer
1813 (Parameter_Specifications (Spec), 'X');
1815 -- Case of a null procedure: generate a NULL statement SCO
1817 if Nkind (N) = N_Subprogram_Declaration
1818 and then Nkind (Spec) = N_Procedure_Specification
1819 and then Null_Present (Spec)
1821 Traverse_Degenerate_Subprogram (N);
1823 -- Case of an expression function: generate a statement SCO
1824 -- for the expression (and then decision SCOs for any nested
1827 elsif Nkind (N) = N_Expression_Function then
1828 Traverse_Degenerate_Subprogram (Expression (N));
1832 -- Entry declaration
1834 when N_Entry_Declaration =>
1835 Process_Decisions_Defer (Parameter_Specifications (N), 'X');
1837 -- Generic subprogram declaration
1839 when N_Generic_Subprogram_Declaration =>
1840 Process_Decisions_Defer
1841 (Generic_Formal_Declarations (N), 'X');
1842 Process_Decisions_Defer
1843 (Parameter_Specifications (Specification (N)), 'X');
1845 -- Task or subprogram body
1847 when N_Subprogram_Body
1850 Set_Statement_Entry;
1851 Traverse_Subprogram_Or_Task_Body (N);
1855 when N_Entry_Body =>
1857 Cond : constant Node_Id :=
1858 Condition (Entry_Body_Formal_Part (N));
1860 Inner_Dominant : Dominant_Info := No_Dominant;
1863 Set_Statement_Entry;
1865 if Present (Cond) then
1866 Process_Decisions_Defer (Cond, 'G');
1868 -- For an entry body with a barrier, the entry body
1869 -- is dominanted by a True evaluation of the barrier.
1871 Inner_Dominant := ('T', N);
1874 Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
1879 when N_Protected_Body =>
1880 Set_Statement_Entry;
1881 Traverse_Declarations_Or_Statements (Declarations (N));
1883 -- Exit statement, which is an exit statement in the SCO sense,
1884 -- so it is included in the current statement sequence, but
1885 -- then it terminates this sequence. We also have to process
1886 -- any decisions in the exit statement expression.
1888 when N_Exit_Statement =>
1889 Extend_Statement_Sequence (N, 'E');
1890 Process_Decisions_Defer (Condition (N), 'E');
1891 Set_Statement_Entry;
1893 -- If condition is present, then following statement is
1894 -- only executed if the condition evaluates to False.
1896 if Present (Condition (N)) then
1897 Current_Dominant := ('F', N);
1899 Current_Dominant := No_Dominant;
1902 -- Label, which breaks the current statement sequence, but the
1903 -- label itself is not included in the next statement sequence,
1904 -- since it generates no code.
1907 Set_Statement_Entry;
1908 Current_Dominant := No_Dominant;
1910 -- Block statement, which breaks the current statement sequence
1912 when N_Block_Statement =>
1913 Set_Statement_Entry;
1915 -- The first statement in the handled sequence of statements
1916 -- is dominated by the elaboration of the last declaration.
1918 Current_Dominant := Traverse_Declarations_Or_Statements
1919 (L => Declarations (N),
1920 D => Current_Dominant);
1922 Traverse_Handled_Statement_Sequence
1923 (N => Handled_Statement_Sequence (N),
1924 D => Current_Dominant);
1926 -- If statement, which breaks the current statement sequence,
1927 -- but we include the condition in the current sequence.
1929 when N_If_Statement =>
1931 Extend_Statement_Sequence (N, 'I');
1932 Process_Decisions_Defer (Condition (N), 'I');
1933 Set_Statement_Entry;
1935 -- Now we traverse the statements in the THEN part
1937 Traverse_Declarations_Or_Statements
1938 (L => Then_Statements (N),
1941 -- Loop through ELSIF parts if present
1943 if Present (Elsif_Parts (N)) then
1945 Saved_Dominant : constant Dominant_Info :=
1948 Elif : Node_Id := First (Elsif_Parts (N));
1951 while Present (Elif) loop
1953 -- An Elsif is executed only if the previous test
1954 -- got a FALSE outcome.
1956 Current_Dominant := ('F', Current_Test);
1958 -- Now update current test information
1960 Current_Test := Elif;
1962 -- We generate a statement sequence for the
1963 -- construct "ELSIF condition", so that we have
1964 -- a statement for the resulting decisions.
1966 Extend_Statement_Sequence (Elif, 'I');
1967 Process_Decisions_Defer (Condition (Elif), 'I');
1968 Set_Statement_Entry;
1970 -- An ELSIF part is never guaranteed to have
1971 -- been executed, following statements are only
1972 -- dominated by the initial IF statement.
1974 Current_Dominant := Saved_Dominant;
1976 -- Traverse the statements in the ELSIF
1978 Traverse_Declarations_Or_Statements
1979 (L => Then_Statements (Elif),
1986 -- Finally traverse the ELSE statements if present
1988 Traverse_Declarations_Or_Statements
1989 (L => Else_Statements (N),
1990 D => ('F', Current_Test));
1992 -- CASE statement, which breaks the current statement sequence,
1993 -- but we include the expression in the current sequence.
1995 when N_Case_Statement =>
1996 Extend_Statement_Sequence (N, 'C');
1997 Process_Decisions_Defer (Expression (N), 'X');
1998 Set_Statement_Entry;
2000 -- Process case branches, all of which are dominated by the
2006 Alt := First_Non_Pragma (Alternatives (N));
2007 while Present (Alt) loop
2008 Traverse_Declarations_Or_Statements
2009 (L => Statements (Alt),
2010 D => Current_Dominant);
2017 when N_Accept_Statement =>
2018 Extend_Statement_Sequence (N, 'A');
2019 Set_Statement_Entry;
2021 -- Process sequence of statements, dominant is the ACCEPT
2024 Traverse_Handled_Statement_Sequence
2025 (N => Handled_Statement_Sequence (N),
2026 D => Current_Dominant);
2030 when N_Selective_Accept =>
2031 Extend_Statement_Sequence (N, 'S');
2032 Set_Statement_Entry;
2034 -- Process alternatives
2039 S_Dom : Dominant_Info;
2042 Alt := First (Select_Alternatives (N));
2043 while Present (Alt) loop
2044 S_Dom := Current_Dominant;
2045 Guard := Condition (Alt);
2047 if Present (Guard) then
2051 Pragma_Sloc => No_Location);
2052 Current_Dominant := ('T', Guard);
2057 Current_Dominant := S_Dom;
2062 Traverse_Declarations_Or_Statements
2063 (L => Else_Statements (N),
2064 D => Current_Dominant);
2066 when N_Conditional_Entry_Call
2067 | N_Timed_Entry_Call
2069 Extend_Statement_Sequence (N, 'S');
2070 Set_Statement_Entry;
2072 -- Process alternatives
2074 Traverse_One (Entry_Call_Alternative (N));
2076 if Nkind (N) = N_Timed_Entry_Call then
2077 Traverse_One (Delay_Alternative (N));
2079 Traverse_Declarations_Or_Statements
2080 (L => Else_Statements (N),
2081 D => Current_Dominant);
2084 when N_Asynchronous_Select =>
2085 Extend_Statement_Sequence (N, 'S');
2086 Set_Statement_Entry;
2088 Traverse_One (Triggering_Alternative (N));
2089 Traverse_Declarations_Or_Statements
2090 (L => Statements (Abortable_Part (N)),
2091 D => Current_Dominant);
2093 when N_Accept_Alternative =>
2094 Traverse_Declarations_Or_Statements
2095 (L => Statements (N),
2096 D => Current_Dominant,
2097 P => Accept_Statement (N));
2099 when N_Entry_Call_Alternative =>
2100 Traverse_Declarations_Or_Statements
2101 (L => Statements (N),
2102 D => Current_Dominant,
2103 P => Entry_Call_Statement (N));
2105 when N_Delay_Alternative =>
2106 Traverse_Declarations_Or_Statements
2107 (L => Statements (N),
2108 D => Current_Dominant,
2109 P => Delay_Statement (N));
2111 when N_Triggering_Alternative =>
2112 Traverse_Declarations_Or_Statements
2113 (L => Statements (N),
2114 D => Current_Dominant,
2115 P => Triggering_Statement (N));
2117 when N_Terminate_Alternative =>
2119 -- It is dubious to emit a statement SCO for a TERMINATE
2120 -- alternative, since no code is actually executed if the
2121 -- alternative is selected -- the tasking runtime call just
2124 Extend_Statement_Sequence (N, ' ');
2125 Set_Statement_Entry;
2127 -- Unconditional exit points, which are included in the current
2128 -- statement sequence, but then terminate it
2130 when N_Goto_Statement
2132 | N_Requeue_Statement
2134 Extend_Statement_Sequence (N, ' ');
2135 Set_Statement_Entry;
2136 Current_Dominant := No_Dominant;
2138 -- Simple return statement. which is an exit point, but we
2139 -- have to process the return expression for decisions.
2141 when N_Simple_Return_Statement =>
2142 Extend_Statement_Sequence (N, ' ');
2143 Process_Decisions_Defer (Expression (N), 'X');
2144 Set_Statement_Entry;
2145 Current_Dominant := No_Dominant;
2147 -- Extended return statement
2149 when N_Extended_Return_Statement =>
2150 Extend_Statement_Sequence (N, 'R');
2151 Process_Decisions_Defer (Return_Object_Declarations (N), 'X');
2152 Set_Statement_Entry;
2154 Traverse_Handled_Statement_Sequence
2155 (N => Handled_Statement_Sequence (N),
2156 D => Current_Dominant);
2158 Current_Dominant := No_Dominant;
2160 -- Loop ends the current statement sequence, but we include
2161 -- the iteration scheme if present in the current sequence.
2162 -- But the body of the loop starts a new sequence, since it
2163 -- may not be executed as part of the current sequence.
2165 when N_Loop_Statement =>
2167 ISC : constant Node_Id := Iteration_Scheme (N);
2168 Inner_Dominant : Dominant_Info := No_Dominant;
2171 if Present (ISC) then
2173 -- If iteration scheme present, extend the current
2174 -- statement sequence to include the iteration scheme
2175 -- and process any decisions it contains.
2179 if Present (Condition (ISC)) then
2180 Extend_Statement_Sequence (N, 'W');
2181 Process_Decisions_Defer (Condition (ISC), 'W');
2183 -- Set more specific dominant for inner statements
2184 -- (the control sloc for the decision is that of
2185 -- the WHILE token).
2187 Inner_Dominant := ('T', ISC);
2192 Extend_Statement_Sequence (N, 'F');
2193 Process_Decisions_Defer
2194 (Loop_Parameter_Specification (ISC), 'X');
2198 Set_Statement_Entry;
2200 if Inner_Dominant = No_Dominant then
2201 Inner_Dominant := Current_Dominant;
2204 Traverse_Declarations_Or_Statements
2205 (L => Statements (N),
2206 D => Inner_Dominant);
2213 -- Record sloc of pragma (pragmas don't nest)
2215 pragma Assert (Current_Pragma_Sloc = No_Location);
2216 Current_Pragma_Sloc := Sloc (N);
2218 -- Processing depends on the kind of pragma
2221 Nam : constant Name_Id := Pragma_Name_Unmapped (N);
2223 First (Pragma_Argument_Associations (N));
2229 | Name_Assert_And_Cut
2232 | Name_Loop_Invariant
2233 | Name_Postcondition
2236 -- For Assert/Check/Precondition/Postcondition, we
2237 -- must generate a P entry for the decision. Note
2238 -- that this is done unconditionally at this stage.
2239 -- Output for disabled pragmas is suppressed later
2240 -- on when we output the decision line in Put_SCOs,
2241 -- depending on setting by Set_SCO_Pragma_Enabled.
2243 if Nam = Name_Check then
2247 Process_Decisions_Defer (Expression (Arg), 'P');
2250 -- Pre/postconditions can be inherited so SCO should
2251 -- never be deactivated???
2254 if Present (Arg) and then Present (Next (Arg)) then
2256 -- Case of a dyadic pragma Debug: first argument
2257 -- is a P decision, any nested decision in the
2258 -- second argument is an X decision.
2260 Process_Decisions_Defer (Expression (Arg), 'P');
2264 Process_Decisions_Defer (Expression (Arg), 'X');
2267 -- For all other pragmas, we generate decision entries
2268 -- for any embedded expressions, and the pragma is
2271 -- Should generate P decisions (not X) for assertion
2272 -- related pragmas: [Type_]Invariant,
2273 -- [{Static,Dynamic}_]Predicate???
2276 Process_Decisions_Defer (N, 'X');
2280 -- Add statement SCO
2282 Extend_Statement_Sequence (N, Typ);
2284 Current_Pragma_Sloc := No_Location;
2287 -- Object declaration. Ignored if Prev_Ids is set, since the
2288 -- parser generates multiple instances of the whole declaration
2289 -- if there is more than one identifier declared, and we only
2290 -- want one entry in the SCOs, so we take the first, for which
2291 -- Prev_Ids is False.
2293 when N_Number_Declaration
2294 | N_Object_Declaration
2296 if not Prev_Ids (N) then
2297 Extend_Statement_Sequence (N, 'o');
2299 if Has_Decision (N) then
2300 Process_Decisions_Defer (N, 'X');
2304 -- All other cases, which extend the current statement sequence
2305 -- but do not terminate it, even if they have nested decisions.
2307 when N_Protected_Type_Declaration
2308 | N_Task_Type_Declaration
2310 Extend_Statement_Sequence (N, 't');
2311 Process_Decisions_Defer (Discriminant_Specifications (N), 'X');
2312 Set_Statement_Entry;
2314 Traverse_Sync_Definition (N);
2316 when N_Single_Protected_Declaration
2317 | N_Single_Task_Declaration
2319 Extend_Statement_Sequence (N, 'o');
2320 Set_Statement_Entry;
2322 Traverse_Sync_Definition (N);
2326 -- Determine required type character code, or ASCII.NUL if
2327 -- no SCO should be generated for this node.
2330 NK : constant Node_Kind := Nkind (N);
2335 when N_Full_Type_Declaration
2336 | N_Incomplete_Type_Declaration
2337 | N_Private_Extension_Declaration
2338 | N_Private_Type_Declaration
2342 when N_Subtype_Declaration =>
2345 when N_Renaming_Declaration =>
2348 when N_Generic_Instantiation =>
2351 when N_Package_Body_Stub
2352 | N_Protected_Body_Stub
2353 | N_Representation_Clause
2355 | N_Use_Package_Clause
2360 when N_Procedure_Call_Statement =>
2364 if NK in N_Statement_Other_Than_Procedure_Call then
2371 if Typ /= ASCII.NUL then
2372 Extend_Statement_Sequence (N, Typ);
2376 -- Process any embedded decisions
2378 if Has_Decision (N) then
2379 Process_Decisions_Defer (N, 'X');
2383 -- Process aspects if present
2385 Traverse_Aspects (N);
2388 -- Start of processing for Traverse_Declarations_Or_Statements
2391 -- Process single prefixed node
2397 -- Loop through statements or declarations
2399 if Is_Non_Empty_List (L) then
2401 while Present (N) loop
2403 -- Note: For separate bodies, we see the tree after Par.Labl has
2404 -- introduced implicit labels, so we need to ignore those nodes.
2406 if Nkind (N) /= N_Implicit_Label_Declaration then
2415 -- End sequence of statements and flush deferred decisions
2417 if Present (P) or else Is_Non_Empty_List (L) then
2418 Set_Statement_Entry;
2421 return Current_Dominant;
2422 end Traverse_Declarations_Or_Statements;
2424 ------------------------------------------
2425 -- Traverse_Generic_Package_Declaration --
2426 ------------------------------------------
2428 procedure Traverse_Generic_Package_Declaration (N : Node_Id) is
2430 Process_Decisions (Generic_Formal_Declarations (N), 'X', No_Location);
2431 Traverse_Package_Declaration (N);
2432 end Traverse_Generic_Package_Declaration;
2434 -----------------------------------------
2435 -- Traverse_Handled_Statement_Sequence --
2436 -----------------------------------------
2438 procedure Traverse_Handled_Statement_Sequence
2440 D : Dominant_Info := No_Dominant)
2445 -- For package bodies without a statement part, the parser adds an empty
2446 -- one, to normalize the representation. The null statement therein,
2447 -- which does not come from source, does not get a SCO.
2449 if Present (N) and then Comes_From_Source (N) then
2450 Traverse_Declarations_Or_Statements (Statements (N), D);
2452 if Present (Exception_Handlers (N)) then
2453 Handler := First_Non_Pragma (Exception_Handlers (N));
2454 while Present (Handler) loop
2455 Traverse_Declarations_Or_Statements
2456 (L => Statements (Handler),
2457 D => ('E', Handler));
2462 end Traverse_Handled_Statement_Sequence;
2464 ---------------------------
2465 -- Traverse_Package_Body --
2466 ---------------------------
2468 procedure Traverse_Package_Body (N : Node_Id) is
2469 Dom : Dominant_Info;
2471 -- The first statement in the handled sequence of statements is
2472 -- dominated by the elaboration of the last declaration.
2474 Dom := Traverse_Declarations_Or_Statements (Declarations (N));
2476 Traverse_Handled_Statement_Sequence
2477 (Handled_Statement_Sequence (N), Dom);
2478 end Traverse_Package_Body;
2480 ----------------------------------
2481 -- Traverse_Package_Declaration --
2482 ----------------------------------
2484 procedure Traverse_Package_Declaration
2486 D : Dominant_Info := No_Dominant)
2488 Spec : constant Node_Id := Specification (N);
2489 Dom : Dominant_Info;
2493 Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
2495 -- First private declaration is dominated by last visible declaration
2497 Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
2498 end Traverse_Package_Declaration;
2500 ------------------------------
2501 -- Traverse_Sync_Definition --
2502 ------------------------------
2504 procedure Traverse_Sync_Definition (N : Node_Id) is
2505 Dom_Info : Dominant_Info := ('S', N);
2506 -- The first declaration is dominated by the protected or task [type]
2510 -- N's protected or task definition
2512 Priv_Decl : List_Id;
2514 -- Sync_Def's Visible_Declarations and Private_Declarations
2518 when N_Protected_Type_Declaration
2519 | N_Single_Protected_Declaration
2521 Sync_Def := Protected_Definition (N);
2523 when N_Single_Task_Declaration
2524 | N_Task_Type_Declaration
2526 Sync_Def := Task_Definition (N);
2529 raise Program_Error;
2532 -- Sync_Def may be Empty at least for empty Task_Type_Declarations.
2533 -- Querying Visible or Private_Declarations is invalid in this case.
2535 if Present (Sync_Def) then
2536 Vis_Decl := Visible_Declarations (Sync_Def);
2537 Priv_Decl := Private_Declarations (Sync_Def);
2539 Vis_Decl := No_List;
2540 Priv_Decl := No_List;
2543 Dom_Info := Traverse_Declarations_Or_Statements
2547 -- If visible declarations are present, the first private declaration
2548 -- is dominated by the last visible declaration.
2550 Traverse_Declarations_Or_Statements
2553 end Traverse_Sync_Definition;
2555 --------------------------------------
2556 -- Traverse_Subprogram_Or_Task_Body --
2557 --------------------------------------
2559 procedure Traverse_Subprogram_Or_Task_Body
2561 D : Dominant_Info := No_Dominant)
2563 Decls : constant List_Id := Declarations (N);
2564 Dom_Info : Dominant_Info := D;
2567 -- If declarations are present, the first statement is dominated by the
2568 -- last declaration.
2570 Dom_Info := Traverse_Declarations_Or_Statements
2571 (L => Decls, D => Dom_Info);
2573 Traverse_Handled_Statement_Sequence
2574 (N => Handled_Statement_Sequence (N),
2576 end Traverse_Subprogram_Or_Task_Body;
2578 -------------------------
2579 -- SCO_Record_Filtered --
2580 -------------------------
2582 procedure SCO_Record_Filtered is
2583 type Decision is record
2585 -- Type of the SCO decision (see comments for SCO_Table_Entry.C1)
2587 Sloc : Source_Location;
2590 -- Index in the SCO_Raw_Table for the root operator/condition for the
2591 -- expression that controls the decision.
2593 -- Decision descriptor: used to gather information about a candidate
2596 package Pending_Decisions is new Table.Table
2597 (Table_Component_Type => Decision,
2598 Table_Index_Type => Nat,
2599 Table_Low_Bound => 1,
2600 Table_Initial => 1000,
2601 Table_Increment => 200,
2602 Table_Name => "Filter_Pending_Decisions");
2603 -- Table used to hold decisions to process during the collection pass
2605 procedure Add_Expression_Tree (Idx : in out Nat);
2606 -- Add SCO raw table entries for the decision controlling expression
2607 -- tree starting at Idx to the filtered SCO table.
2609 procedure Collect_Decisions
2612 -- Collect decisions to add to the filtered SCO table starting at the
2613 -- D decision (including it and its nested operators/conditions). Set
2614 -- Next to the first node index passed the whole decision.
2616 procedure Compute_Range
2618 From : out Source_Location;
2619 To : out Source_Location);
2620 -- Compute the source location range for the expression tree starting at
2621 -- Idx in the SCO raw table. Store its bounds in From and To.
2623 function Is_Decision (Idx : Nat) return Boolean;
2624 -- Return if the expression tree starting at Idx has adjacent nested
2625 -- nodes that make a decision.
2627 procedure Process_Pending_Decisions
2628 (Original_Decision : SCO_Table_Entry);
2629 -- Complete the filtered SCO table using collected decisions. Output
2630 -- decisions inherit the pragma information from the original decision.
2632 procedure Search_Nested_Decisions (Idx : in out Nat);
2633 -- Collect decisions to add to the filtered SCO table starting at the
2634 -- node at Idx in the SCO raw table. This node must not be part of an
2635 -- already-processed decision. Set Idx to the first node index passed
2636 -- the whole expression tree.
2638 procedure Skip_Decision
2640 Process_Nested_Decisions : Boolean);
2641 -- Skip all the nodes that belong to the decision starting at Idx. If
2642 -- Process_Nested_Decision, call Search_Nested_Decisions on the first
2643 -- nested nodes that do not belong to the decision. Set Idx to the first
2644 -- node index passed the whole expression tree.
2646 -------------------------
2647 -- Add_Expression_Tree --
2648 -------------------------
2650 procedure Add_Expression_Tree (Idx : in out Nat) is
2651 Node_Idx : constant Nat := Idx;
2652 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Node_Idx);
2653 From : Source_Location;
2654 To : Source_Location;
2660 -- This is a single condition. Add an entry for it and move on
2662 SCO_Table.Append (T);
2667 -- This is a NOT operator: add an entry for it and browse its
2670 SCO_Table.Append (T);
2672 Add_Expression_Tree (Idx);
2676 -- This must be an AND/OR/AND THEN/OR ELSE operator
2680 -- This is not a short circuit operator: consider this one
2681 -- and all its children as a single condition.
2683 Compute_Range (Idx, From, To);
2690 Pragma_Sloc => No_Location,
2691 Pragma_Aspect_Name => No_Name));
2694 -- This is a real short circuit operator: add an entry for
2695 -- it and browse its children.
2697 SCO_Table.Append (T);
2699 Add_Expression_Tree (Idx);
2700 Add_Expression_Tree (Idx);
2703 end Add_Expression_Tree;
2705 -----------------------
2706 -- Collect_Decisions --
2707 -----------------------
2709 procedure Collect_Decisions
2716 if D.Kind /= 'X' or else Is_Decision (D.Top) then
2717 Pending_Decisions.Append (D);
2720 Skip_Decision (Idx, True);
2722 end Collect_Decisions;
2728 procedure Compute_Range
2730 From : out Source_Location;
2731 To : out Source_Location)
2733 Sloc_F : Source_Location := No_Source_Location;
2734 Sloc_T : Source_Location := No_Source_Location;
2736 procedure Process_One;
2737 -- Process one node of the tree, and recurse over children. Update
2738 -- Idx during the traversal.
2744 procedure Process_One is
2746 if Sloc_F = No_Source_Location
2748 SCO_Raw_Table.Table (Idx).From < Sloc_F
2750 Sloc_F := SCO_Raw_Table.Table (Idx).From;
2753 if Sloc_T = No_Source_Location
2755 Sloc_T < SCO_Raw_Table.Table (Idx).To
2757 Sloc_T := SCO_Raw_Table.Table (Idx).To;
2760 if SCO_Raw_Table.Table (Idx).C1 = ' ' then
2762 -- This is a condition: nothing special to do
2766 elsif SCO_Raw_Table.Table (Idx).C1 = '!' then
2768 -- The "not" operator has only one operand
2774 -- This is an AND THEN or OR ELSE logical operator: follow the
2775 -- left, then the right operands.
2784 -- Start of processing for Compute_Range
2796 function Is_Decision (Idx : Nat) return Boolean is
2802 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
2811 -- This is a decision iff the only operand of the NOT
2812 -- operator could be a standalone decision.
2818 -- This node is a logical operator (and thus could be a
2819 -- standalone decision) iff it is a short circuit
2828 -------------------------------
2829 -- Process_Pending_Decisions --
2830 -------------------------------
2832 procedure Process_Pending_Decisions
2833 (Original_Decision : SCO_Table_Entry)
2836 for Index in 1 .. Pending_Decisions.Last loop
2838 D : Decision renames Pending_Decisions.Table (Index);
2842 -- Add a SCO table entry for the decision itself
2844 pragma Assert (D.Kind /= ' ');
2847 ((To => No_Source_Location,
2852 Pragma_Sloc => Original_Decision.Pragma_Sloc,
2853 Pragma_Aspect_Name =>
2854 Original_Decision.Pragma_Aspect_Name));
2856 -- Then add ones for its nested operators/operands. Do not
2857 -- forget to tag its *last* entry as such.
2859 Add_Expression_Tree (Idx);
2860 SCO_Table.Table (SCO_Table.Last).Last := True;
2864 -- Clear the pending decisions list
2865 Pending_Decisions.Set_Last (0);
2866 end Process_Pending_Decisions;
2868 -----------------------------
2869 -- Search_Nested_Decisions --
2870 -----------------------------
2872 procedure Search_Nested_Decisions (Idx : in out Nat) is
2876 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
2895 -- This is not a logical operator: start looking for
2896 -- nested decisions from here. Recurse over the left
2897 -- child and let the loop take care of the right one.
2900 Search_Nested_Decisions (Idx);
2903 -- We found a nested decision
2915 end Search_Nested_Decisions;
2921 procedure Skip_Decision
2923 Process_Nested_Decisions : Boolean)
2928 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
2939 -- This NOT operator belongs to the outside decision:
2945 if T.C2 = '?' and then Process_Nested_Decisions then
2947 -- This is not a logical operator: start looking for
2948 -- nested decisions from here. Recurse over the left
2949 -- child and let the loop take care of the right one.
2951 Search_Nested_Decisions (Idx);
2954 -- This is a logical operator, so it belongs to the
2955 -- outside decision: skip its left child, then let the
2956 -- loop take care of the right one.
2958 Skip_Decision (Idx, Process_Nested_Decisions);
2965 -- Start of processing for SCO_Record_Filtered
2968 -- Filtering must happen only once: do nothing if it this pass was
2971 if SCO_Generation_State = Filtered then
2974 pragma Assert (SCO_Generation_State = Raw);
2975 SCO_Generation_State := Filtered;
2978 -- Loop through all SCO entries under SCO units
2980 for Unit_Idx in 1 .. SCO_Unit_Table.Last loop
2982 Unit : SCO_Unit_Table_Entry
2983 renames SCO_Unit_Table.Table (Unit_Idx);
2985 Idx : Nat := Unit.From;
2986 -- Index of the current SCO raw table entry
2988 New_From : constant Nat := SCO_Table.Last + 1;
2989 -- After copying SCO enties of interest to the final table, we
2990 -- will have to change the From/To indexes this unit targets.
2991 -- This constant keeps track of the new From index.
2994 while Idx <= Unit.To loop
2996 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
3001 -- Decision (of any kind, including pragmas and aspects)
3003 when 'E' | 'G' | 'I' | 'W' | 'X' | 'P' | 'a' | 'A' =>
3004 if SCO_Pragma_Disabled (T.Pragma_Sloc) then
3006 -- Skip SCO entries for decisions in disabled
3007 -- constructs (pragmas or aspects).
3010 Skip_Decision (Idx, False);
3018 Process_Pending_Decisions (T);
3021 -- There is no translation/filtering to do for other kind
3022 -- of SCO items (statements, dominance markers, etc.).
3024 when '|' | '&' | '!' | ' ' =>
3026 -- SCO logical operators and conditions cannot exist
3027 -- on their own: they must be inside a decision (such
3028 -- entries must have been skipped by
3029 -- Collect_Decisions).
3031 raise Program_Error;
3034 SCO_Table.Append (T);
3040 -- Now, update the SCO entry indexes in the unit entry
3042 Unit.From := New_From;
3043 Unit.To := SCO_Table.Last;
3047 -- Then clear the raw table to free bytes
3050 end SCO_Record_Filtered;