1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2009-2015, 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
, F2
: Source_Ptr
) return Boolean;
124 -- Function to test two keys for equality
126 function "<" (S1
, 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.
203 -- If P is 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
);
221 procedure Traverse_Handled_Statement_Sequence
223 D
: Dominant_Info
:= No_Dominant
);
224 procedure Traverse_Package_Body
(N
: Node_Id
);
225 procedure Traverse_Package_Declaration
227 D
: Dominant_Info
:= No_Dominant
);
228 procedure Traverse_Subprogram_Or_Task_Body
230 D
: Dominant_Info
:= No_Dominant
);
232 procedure Traverse_Sync_Definition
(N
: Node_Id
);
233 -- Traverse a protected definition or task definition
235 procedure Write_SCOs_To_ALI_File
is new Put_SCOs
;
236 -- Write SCO information to the ALI file using routines in Lib.Util
243 procedure Dump_Entry
(Index
: Nat
; T
: SCO_Table_Entry
);
244 -- Dump a SCO table entry
250 procedure Dump_Entry
(Index
: Nat
; T
: SCO_Table_Entry
) is
257 Write_Str
(" C1 = '");
263 Write_Str
(" C2 = '");
268 if T
.From
/= No_Source_Location
then
269 Write_Str
(" From = ");
270 Write_Int
(Int
(T
.From
.Line
));
272 Write_Int
(Int
(T
.From
.Col
));
275 if T
.To
/= No_Source_Location
then
276 Write_Str
(" To = ");
277 Write_Int
(Int
(T
.To
.Line
));
279 Write_Int
(Int
(T
.To
.Col
));
285 Write_Str
(" False");
291 -- Start of processing for dsco
294 -- Dump SCO unit table
296 Write_Line
("SCO Unit Table");
297 Write_Line
("--------------");
299 for Index
in 1 .. SCO_Unit_Table
.Last
loop
301 UTE
: SCO_Unit_Table_Entry
renames SCO_Unit_Table
.Table
(Index
);
305 Write_Int
(Int
(Index
));
306 Write_Str
(" Dep_Num = ");
307 Write_Int
(Int
(UTE
.Dep_Num
));
308 Write_Str
(" From = ");
309 Write_Int
(Int
(UTE
.From
));
310 Write_Str
(" To = ");
311 Write_Int
(Int
(UTE
.To
));
313 Write_Str
(" File_Name = """);
315 if UTE
.File_Name
/= null then
316 Write_Str
(UTE
.File_Name
.all);
324 -- Dump SCO Unit number table if it contains any entries
326 if SCO_Unit_Number_Table
.Last
>= 1 then
328 Write_Line
("SCO Unit Number Table");
329 Write_Line
("---------------------");
331 for Index
in 1 .. SCO_Unit_Number_Table
.Last
loop
333 Write_Int
(Int
(Index
));
334 Write_Str
(". Unit_Number = ");
335 Write_Int
(Int
(SCO_Unit_Number_Table
.Table
(Index
)));
340 -- Dump SCO raw-table
343 Write_Line
("SCO Raw Table");
344 Write_Line
("---------");
346 if SCO_Generation_State
= Filtered
then
347 Write_Line
("Empty (free'd after second pass)");
349 for Index
in 1 .. SCO_Raw_Table
.Last
loop
350 Dump_Entry
(Index
, SCO_Raw_Table
.Table
(Index
));
354 -- Dump SCO table itself
357 Write_Line
("SCO Filtered Table");
358 Write_Line
("---------");
360 for Index
in 1 .. SCO_Table
.Last
loop
361 Dump_Entry
(Index
, SCO_Table
.Table
(Index
));
369 function Equal
(F1
, F2
: Source_Ptr
) return Boolean is
378 function "<" (S1
, S2
: Source_Location
) return Boolean is
380 return S1
.Line
< S2
.Line
381 or else (S1
.Line
= S2
.Line
and then S1
.Col
< S2
.Col
);
388 function Has_Decision
(N
: Node_Id
) return Boolean is
390 function Check_Node
(N
: Node_Id
) return Traverse_Result
;
391 -- Determine if Nkind (N) indicates the presence of a decision (i.e.
392 -- N is a logical operator, which is a decision in itself, or an
393 -- IF-expression whose Condition attribute is a decision).
399 function Check_Node
(N
: Node_Id
) return Traverse_Result
is
401 -- If we are not sure this is a logical operator (AND and OR may be
402 -- turned into logical operators with the Short_Circuit_And_Or
403 -- pragma), assume it is. Putative decisions will be discarded if
404 -- needed in the secord pass.
406 if Is_Logical_Operator
(N
) /= False
407 or else Nkind
(N
) = N_If_Expression
415 function Traverse
is new Traverse_Func
(Check_Node
);
417 -- Start of processing for Has_Decision
420 return Traverse
(N
) = Abandon
;
427 function Hash
(F
: Source_Ptr
) return Header_Num
is
429 return Header_Num
(Nat
(F
) mod 997);
436 procedure Initialize
is
438 SCO_Unit_Number_Table
.Init
;
440 -- The SCO_Unit_Number_Table entry with index 0 is intentionally set
441 -- aside to be used as temporary for sorting.
443 SCO_Unit_Number_Table
.Increment_Last
;
446 -------------------------
447 -- Is_Logical_Operator --
448 -------------------------
450 function Is_Logical_Operator
(N
: Node_Id
) return Tristate
is
452 if Nkind_In
(N
, N_Op_Not
, N_And_Then
, N_Or_Else
) then
454 elsif Nkind_In
(N
, N_Op_And
, N_Op_Or
) then
459 end Is_Logical_Operator
;
461 -----------------------
462 -- Process_Decisions --
463 -----------------------
465 -- Version taking a list
467 procedure Process_Decisions
470 Pragma_Sloc
: Source_Ptr
)
476 while Present
(N
) loop
477 Process_Decisions
(N
, T
, Pragma_Sloc
);
481 end Process_Decisions
;
483 -- Version taking a node
485 Current_Pragma_Sloc
: Source_Ptr
:= No_Location
;
486 -- While processing a pragma, this is set to the sloc of the N_Pragma node
488 procedure Process_Decisions
491 Pragma_Sloc
: Source_Ptr
)
494 -- This is used to mark the location of a decision sequence in the SCO
495 -- table. We use it for backing out a simple decision in an expression
496 -- context that contains only NOT operators.
499 -- Likewise for the putative SCO_Raw_Hash_Table entries: see below
501 type Hash_Entry
is record
505 -- We must register all conditions/pragmas in SCO_Raw_Hash_Table.
506 -- However we cannot register them in the same time we are adding the
507 -- corresponding SCO entries to the raw table since we may discard them
508 -- later on. So instead we put all putative conditions into Hash_Entries
509 -- (see below) and register them once we are sure we keep them.
511 -- This data structure holds the conditions/pragmas to register in
512 -- SCO_Raw_Hash_Table.
514 package Hash_Entries
is new Table
.Table
(
515 Table_Component_Type
=> Hash_Entry
,
516 Table_Index_Type
=> Nat
,
517 Table_Low_Bound
=> 1,
519 Table_Increment
=> 10,
520 Table_Name
=> "Hash_Entries");
521 -- Hold temporarily (i.e. free'd before returning) the Hash_Entry before
522 -- they are registered in SCO_Raw_Hash_Table.
524 X_Not_Decision
: Boolean;
525 -- This flag keeps track of whether a decision sequence in the SCO table
526 -- contains only NOT operators, and is for an expression context (T=X).
527 -- The flag will be set False if T is other than X, or if an operator
528 -- other than NOT is in the sequence.
530 function Process_Node
(N
: Node_Id
) return Traverse_Result
;
531 -- Processes one node in the traversal, looking for logical operators,
532 -- and if one is found, outputs the appropriate table entries.
534 procedure Output_Decision_Operand
(N
: Node_Id
);
535 -- The node N is the top level logical operator of a decision, or it is
536 -- one of the operands of a logical operator belonging to a single
537 -- complex decision. This routine outputs the sequence of table entries
538 -- corresponding to the node. Note that we do not process the sub-
539 -- operands to look for further decisions, that processing is done in
540 -- Process_Decision_Operand, because we can't get decisions mixed up in
541 -- the global table. Call has no effect if N is Empty.
543 procedure Output_Element
(N
: Node_Id
);
544 -- Node N is an operand of a logical operator that is not itself a
545 -- logical operator, or it is a simple decision. This routine outputs
546 -- the table entry for the element, with C1 set to ' '. Last is set
547 -- False, and an entry is made in the condition hash table.
549 procedure Output_Header
(T
: Character);
550 -- Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
551 -- PRAGMA, and 'X' for the expression case.
553 procedure Process_Decision_Operand
(N
: Node_Id
);
554 -- This is called on node N, the top level node of a decision, or on one
555 -- of its operands or suboperands after generating the full output for
556 -- the complex decision. It process the suboperands of the decision
557 -- looking for nested decisions.
559 -----------------------------
560 -- Output_Decision_Operand --
561 -----------------------------
563 procedure Output_Decision_Operand
(N
: Node_Id
) is
565 -- C1 holds a character that identifies the operation while C2
566 -- indicates whether we are sure (' ') or not ('?') this operation
567 -- belongs to the decision. '?' entries will be filtered out in the
568 -- second (SCO_Record_Filtered) pass.
578 T
:= Is_Logical_Operator
(N
);
583 if Nkind
(N
) = N_Op_Not
then
590 if Nkind_In
(N
, N_Op_Or
, N_Or_Else
) then
592 else pragma Assert
(Nkind_In
(N
, N_Op_And
, N_And_Then
));
610 Hash_Entries
.Append
((Sloc
(N
), SCO_Raw_Table
.Last
));
612 Output_Decision_Operand
(L
);
613 Output_Decision_Operand
(Right_Opnd
(N
));
615 -- Not a logical operator
620 end Output_Decision_Operand
;
626 procedure Output_Element
(N
: Node_Id
) is
630 Sloc_Range
(N
, FSloc
, LSloc
);
637 Hash_Entries
.Append
((FSloc
, SCO_Raw_Table
.Last
));
644 procedure Output_Header
(T
: Character) is
645 Loc
: Source_Ptr
:= No_Location
;
646 -- Node whose Sloc is used for the decision
648 Nam
: Name_Id
:= No_Name
;
649 -- For the case of an aspect, aspect name
653 when 'I' |
'E' |
'W' |
'a' |
'A' =>
655 -- For IF, EXIT, WHILE, or aspects, the token SLOC is that of
656 -- the parent of the expression.
658 Loc
:= Sloc
(Parent
(N
));
660 if T
= 'a' or else T
= 'A' then
661 Nam
:= Chars
(Identifier
(Parent
(N
)));
666 -- For entry guard, the token sloc is from the N_Entry_Body.
667 -- For PRAGMA, we must get the location from the pragma node.
668 -- Argument N is the pragma argument, and we have to go up
669 -- two levels (through the pragma argument association) to
670 -- get to the pragma node itself. For the guard on a select
671 -- alternative, we do not have access to the token location for
672 -- the WHEN, so we use the first sloc of the condition itself
673 -- (note: we use First_Sloc, not Sloc, because this is what is
674 -- referenced by dominance markers).
676 -- Doesn't this requirement of using First_Sloc need to be
677 -- documented in the spec ???
679 if Nkind_In
(Parent
(N
), N_Accept_Alternative
,
681 N_Terminate_Alternative
)
683 Loc
:= First_Sloc
(N
);
685 Loc
:= Sloc
(Parent
(Parent
(N
)));
690 -- For an expression, no Sloc
694 -- No other possibilities
706 Pragma_Sloc
=> Pragma_Sloc
,
707 Pragma_Aspect_Name
=> Nam
);
709 -- For an aspect specification, which will be rewritten into a
710 -- pragma, enter a hash table entry now.
713 Hash_Entries
.Append
((Loc
, SCO_Raw_Table
.Last
));
717 ------------------------------
718 -- Process_Decision_Operand --
719 ------------------------------
721 procedure Process_Decision_Operand
(N
: Node_Id
) is
723 if Is_Logical_Operator
(N
) /= False then
724 if Nkind
(N
) /= N_Op_Not
then
725 Process_Decision_Operand
(Left_Opnd
(N
));
726 X_Not_Decision
:= False;
729 Process_Decision_Operand
(Right_Opnd
(N
));
732 Process_Decisions
(N
, 'X', Pragma_Sloc
);
734 end Process_Decision_Operand
;
740 function Process_Node
(N
: Node_Id
) return Traverse_Result
is
744 -- Logical operators, output table entries and then process
745 -- operands recursively to deal with nested conditions.
747 when N_And_Then | N_Or_Else | N_Op_Not | N_Op_And | N_Op_Or
=>
752 -- If outer level, then type comes from call, otherwise it
753 -- is more deeply nested and counts as X for expression.
755 if N
= Process_Decisions
.N
then
756 T
:= Process_Decisions
.T
;
761 -- Output header for sequence
763 X_Not_Decision
:= T
= 'X' and then Nkind
(N
) = N_Op_Not
;
764 Mark
:= SCO_Raw_Table
.Last
;
765 Mark_Hash
:= Hash_Entries
.Last
;
768 -- Output the decision
770 Output_Decision_Operand
(N
);
772 -- If the decision was in an expression context (T = 'X')
773 -- and contained only NOT operators, then we don't output
776 if X_Not_Decision
then
777 SCO_Raw_Table
.Set_Last
(Mark
);
778 Hash_Entries
.Set_Last
(Mark_Hash
);
780 -- Otherwise, set Last in last table entry to mark end
783 SCO_Raw_Table
.Table
(SCO_Raw_Table
.Last
).Last
:= True;
786 -- Process any embedded decisions
788 Process_Decision_Operand
(N
);
794 -- Really hard to believe this is correct given the special
795 -- handling for if expressions below ???
797 when N_Case_Expression
=>
800 -- If expression, processed like an if statement
802 when N_If_Expression
=>
804 Cond
: constant Node_Id
:= First
(Expressions
(N
));
805 Thnx
: constant Node_Id
:= Next
(Cond
);
806 Elsx
: constant Node_Id
:= Next
(Thnx
);
808 Process_Decisions
(Cond
, 'I', Pragma_Sloc
);
809 Process_Decisions
(Thnx
, 'X', Pragma_Sloc
);
810 Process_Decisions
(Elsx
, 'X', Pragma_Sloc
);
814 -- All other cases, continue scan
822 procedure Traverse
is new Traverse_Proc
(Process_Node
);
824 -- Start of processing for Process_Decisions
833 -- See if we have simple decision at outer level and if so then
834 -- generate the decision entry for this simple decision. A simple
835 -- decision is a boolean expression (which is not a logical operator
836 -- or short circuit form) appearing as the operand of an IF, WHILE,
837 -- EXIT WHEN, or special PRAGMA construct.
839 if T
/= 'X' and then Is_Logical_Operator
(N
) = False then
843 -- Change Last in last table entry to True to mark end of
844 -- sequence, which is this case is only one element long.
846 SCO_Raw_Table
.Table
(SCO_Raw_Table
.Last
).Last
:= True;
851 -- Now we have the definitive set of SCO entries, register them in the
852 -- corresponding hash table.
854 for J
in 1 .. Hash_Entries
.Last
loop
855 SCO_Raw_Hash_Table
.Set
856 (Hash_Entries
.Table
(J
).Sloc
,
857 Hash_Entries
.Table
(J
).SCO_Index
);
861 end Process_Decisions
;
869 procedure Write_Info_Char
(C
: Character) renames Write_Char
;
870 -- Write one character;
872 procedure Write_Info_Initiate
(Key
: Character) renames Write_Char
;
873 -- Start new one and write one character;
875 procedure Write_Info_Nat
(N
: Nat
);
878 procedure Write_Info_Terminate
renames Write_Eol
;
879 -- Terminate current line
885 procedure Write_Info_Nat
(N
: Nat
) is
890 procedure Debug_Put_SCOs
is new Put_SCOs
;
892 -- Start of processing for pscos
898 ---------------------
899 -- Record_Instance --
900 ---------------------
902 procedure Record_Instance
(Id
: Instance_Id
; Inst_Sloc
: Source_Ptr
) is
903 Inst_Src
: constant Source_File_Index
:=
904 Get_Source_File_Index
(Inst_Sloc
);
906 SCO_Instance_Table
.Append
907 ((Inst_Dep_Num
=> Dependency_Num
(Unit
(Inst_Src
)),
908 Inst_Loc
=> To_Source_Location
(Inst_Sloc
),
909 Enclosing_Instance
=> SCO_Instance_Index
(Instance
(Inst_Src
))));
911 (SCO_Instance_Table
.Last
= SCO_Instance_Index
(Id
));
918 procedure SCO_Output
is
919 procedure Populate_SCO_Instance_Table
is
920 new Sinput
.Iterate_On_Instances
(Record_Instance
);
922 pragma Assert
(SCO_Generation_State
= Filtered
);
924 if Debug_Flag_Dot_OO
then
928 Populate_SCO_Instance_Table
;
930 -- Sort the unit tables based on dependency numbers
932 Unit_Table_Sort
: declare
934 function Lt
(Op1
, Op2
: Natural) return Boolean;
935 -- Comparison routine for sort call
937 procedure Move
(From
: Natural; To
: Natural);
938 -- Move routine for sort call
944 function Lt
(Op1
, Op2
: Natural) return Boolean is
948 (SCO_Unit_Number_Table
.Table
(SCO_Unit_Index
(Op1
)))
951 (SCO_Unit_Number_Table
.Table
(SCO_Unit_Index
(Op2
)));
958 procedure Move
(From
: Natural; To
: Natural) is
960 SCO_Unit_Table
.Table
(SCO_Unit_Index
(To
)) :=
961 SCO_Unit_Table
.Table
(SCO_Unit_Index
(From
));
962 SCO_Unit_Number_Table
.Table
(SCO_Unit_Index
(To
)) :=
963 SCO_Unit_Number_Table
.Table
(SCO_Unit_Index
(From
));
966 package Sorting
is new GNAT
.Heap_Sort_G
(Move
, Lt
);
968 -- Start of processing for Unit_Table_Sort
971 Sorting
.Sort
(Integer (SCO_Unit_Table
.Last
));
974 -- Loop through entries in the unit table to set file name and
975 -- dependency number entries.
977 for J
in 1 .. SCO_Unit_Table
.Last
loop
979 U
: constant Unit_Number_Type
:= SCO_Unit_Number_Table
.Table
(J
);
980 UTE
: SCO_Unit_Table_Entry
renames SCO_Unit_Table
.Table
(J
);
982 Get_Name_String
(Reference_Name
(Source_Index
(U
)));
983 UTE
.File_Name
:= new String'(Name_Buffer (1 .. Name_Len));
984 UTE.Dep_Num := Dependency_Num (U);
988 -- Now the tables are all setup for output to the ALI file
990 Write_SCOs_To_ALI_File;
993 -------------------------
994 -- SCO_Pragma_Disabled --
995 -------------------------
997 function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is
1001 if Loc = No_Location then
1005 Index := SCO_Raw_Hash_Table.Get (Loc);
1007 -- The test here for zero is to deal with possible previous errors, and
1008 -- for the case of pragma statement SCOs, for which we always set the
1009 -- Pragma_Sloc even if the particular pragma cannot be specifically
1014 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
1024 -- Aspect decision (enabled)
1029 -- Aspect decision (not enabled)
1034 -- Nullified disabled SCO
1039 raise Program_Error;
1046 end SCO_Pragma_Disabled;
1048 --------------------
1049 -- SCO_Record_Raw --
1050 --------------------
1052 procedure SCO_Record_Raw (U : Unit_Number_Type) is
1056 procedure Traverse_Aux_Decls (N : Node_Id);
1057 -- Traverse the Aux_Decls_Node of compilation unit N
1059 ------------------------
1060 -- Traverse_Aux_Decls --
1061 ------------------------
1063 procedure Traverse_Aux_Decls (N : Node_Id) is
1064 ADN : constant Node_Id := Aux_Decls_Node (N);
1066 Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
1067 Traverse_Declarations_Or_Statements (Pragmas_After (ADN));
1069 -- Declarations and Actions do not correspond to source constructs,
1070 -- they contain only nodes from expansion, so at this point they
1071 -- should still be empty:
1073 pragma Assert (No (Declarations (ADN)));
1074 pragma Assert (No (Actions (ADN)));
1075 end Traverse_Aux_Decls;
1077 -- Start of processing for SCO_Record_Raw
1080 -- It is legitimate to run this pass multiple times (once per unit) so
1081 -- run it even if it was already run before.
1083 pragma Assert (SCO_Generation_State in None .. Raw);
1084 SCO_Generation_State := Raw;
1086 -- Ignore call if not generating code and generating SCO's
1088 if not (Generate_SCO and then Operating_Mode = Generate_Code) then
1092 -- Ignore call if this unit already recorded
1094 for J in 1 .. SCO_Unit_Number_Table.Last loop
1095 if U = SCO_Unit_Number_Table.Table (J) then
1100 -- Otherwise record starting entry
1102 From := SCO_Raw_Table.Last + 1;
1104 -- Get Unit (checking case of subunit)
1106 Lu := Unit (Cunit (U));
1108 if Nkind (Lu) = N_Subunit then
1109 Lu := Proper_Body (Lu);
1112 -- Traverse the unit
1114 Traverse_Aux_Decls (Cunit (U));
1118 N_Package_Declaration |
1120 N_Subprogram_Declaration |
1122 N_Generic_Package_Declaration |
1125 N_Generic_Instantiation =>
1127 Traverse_Declarations_Or_Statements (L => No_List, P => Lu);
1131 -- All other cases of compilation units (e.g. renamings), generate
1132 -- no SCO information.
1137 -- Make entry for new unit in unit tables, we will fill in the file
1138 -- name and dependency numbers later.
1140 SCO_Unit_Table.Append (
1143 File_Index => Get_Source_File_Index (Sloc (Lu)),
1145 To => SCO_Raw_Table.Last));
1147 SCO_Unit_Number_Table.Append (U);
1150 -----------------------
1151 -- Set_SCO_Condition --
1152 -----------------------
1154 procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is
1156 -- SCO annotations are not processed after the filtering pass
1158 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1160 Orig : constant Node_Id := Original_Node (Cond);
1165 Constant_Condition_Code : constant array (Boolean) of Character :=
1166 (False => 'f
', True => 't
');
1168 Sloc_Range (Orig, Start, Dummy);
1169 Index := SCO_Raw_Hash_Table.Get (Start);
1171 -- Index can be zero for boolean expressions that do not have SCOs
1172 -- (simple decisions outside of a control flow structure), or in case
1173 -- of a previous error.
1179 pragma Assert (SCO_Raw_Table.Table (Index).C1 = ' ');
1180 SCO_Raw_Table.Table (Index).C2 := Constant_Condition_Code (Val);
1182 end Set_SCO_Condition;
1184 ------------------------------
1185 -- Set_SCO_Logical_Operator --
1186 ------------------------------
1188 procedure Set_SCO_Logical_Operator (Op : Node_Id) is
1190 -- SCO annotations are not processed after the filtering pass
1192 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1194 Orig : constant Node_Id := Original_Node (Op);
1195 Orig_Sloc : constant Source_Ptr := Sloc (Orig);
1196 Index : constant Nat := SCO_Raw_Hash_Table.Get (Orig_Sloc);
1199 -- All (putative) logical operators are supposed to have their own entry
1200 -- in the SCOs table. However, the semantic analysis may invoke this
1201 -- subprogram with nodes that are out of the SCO generation scope.
1204 SCO_Raw_Table.Table (Index).C2 := ' ';
1206 end Set_SCO_Logical_Operator;
1208 ----------------------------
1209 -- Set_SCO_Pragma_Enabled --
1210 ----------------------------
1212 procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is
1214 -- SCO annotations are not processed after the filtering pass
1216 pragma Assert (not Generate_SCO or else SCO_Generation_State = Raw);
1221 -- Nothing to do if not generating SCO, or if we're not processing the
1222 -- original source occurrence of the pragma.
1224 if not (Generate_SCO
1225 and then In_Extended_Main_Source_Unit (Loc)
1226 and then not (In_Instance or In_Inlined_Body))
1231 -- Note: the reason we use the Sloc value as the key is that in the
1232 -- generic case, the call to this procedure is made on a copy of the
1233 -- original node, so we can't use the Node_Id value.
1235 Index := SCO_Raw_Hash_Table.Get (Loc);
1237 -- A zero index here indicates that semantic analysis found an
1238 -- activated pragma at Loc which does not have a corresponding pragma
1239 -- or aspect at the syntax level. This may occur in legitimate cases
1240 -- because of expanded code (such are Pre/Post conditions generated for
1241 -- formal parameter validity checks), or as a consequence of a previous
1249 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
1252 -- Note: may be called multiple times for the same sloc, so
1253 -- account for the fact that the entry may already have been
1257 -- Aspect (decision SCO)
1265 -- Pragma (statement SCO)
1268 pragma Assert (T.C2 = 'p
' or else T.C2 = 'P
');
1272 raise Program_Error;
1276 end Set_SCO_Pragma_Enabled;
1278 -------------------------
1279 -- Set_Raw_Table_Entry --
1280 -------------------------
1282 procedure Set_Raw_Table_Entry
1288 Pragma_Sloc : Source_Ptr := No_Location;
1289 Pragma_Aspect_Name : Name_Id := No_Name)
1291 pragma Assert (SCO_Generation_State = Raw);
1293 SCO_Raw_Table.Append
1296 From => To_Source_Location (From),
1297 To => To_Source_Location (To),
1299 Pragma_Sloc => Pragma_Sloc,
1300 Pragma_Aspect_Name => Pragma_Aspect_Name));
1301 end Set_Raw_Table_Entry;
1303 ------------------------
1304 -- To_Source_Location --
1305 ------------------------
1307 function To_Source_Location (S : Source_Ptr) return Source_Location is
1309 if S = No_Location then
1310 return No_Source_Location;
1313 (Line => Get_Logical_Line_Number (S),
1314 Col => Get_Column_Number (S));
1316 end To_Source_Location;
1318 -----------------------------------------
1319 -- Traverse_Declarations_Or_Statements --
1320 -----------------------------------------
1322 -- Tables used by Traverse_Declarations_Or_Statements for temporarily
1323 -- holding statement and decision entries. These are declared globally
1324 -- since they are shared by recursive calls to this procedure.
1326 type SC_Entry is record
1332 -- Used to store a single entry in the following table, From:To represents
1333 -- the range of entries in the CS line entry, and typ is the type, with
1334 -- space meaning that no type letter will accompany the entry.
1336 package SC is new Table.Table (
1337 Table_Component_Type => SC_Entry,
1338 Table_Index_Type => Nat,
1339 Table_Low_Bound => 1,
1340 Table_Initial => 1000,
1341 Table_Increment => 200,
1342 Table_Name => "SCO_SC");
1343 -- Used to store statement components for a CS entry to be output
1344 -- as a result of the call to this procedure. SC.Last is the last
1345 -- entry stored, so the current statement sequence is represented
1346 -- by SC_Array (SC_First .. SC.Last), where SC_First is saved on
1347 -- entry to each recursive call to the routine.
1349 -- Extend_Statement_Sequence adds an entry to this array, and then
1350 -- Set_Statement_Entry clears the entries starting with SC_First,
1351 -- copying these entries to the main SCO output table. The reason that
1352 -- we do the temporary caching of results in this array is that we want
1353 -- the SCO table entries for a given CS line to be contiguous, and the
1354 -- processing may output intermediate entries such as decision entries.
1356 type SD_Entry is record
1362 -- Used to store a single entry in the following table. Nod is the node to
1363 -- be searched for decisions for the case of Process_Decisions_Defer with a
1364 -- node argument (with Lst set to No_List. Lst is the list to be searched
1365 -- for decisions for the case of Process_Decisions_Defer with a List
1366 -- argument (in which case Nod is set to Empty). Plo is the sloc of the
1367 -- enclosing pragma, if any.
1369 package SD is new Table.Table (
1370 Table_Component_Type => SD_Entry,
1371 Table_Index_Type => Nat,
1372 Table_Low_Bound => 1,
1373 Table_Initial => 1000,
1374 Table_Increment => 200,
1375 Table_Name => "SCO_SD");
1376 -- Used to store possible decision information. Instead of calling the
1377 -- Process_Decisions procedures directly, we call Process_Decisions_Defer,
1378 -- which simply stores the arguments in this table. Then when we clear
1379 -- out a statement sequence using Set_Statement_Entry, after generating
1380 -- the CS lines for the statements, the entries in this table result in
1381 -- calls to Process_Decision. The reason for doing things this way is to
1382 -- ensure that decisions are output after the CS line for the statements
1383 -- in which the decisions occur.
1385 procedure Traverse_Declarations_Or_Statements
1387 D : Dominant_Info := No_Dominant;
1388 P : Node_Id := Empty)
1390 Discard_Dom : Dominant_Info;
1391 pragma Warnings (Off, Discard_Dom);
1393 Discard_Dom := Traverse_Declarations_Or_Statements (L, D, P);
1394 end Traverse_Declarations_Or_Statements;
1396 function Traverse_Declarations_Or_Statements
1398 D : Dominant_Info := No_Dominant;
1399 P : Node_Id := Empty) return Dominant_Info
1401 Current_Dominant : Dominant_Info := D;
1402 -- Dominance information for the current basic block
1404 Current_Test : Node_Id;
1405 -- Conditional node (N_If_Statement or N_Elsiif being processed
1409 SC_First : constant Nat := SC.Last + 1;
1410 SD_First : constant Nat := SD.Last + 1;
1411 -- Record first entries used in SC/SD at this recursive level
1413 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
1414 -- Extend the current statement sequence to encompass the node N. Typ
1415 -- is the letter that identifies the type of statement/declaration that
1416 -- is being added to the sequence.
1418 procedure Set_Statement_Entry;
1419 -- Output CS entries for all statements saved in table SC, and end the
1420 -- current CS sequence. Then output entries for all decisions nested in
1421 -- these statements, which have been deferred so far.
1423 procedure Process_Decisions_Defer (N : Node_Id; T : Character);
1424 pragma Inline (Process_Decisions_Defer);
1425 -- This routine is logically the same as Process_Decisions, except that
1426 -- the arguments are saved in the SD table for later processing when
1427 -- Set_Statement_Entry is called, which goes through the saved entries
1428 -- making the corresponding calls to Process_Decision.
1430 procedure Process_Decisions_Defer (L : List_Id; T : Character);
1431 pragma Inline (Process_Decisions_Defer);
1432 -- Same case for list arguments, deferred call to Process_Decisions
1434 procedure Traverse_One (N : Node_Id);
1435 -- Traverse one declaration or statement
1437 procedure Traverse_Aspects (N : Node_Id);
1438 -- Helper for Traverse_One: traverse N's aspect specifications
1440 -------------------------
1441 -- Set_Statement_Entry --
1442 -------------------------
1444 procedure Set_Statement_Entry is
1445 SC_Last : constant Int := SC.Last;
1446 SD_Last : constant Int := SD.Last;
1449 -- Output statement entries from saved entries in SC table
1451 for J in SC_First .. SC_Last loop
1452 if J = SC_First then
1454 if Current_Dominant /= No_Dominant then
1456 From, To : Source_Ptr;
1458 Sloc_Range (Current_Dominant.N, From, To);
1459 if Current_Dominant.K /= 'E
' then
1464 C2 => Current_Dominant.K,
1468 Pragma_Sloc => No_Location,
1469 Pragma_Aspect_Name => No_Name);
1475 SCE : SC_Entry renames SC.Table (J);
1476 Pragma_Sloc : Source_Ptr := No_Location;
1477 Pragma_Aspect_Name : Name_Id := No_Name;
1479 -- For the case of a statement SCO for a pragma controlled by
1480 -- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
1481 -- those of any nested decision) is emitted only if the pragma
1484 if SCE.Typ = 'p
' then
1485 Pragma_Sloc := SCE.From;
1486 SCO_Raw_Hash_Table.Set
1487 (Pragma_Sloc, SCO_Raw_Table.Last + 1);
1488 Pragma_Aspect_Name := Pragma_Name (SCE.N);
1489 pragma Assert (Pragma_Aspect_Name /= No_Name);
1491 elsif SCE.Typ = 'P
' then
1492 Pragma_Aspect_Name := Pragma_Name (SCE.N);
1493 pragma Assert (Pragma_Aspect_Name /= No_Name);
1501 Last => (J = SC_Last),
1502 Pragma_Sloc => Pragma_Sloc,
1503 Pragma_Aspect_Name => Pragma_Aspect_Name);
1507 -- Last statement of basic block, if present, becomes new current
1510 if SC_Last >= SC_First then
1511 Current_Dominant := ('S
', SC.Table (SC_Last).N);
1514 -- Clear out used section of SC table
1516 SC.Set_Last (SC_First - 1);
1518 -- Output any embedded decisions
1520 for J in SD_First .. SD_Last loop
1522 SDE : SD_Entry renames SD.Table (J);
1524 if Present (SDE.Nod) then
1525 Process_Decisions (SDE.Nod, SDE.Typ, SDE.Plo);
1527 Process_Decisions (SDE.Lst, SDE.Typ, SDE.Plo);
1532 -- Clear out used section of SD table
1534 SD.Set_Last (SD_First - 1);
1535 end Set_Statement_Entry;
1537 -------------------------------
1538 -- Extend_Statement_Sequence --
1539 -------------------------------
1541 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
1545 To_Node : Node_Id := Empty;
1548 Sloc_Range (N, F, T);
1551 when N_Accept_Statement =>
1552 if Present (Parameter_Specifications (N)) then
1553 To_Node := Last (Parameter_Specifications (N));
1554 elsif Present (Entry_Index (N)) then
1555 To_Node := Entry_Index (N);
1558 when N_Case_Statement =>
1559 To_Node := Expression (N);
1561 when N_If_Statement | N_Elsif_Part =>
1562 To_Node := Condition (N);
1564 when N_Extended_Return_Statement =>
1565 To_Node := Last (Return_Object_Declarations (N));
1567 when N_Loop_Statement =>
1568 To_Node := Iteration_Scheme (N);
1570 when N_Selective_Accept |
1571 N_Timed_Entry_Call |
1572 N_Conditional_Entry_Call |
1573 N_Asynchronous_Select |
1574 N_Single_Protected_Declaration |
1575 N_Single_Task_Declaration =>
1578 when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
1579 if Has_Aspects (N) then
1580 To_Node := Last (Aspect_Specifications (N));
1582 elsif Present (Discriminant_Specifications (N)) then
1583 To_Node := Last (Discriminant_Specifications (N));
1586 To_Node := Defining_Identifier (N);
1594 if Present (To_Node) then
1595 Sloc_Range (To_Node, Dummy, T);
1598 SC.Append ((N, F, T, Typ));
1599 end Extend_Statement_Sequence;
1601 -----------------------------
1602 -- Process_Decisions_Defer --
1603 -----------------------------
1605 procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
1607 SD.Append ((N, No_List, T, Current_Pragma_Sloc));
1608 end Process_Decisions_Defer;
1610 procedure Process_Decisions_Defer (L : List_Id; T : Character) is
1612 SD.Append ((Empty, L, T, Current_Pragma_Sloc));
1613 end Process_Decisions_Defer;
1615 ----------------------
1616 -- Traverse_Aspects --
1617 ----------------------
1619 procedure Traverse_Aspects (N : Node_Id) is
1625 AN := First (Aspect_Specifications (N));
1626 while Present (AN) loop
1627 AE := Expression (AN);
1629 -- SCOs are generated before semantic analysis/expansion:
1630 -- PPCs are not split yet.
1632 pragma Assert (not Split_PPC (AN));
1636 case Get_Aspect_Id (AN) is
1638 -- Aspects rewritten into pragmas controlled by a Check_Policy:
1639 -- Current_Pragma_Sloc must be set to the sloc of the aspect
1640 -- specification. The corresponding pragma will have the same
1644 Aspect_Precondition |
1646 Aspect_Postcondition |
1651 -- Aspects whose checks are generated in client units,
1652 -- regardless of whether or not the check is activated in the
1653 -- unit which contains the declaration: create decision as
1654 -- unconditionally enabled aspect (but still make a pragma
1655 -- entry since Set_SCO_Pragma_Enabled will be called when
1656 -- analyzing actual checks, possibly in other units).
1658 -- Pre/post can have checks in client units too because of
1659 -- inheritance, so should they be moved here???
1661 when Aspect_Predicate |
1662 Aspect_Static_Predicate |
1663 Aspect_Dynamic_Predicate |
1664 Aspect_Type_Invariant =>
1668 -- Other aspects: just process any decision nested in the
1669 -- aspect expression.
1673 if Has_Decision (AE) then
1679 if C1 /= ASCII.NUL then
1680 pragma Assert (Current_Pragma_Sloc = No_Location);
1682 if C1 = 'a
' or else C1 = 'A
' then
1683 Current_Pragma_Sloc := Sloc (AN);
1686 Process_Decisions_Defer (AE, C1);
1688 Current_Pragma_Sloc := No_Location;
1693 end Traverse_Aspects;
1699 procedure Traverse_One (N : Node_Id) is
1701 -- Initialize or extend current statement sequence. Note that for
1702 -- special cases such as IF and Case statements we will modify
1703 -- the range to exclude internal statements that should not be
1704 -- counted as part of the current statement sequence.
1708 -- Package declaration
1710 when N_Package_Declaration =>
1711 Set_Statement_Entry;
1712 Traverse_Package_Declaration (N, Current_Dominant);
1714 -- Generic package declaration
1716 when N_Generic_Package_Declaration =>
1717 Set_Statement_Entry;
1718 Traverse_Generic_Package_Declaration (N);
1722 when N_Package_Body =>
1723 Set_Statement_Entry;
1724 Traverse_Package_Body (N);
1726 -- Subprogram declaration or subprogram body stub
1728 when N_Subprogram_Declaration | N_Subprogram_Body_Stub =>
1729 Process_Decisions_Defer
1730 (Parameter_Specifications (Specification (N)), 'X
');
1732 -- Entry declaration
1734 when N_Entry_Declaration =>
1735 Process_Decisions_Defer (Parameter_Specifications (N), 'X
');
1737 -- Generic subprogram declaration
1739 when N_Generic_Subprogram_Declaration =>
1740 Process_Decisions_Defer
1741 (Generic_Formal_Declarations (N), 'X
');
1742 Process_Decisions_Defer
1743 (Parameter_Specifications (Specification (N)), 'X
');
1745 -- Task or subprogram body
1747 when N_Task_Body | N_Subprogram_Body =>
1748 Set_Statement_Entry;
1749 Traverse_Subprogram_Or_Task_Body (N);
1753 when N_Entry_Body =>
1755 Cond : constant Node_Id :=
1756 Condition (Entry_Body_Formal_Part (N));
1758 Inner_Dominant : Dominant_Info := No_Dominant;
1761 Set_Statement_Entry;
1763 if Present (Cond) then
1764 Process_Decisions_Defer (Cond, 'G
');
1766 -- For an entry body with a barrier, the entry body
1767 -- is dominanted by a True evaluation of the barrier.
1769 Inner_Dominant := ('T
', N);
1772 Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
1777 when N_Protected_Body =>
1778 Set_Statement_Entry;
1779 Traverse_Declarations_Or_Statements (Declarations (N));
1781 -- Exit statement, which is an exit statement in the SCO sense,
1782 -- so it is included in the current statement sequence, but
1783 -- then it terminates this sequence. We also have to process
1784 -- any decisions in the exit statement expression.
1786 when N_Exit_Statement =>
1787 Extend_Statement_Sequence (N, 'E
');
1788 Process_Decisions_Defer (Condition (N), 'E
');
1789 Set_Statement_Entry;
1791 -- If condition is present, then following statement is
1792 -- only executed if the condition evaluates to False.
1794 if Present (Condition (N)) then
1795 Current_Dominant := ('F
', N);
1797 Current_Dominant := No_Dominant;
1800 -- Label, which breaks the current statement sequence, but the
1801 -- label itself is not included in the next statement sequence,
1802 -- since it generates no code.
1805 Set_Statement_Entry;
1806 Current_Dominant := No_Dominant;
1808 -- Block statement, which breaks the current statement sequence
1810 when N_Block_Statement =>
1811 Set_Statement_Entry;
1813 -- The first statement in the handled sequence of statements
1814 -- is dominated by the elaboration of the last declaration.
1816 Current_Dominant := Traverse_Declarations_Or_Statements
1817 (L => Declarations (N),
1818 D => Current_Dominant);
1820 Traverse_Handled_Statement_Sequence
1821 (N => Handled_Statement_Sequence (N),
1822 D => Current_Dominant);
1824 -- If statement, which breaks the current statement sequence,
1825 -- but we include the condition in the current sequence.
1827 when N_If_Statement =>
1829 Extend_Statement_Sequence (N, 'I
');
1830 Process_Decisions_Defer (Condition (N), 'I
');
1831 Set_Statement_Entry;
1833 -- Now we traverse the statements in the THEN part
1835 Traverse_Declarations_Or_Statements
1836 (L => Then_Statements (N),
1839 -- Loop through ELSIF parts if present
1841 if Present (Elsif_Parts (N)) then
1843 Saved_Dominant : constant Dominant_Info :=
1846 Elif : Node_Id := First (Elsif_Parts (N));
1849 while Present (Elif) loop
1851 -- An Elsif is executed only if the previous test
1852 -- got a FALSE outcome.
1854 Current_Dominant := ('F
', Current_Test);
1856 -- Now update current test information
1858 Current_Test := Elif;
1860 -- We generate a statement sequence for the
1861 -- construct "ELSIF condition", so that we have
1862 -- a statement for the resulting decisions.
1864 Extend_Statement_Sequence (Elif, 'I
');
1865 Process_Decisions_Defer (Condition (Elif), 'I
');
1866 Set_Statement_Entry;
1868 -- An ELSIF part is never guaranteed to have
1869 -- been executed, following statements are only
1870 -- dominated by the initial IF statement.
1872 Current_Dominant := Saved_Dominant;
1874 -- Traverse the statements in the ELSIF
1876 Traverse_Declarations_Or_Statements
1877 (L => Then_Statements (Elif),
1884 -- Finally traverse the ELSE statements if present
1886 Traverse_Declarations_Or_Statements
1887 (L => Else_Statements (N),
1888 D => ('F
', Current_Test));
1890 -- CASE statement, which breaks the current statement sequence,
1891 -- but we include the expression in the current sequence.
1893 when N_Case_Statement =>
1894 Extend_Statement_Sequence (N, 'C
');
1895 Process_Decisions_Defer (Expression (N), 'X
');
1896 Set_Statement_Entry;
1898 -- Process case branches, all of which are dominated by the
1904 Alt := First (Alternatives (N));
1905 while Present (Alt) loop
1906 Traverse_Declarations_Or_Statements
1907 (L => Statements (Alt),
1908 D => Current_Dominant);
1915 when N_Accept_Statement =>
1916 Extend_Statement_Sequence (N, 'A
');
1917 Set_Statement_Entry;
1919 -- Process sequence of statements, dominant is the ACCEPT
1922 Traverse_Handled_Statement_Sequence
1923 (N => Handled_Statement_Sequence (N),
1924 D => Current_Dominant);
1928 when N_Selective_Accept =>
1929 Extend_Statement_Sequence (N, 'S
');
1930 Set_Statement_Entry;
1932 -- Process alternatives
1937 S_Dom : Dominant_Info;
1940 Alt := First (Select_Alternatives (N));
1941 while Present (Alt) loop
1942 S_Dom := Current_Dominant;
1943 Guard := Condition (Alt);
1945 if Present (Guard) then
1949 Pragma_Sloc => No_Location);
1950 Current_Dominant := ('T
', Guard);
1955 Current_Dominant := S_Dom;
1960 Traverse_Declarations_Or_Statements
1961 (L => Else_Statements (N),
1962 D => Current_Dominant);
1964 when N_Timed_Entry_Call | N_Conditional_Entry_Call =>
1965 Extend_Statement_Sequence (N, 'S
');
1966 Set_Statement_Entry;
1968 -- Process alternatives
1970 Traverse_One (Entry_Call_Alternative (N));
1972 if Nkind (N) = N_Timed_Entry_Call then
1973 Traverse_One (Delay_Alternative (N));
1975 Traverse_Declarations_Or_Statements
1976 (L => Else_Statements (N),
1977 D => Current_Dominant);
1980 when N_Asynchronous_Select =>
1981 Extend_Statement_Sequence (N, 'S
');
1982 Set_Statement_Entry;
1984 Traverse_One (Triggering_Alternative (N));
1985 Traverse_Declarations_Or_Statements
1986 (L => Statements (Abortable_Part (N)),
1987 D => Current_Dominant);
1989 when N_Accept_Alternative =>
1990 Traverse_Declarations_Or_Statements
1991 (L => Statements (N),
1992 D => Current_Dominant,
1993 P => Accept_Statement (N));
1995 when N_Entry_Call_Alternative =>
1996 Traverse_Declarations_Or_Statements
1997 (L => Statements (N),
1998 D => Current_Dominant,
1999 P => Entry_Call_Statement (N));
2001 when N_Delay_Alternative =>
2002 Traverse_Declarations_Or_Statements
2003 (L => Statements (N),
2004 D => Current_Dominant,
2005 P => Delay_Statement (N));
2007 when N_Triggering_Alternative =>
2008 Traverse_Declarations_Or_Statements
2009 (L => Statements (N),
2010 D => Current_Dominant,
2011 P => Triggering_Statement (N));
2013 when N_Terminate_Alternative =>
2015 -- It is dubious to emit a statement SCO for a TERMINATE
2016 -- alternative, since no code is actually executed if the
2017 -- alternative is selected -- the tasking runtime call just
2020 Extend_Statement_Sequence (N, ' ');
2021 Set_Statement_Entry;
2023 -- Unconditional exit points, which are included in the current
2024 -- statement sequence, but then terminate it
2026 when N_Requeue_Statement |
2028 N_Raise_Statement =>
2029 Extend_Statement_Sequence (N, ' ');
2030 Set_Statement_Entry;
2031 Current_Dominant := No_Dominant;
2033 -- Simple return statement. which is an exit point, but we
2034 -- have to process the return expression for decisions.
2036 when N_Simple_Return_Statement =>
2037 Extend_Statement_Sequence (N, ' ');
2038 Process_Decisions_Defer (Expression (N), 'X
');
2039 Set_Statement_Entry;
2040 Current_Dominant := No_Dominant;
2042 -- Extended return statement
2044 when N_Extended_Return_Statement =>
2045 Extend_Statement_Sequence (N, 'R
');
2046 Process_Decisions_Defer
2047 (Return_Object_Declarations (N), 'X
');
2048 Set_Statement_Entry;
2050 Traverse_Handled_Statement_Sequence
2051 (N => Handled_Statement_Sequence (N),
2052 D => Current_Dominant);
2054 Current_Dominant := No_Dominant;
2056 -- Loop ends the current statement sequence, but we include
2057 -- the iteration scheme if present in the current sequence.
2058 -- But the body of the loop starts a new sequence, since it
2059 -- may not be executed as part of the current sequence.
2061 when N_Loop_Statement =>
2063 ISC : constant Node_Id := Iteration_Scheme (N);
2064 Inner_Dominant : Dominant_Info := No_Dominant;
2067 if Present (ISC) then
2069 -- If iteration scheme present, extend the current
2070 -- statement sequence to include the iteration scheme
2071 -- and process any decisions it contains.
2075 if Present (Condition (ISC)) then
2076 Extend_Statement_Sequence (N, 'W
');
2077 Process_Decisions_Defer (Condition (ISC), 'W
');
2079 -- Set more specific dominant for inner statements
2080 -- (the control sloc for the decision is that of
2081 -- the WHILE token).
2083 Inner_Dominant := ('T
', ISC);
2088 Extend_Statement_Sequence (N, 'F
');
2089 Process_Decisions_Defer
2090 (Loop_Parameter_Specification (ISC), 'X
');
2094 Set_Statement_Entry;
2096 if Inner_Dominant = No_Dominant then
2097 Inner_Dominant := Current_Dominant;
2100 Traverse_Declarations_Or_Statements
2101 (L => Statements (N),
2102 D => Inner_Dominant);
2109 -- Record sloc of pragma (pragmas don't nest)
2111 pragma Assert (Current_Pragma_Sloc = No_Location);
2112 Current_Pragma_Sloc := Sloc (N);
2114 -- Processing depends on the kind of pragma
2117 Nam : constant Name_Id := Pragma_Name (N);
2119 First (Pragma_Argument_Associations (N));
2125 Name_Assert_And_Cut |
2128 Name_Loop_Invariant |
2130 Name_Postcondition =>
2132 -- For Assert/Check/Precondition/Postcondition, we
2133 -- must generate a P entry for the decision. Note
2134 -- that this is done unconditionally at this stage.
2135 -- Output for disabled pragmas is suppressed later
2136 -- on when we output the decision line in Put_SCOs,
2137 -- depending on setting by Set_SCO_Pragma_Enabled.
2139 if Nam = Name_Check then
2143 Process_Decisions_Defer (Expression (Arg), 'P
');
2146 -- Pre/postconditions can be inherited so SCO should
2147 -- never be deactivated???
2150 if Present (Arg) and then Present (Next (Arg)) then
2152 -- Case of a dyadic pragma Debug: first argument
2153 -- is a P decision, any nested decision in the
2154 -- second argument is an X decision.
2156 Process_Decisions_Defer (Expression (Arg), 'P
');
2160 Process_Decisions_Defer (Expression (Arg), 'X
');
2163 -- For all other pragmas, we generate decision entries
2164 -- for any embedded expressions, and the pragma is
2167 -- Should generate P decisions (not X) for assertion
2168 -- related pragmas: [Type_]Invariant,
2169 -- [{Static,Dynamic}_]Predicate???
2172 Process_Decisions_Defer (N, 'X
');
2176 -- Add statement SCO
2178 Extend_Statement_Sequence (N, Typ);
2180 Current_Pragma_Sloc := No_Location;
2183 -- Object declaration. Ignored if Prev_Ids is set, since the
2184 -- parser generates multiple instances of the whole declaration
2185 -- if there is more than one identifier declared, and we only
2186 -- want one entry in the SCOs, so we take the first, for which
2187 -- Prev_Ids is False.
2189 when N_Object_Declaration | N_Number_Declaration =>
2190 if not Prev_Ids (N) then
2191 Extend_Statement_Sequence (N, 'o
');
2193 if Has_Decision (N) then
2194 Process_Decisions_Defer (N, 'X
');
2198 -- All other cases, which extend the current statement sequence
2199 -- but do not terminate it, even if they have nested decisions.
2201 when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
2202 Extend_Statement_Sequence (N, 't
');
2203 Process_Decisions_Defer (Discriminant_Specifications (N), 'X
');
2204 Set_Statement_Entry;
2206 Traverse_Sync_Definition (N);
2208 when N_Single_Protected_Declaration | N_Single_Task_Declaration =>
2209 Extend_Statement_Sequence (N, 'o
');
2210 Set_Statement_Entry;
2212 Traverse_Sync_Definition (N);
2216 -- Determine required type character code, or ASCII.NUL if
2217 -- no SCO should be generated for this node.
2220 NK : constant Node_Kind := Nkind (N);
2225 when N_Full_Type_Declaration |
2226 N_Incomplete_Type_Declaration |
2227 N_Private_Type_Declaration |
2228 N_Private_Extension_Declaration =>
2231 when N_Subtype_Declaration =>
2234 when N_Renaming_Declaration =>
2237 when N_Generic_Instantiation =>
2240 when N_Representation_Clause |
2241 N_Use_Package_Clause |
2243 N_Package_Body_Stub |
2245 N_Protected_Body_Stub =>
2248 when N_Procedure_Call_Statement =>
2252 if NK in N_Statement_Other_Than_Procedure_Call then
2259 if Typ /= ASCII.NUL then
2260 Extend_Statement_Sequence (N, Typ);
2264 -- Process any embedded decisions
2266 if Has_Decision (N) then
2267 Process_Decisions_Defer (N, 'X
');
2271 -- Process aspects if present
2273 Traverse_Aspects (N);
2276 -- Start of processing for Traverse_Declarations_Or_Statements
2279 -- Process single prefixed node
2285 -- Loop through statements or declarations
2287 if Is_Non_Empty_List (L) then
2289 while Present (N) loop
2291 -- Note: For separate bodies, we see the tree after Par.Labl has
2292 -- introduced implicit labels, so we need to ignore those nodes.
2294 if Nkind (N) /= N_Implicit_Label_Declaration then
2303 -- End sequence of statements and flush deferred decisions
2305 if Present (P) or else Is_Non_Empty_List (L) then
2306 Set_Statement_Entry;
2309 return Current_Dominant;
2310 end Traverse_Declarations_Or_Statements;
2312 ------------------------------------------
2313 -- Traverse_Generic_Package_Declaration --
2314 ------------------------------------------
2316 procedure Traverse_Generic_Package_Declaration (N : Node_Id) is
2318 Process_Decisions (Generic_Formal_Declarations (N), 'X
', No_Location);
2319 Traverse_Package_Declaration (N);
2320 end Traverse_Generic_Package_Declaration;
2322 -----------------------------------------
2323 -- Traverse_Handled_Statement_Sequence --
2324 -----------------------------------------
2326 procedure Traverse_Handled_Statement_Sequence
2328 D : Dominant_Info := No_Dominant)
2333 -- For package bodies without a statement part, the parser adds an empty
2334 -- one, to normalize the representation. The null statement therein,
2335 -- which does not come from source, does not get a SCO.
2337 if Present (N) and then Comes_From_Source (N) then
2338 Traverse_Declarations_Or_Statements (Statements (N), D);
2340 if Present (Exception_Handlers (N)) then
2341 Handler := First (Exception_Handlers (N));
2342 while Present (Handler) loop
2343 Traverse_Declarations_Or_Statements
2344 (L => Statements (Handler),
2345 D => ('E
', Handler));
2350 end Traverse_Handled_Statement_Sequence;
2352 ---------------------------
2353 -- Traverse_Package_Body --
2354 ---------------------------
2356 procedure Traverse_Package_Body (N : Node_Id) is
2357 Dom : Dominant_Info;
2359 -- The first statement in the handled sequence of statements is
2360 -- dominated by the elaboration of the last declaration.
2362 Dom := Traverse_Declarations_Or_Statements (Declarations (N));
2364 Traverse_Handled_Statement_Sequence
2365 (Handled_Statement_Sequence (N), Dom);
2366 end Traverse_Package_Body;
2368 ----------------------------------
2369 -- Traverse_Package_Declaration --
2370 ----------------------------------
2372 procedure Traverse_Package_Declaration
2374 D : Dominant_Info := No_Dominant)
2376 Spec : constant Node_Id := Specification (N);
2377 Dom : Dominant_Info;
2381 Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
2383 -- First private declaration is dominated by last visible declaration
2385 Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
2386 end Traverse_Package_Declaration;
2388 ------------------------------
2389 -- Traverse_Sync_Definition --
2390 ------------------------------
2392 procedure Traverse_Sync_Definition (N : Node_Id) is
2393 Dom_Info : Dominant_Info := ('S
', N);
2394 -- The first declaration is dominated by the protected or task [type]
2398 -- N's protected or task definition
2401 -- Sync_Def's Visible_Declarations
2405 when N_Single_Protected_Declaration | N_Protected_Type_Declaration =>
2406 Sync_Def := Protected_Definition (N);
2408 when N_Single_Task_Declaration | N_Task_Type_Declaration =>
2409 Sync_Def := Task_Definition (N);
2412 raise Program_Error;
2415 Vis_Decl := Visible_Declarations (Sync_Def);
2417 Dom_Info := Traverse_Declarations_Or_Statements
2421 -- If visible declarations are present, the first private declaration
2422 -- is dominated by the last visible declaration.
2424 Traverse_Declarations_Or_Statements
2425 (L => Private_Declarations (Sync_Def),
2427 end Traverse_Sync_Definition;
2429 --------------------------------------
2430 -- Traverse_Subprogram_Or_Task_Body --
2431 --------------------------------------
2433 procedure Traverse_Subprogram_Or_Task_Body
2435 D : Dominant_Info := No_Dominant)
2437 Decls : constant List_Id := Declarations (N);
2438 Dom_Info : Dominant_Info := D;
2440 -- If declarations are present, the first statement is dominated by the
2441 -- last declaration.
2443 Dom_Info := Traverse_Declarations_Or_Statements
2444 (L => Decls, D => Dom_Info);
2446 Traverse_Handled_Statement_Sequence
2447 (N => Handled_Statement_Sequence (N),
2449 end Traverse_Subprogram_Or_Task_Body;
2451 -------------------------
2452 -- SCO_Record_Filtered --
2453 -------------------------
2455 procedure SCO_Record_Filtered is
2456 type Decision is record
2458 -- Type of the SCO decision (see comments for SCO_Table_Entry.C1)
2460 Sloc : Source_Location;
2463 -- Index in the SCO_Raw_Table for the root operator/condition for the
2464 -- expression that controls the decision.
2466 -- Decision descriptor: used to gather information about a candidate
2469 package Pending_Decisions is new Table.Table
2470 (Table_Component_Type => Decision,
2471 Table_Index_Type => Nat,
2472 Table_Low_Bound => 1,
2473 Table_Initial => 1000,
2474 Table_Increment => 200,
2475 Table_Name => "Filter_Pending_Decisions");
2476 -- Table used to hold decisions to process during the collection pass
2478 function Is_Decision (Idx : Nat) return Boolean;
2479 -- Return if the expression tree starting at Idx has adjacent nested
2480 -- nodes that make a decision.
2482 procedure Search_Nested_Decisions (Idx : in out Nat);
2483 -- Collect decisions to add to the filtered SCO table starting at the
2484 -- node at Idx in the SCO raw table. This node must not be part of an
2485 -- already-processed decision. Set Idx to the first node index passed
2486 -- the whole expression tree.
2488 procedure Skip_Decision
2490 Process_Nested_Decisions : Boolean);
2491 -- Skip all the nodes that belong to the decision starting at Idx. If
2492 -- Process_Nested_Decision, call Search_Nested_Decisions on the first
2493 -- nested nodes that do not belong to the decision. Set Idx to the first
2494 -- node index passed the whole expression tree.
2496 procedure Collect_Decisions
2499 -- Collect decisions to add to the filtered SCO table starting at the
2500 -- D decision (including it and its nested operators/conditions). Set
2501 -- Next to the first node index passed the whole decision.
2503 procedure Compute_Range
2505 From : out Source_Location;
2506 To : out Source_Location);
2507 -- Compute the source location range for the expression tree starting at
2508 -- Idx in the SCO raw table. Store its bounds in From and To.
2510 procedure Add_Expression_Tree (Idx : in out Nat);
2511 -- Add SCO raw table entries for the decision controlling expression
2512 -- tree starting at Idx to the filtered SCO table.
2514 procedure Process_Pending_Decisions
2515 (Original_Decision : SCO_Table_Entry);
2516 -- Complete the filtered SCO table using collected decisions. Output
2517 -- decisions inherit the pragma information from the original decision.
2523 function Is_Decision (Idx : Nat) return Boolean is
2529 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Index);
2538 -- This is a decision iff the only operand of the NOT
2539 -- operator could be a standalone decision.
2545 -- This node is a logical operator (and thus could be a
2546 -- standalone decision) iff it is a short circuit
2556 -----------------------------
2557 -- Search_Nested_Decisions --
2558 -----------------------------
2560 procedure Search_Nested_Decisions (Idx : in out Nat)
2565 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
2584 -- This in not a logical operator: start looking for
2585 -- nested decisions from here. Recurse over the left
2586 -- child and let the loop take care of the right one.
2589 Search_Nested_Decisions (Idx);
2592 -- We found a nested decision
2604 end Search_Nested_Decisions;
2610 procedure Skip_Decision
2612 Process_Nested_Decisions : Boolean)
2617 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
2628 -- This NOT operator belongs to the outside decision:
2634 if T.C2 = '?
' and then Process_Nested_Decisions then
2636 -- This in not a logical operator: start looking for
2637 -- nested decisions from here. Recurse over the left
2638 -- child and let the loop take care of the right one.
2640 Search_Nested_Decisions (Idx);
2643 -- This is a logical operator, so it belongs to the
2644 -- outside decision: skip its left child, then let the
2645 -- loop take care of the right one.
2647 Skip_Decision (Idx, Process_Nested_Decisions);
2654 -----------------------
2655 -- Collect_Decisions --
2656 -----------------------
2658 procedure Collect_Decisions
2664 if D.Kind /= 'X
' or else Is_Decision (D.Top) then
2665 Pending_Decisions.Append (D);
2668 Skip_Decision (Idx, True);
2670 end Collect_Decisions;
2676 procedure Compute_Range
2678 From : out Source_Location;
2679 To : out Source_Location)
2681 Sloc_F, Sloc_T : Source_Location := No_Source_Location;
2683 procedure Process_One;
2684 -- Process one node of the tree, and recurse over children. Update
2685 -- Idx during the traversal.
2691 procedure Process_One is
2693 if Sloc_F = No_Source_Location
2695 SCO_Raw_Table.Table (Idx).From < Sloc_F
2697 Sloc_F := SCO_Raw_Table.Table (Idx).From;
2699 if Sloc_T = No_Source_Location
2701 Sloc_T < SCO_Raw_Table.Table (Idx).To
2703 Sloc_T := SCO_Raw_Table.Table (Idx).To;
2706 if SCO_Raw_Table.Table (Idx).C1 = ' ' then
2708 -- This is a condition: nothing special to do
2712 elsif SCO_Raw_Table.Table (Idx).C1 = '!' then
2714 -- The "not" operator has only one operand
2720 -- This is an AND THEN or OR ELSE logical operator: follow the
2721 -- left, then the right operands.
2730 -- Start of processing for Compute_Range
2738 -------------------------
2739 -- Add_Expression_Tree --
2740 -------------------------
2742 procedure Add_Expression_Tree (Idx : in out Nat)
2744 Node_Idx : constant Nat := Idx;
2745 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Node_Idx);
2746 From, To : Source_Location;
2752 -- This is a single condition. Add an entry for it and move on
2754 SCO_Table.Append (T);
2759 -- This is a NOT operator: add an entry for it and browse its
2762 SCO_Table.Append (T);
2764 Add_Expression_Tree (Idx);
2768 -- This must be an AND/OR/AND THEN/OR ELSE operator
2772 -- This is not a short circuit operator: consider this one
2773 -- and all its children as a single condition.
2775 Compute_Range (Idx, From, To);
2782 Pragma_Sloc => No_Location,
2783 Pragma_Aspect_Name => No_Name));
2786 -- This is a real short circuit operator: add an entry for
2787 -- it and browse its children.
2789 SCO_Table.Append (T);
2791 Add_Expression_Tree (Idx);
2792 Add_Expression_Tree (Idx);
2795 end Add_Expression_Tree;
2797 -------------------------------
2798 -- Process_Pending_Decisions --
2799 -------------------------------
2801 procedure Process_Pending_Decisions
2802 (Original_Decision : SCO_Table_Entry)
2805 for Index in 1 .. Pending_Decisions.Last loop
2807 D : Decision renames Pending_Decisions.Table (Index);
2811 -- Add a SCO table entry for the decision itself
2813 pragma Assert (D.Kind /= ' ');
2816 ((To => No_Source_Location,
2821 Pragma_Sloc => Original_Decision.Pragma_Sloc,
2822 Pragma_Aspect_Name =>
2823 Original_Decision.Pragma_Aspect_Name));
2825 -- Then add ones for its nested operators/operands. Do not
2826 -- forget to tag its *last* entry as such.
2828 Add_Expression_Tree (Idx);
2829 SCO_Table.Table (SCO_Table.Last).Last := True;
2833 -- Clear the pending decisions list
2834 Pending_Decisions.Set_Last (0);
2835 end Process_Pending_Decisions;
2837 -- Start of processing for SCO_Record_Filtered
2840 -- Filtering must happen only once: do nothing if it this pass was
2843 if SCO_Generation_State = Filtered then
2846 pragma Assert (SCO_Generation_State = Raw);
2847 SCO_Generation_State := Filtered;
2850 -- Loop through all SCO entries under SCO units
2852 for Unit_Idx in 1 .. SCO_Unit_Table.Last loop
2854 Unit : SCO_Unit_Table_Entry
2855 renames SCO_Unit_Table.Table (Unit_Idx);
2857 Idx : Nat := Unit.From;
2858 -- Index of the current SCO raw table entry
2860 New_From : constant Nat := SCO_Table.Last + 1;
2861 -- After copying SCO enties of interest to the final table, we
2862 -- will have to change the From/To indexes this unit targets.
2863 -- This constant keeps track of the new From index.
2866 while Idx <= Unit.To loop
2868 T : SCO_Table_Entry renames SCO_Raw_Table.Table (Idx);
2873 -- Decision (of any kind, including pragmas and aspects)
2875 when 'E
' | 'G
' | 'I
' | 'W
' | 'X
' | 'P
' | 'a
' | 'A
' =>
2876 if SCO_Pragma_Disabled (T.Pragma_Sloc) then
2878 -- Skip SCO entries for decisions in disabled
2879 -- constructs (pragmas or aspects).
2882 Skip_Decision (Idx, False);
2890 Process_Pending_Decisions (T);
2893 -- There is no translation/filtering to do for other kind
2894 -- of SCO items (statements, dominance markers, etc.).
2896 when '|
' | '&' | '!' | ' ' =>
2898 -- SCO logical operators and conditions cannot exist
2899 -- on their own: they must be inside a decision (such
2900 -- entries must have been skipped by
2901 -- Collect_Decisions).
2903 raise Program_Error;
2906 SCO_Table.Append (T);
2912 -- Now, update the SCO entry indexes in the unit entry
2914 Unit.From := New_From;
2915 Unit.To := SCO_Table.Last;
2919 -- Then clear the raw table to free bytes
2922 end SCO_Record_Filtered;