?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merge branch 'master' r216746-r217593 into gimple-classes-v2-option-3
[official-gcc.git] / gcc / ada / par_sco.adb
blob15382acf6ce75f37bfa0e93fc64f27468e9bdd96
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R _ S C O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2009-2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Aspects; use Aspects;
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Errout; use Errout;
30 with Lib; use Lib;
31 with Lib.Util; use Lib.Util;
32 with Namet; use Namet;
33 with Nlists; use Nlists;
34 with Opt; use Opt;
35 with Output; use Output;
36 with Put_SCOs;
37 with SCOs; use SCOs;
38 with Sem; use Sem;
39 with Sem_Util; use Sem_Util;
40 with Sinfo; use Sinfo;
41 with Sinput; use Sinput;
42 with Snames; use Snames;
43 with Table;
44
45 with GNAT.HTable; use GNAT.HTable;
46 with GNAT.Heap_Sort_G;
47
48 package body Par_SCO is
49
50 -----------------------
51 -- Unit Number Table --
52 -----------------------
53
54 -- This table parallels the SCO_Unit_Table, keeping track of the unit
55 -- numbers corresponding to the entries made in this table, so that before
56 -- writing out the SCO information to the ALI file, we can fill in the
57 -- proper dependency numbers and file names.
58
59 -- Note that the zero'th entry is here for convenience in sorting the
60 -- table, the real lower bound is 1.
61
62 package SCO_Unit_Number_Table is new Table.Table (
63 Table_Component_Type => Unit_Number_Type,
64 Table_Index_Type => SCO_Unit_Index,
65 Table_Low_Bound => 0, -- see note above on sort
66 Table_Initial => 20,
67 Table_Increment => 200,
68 Table_Name => "SCO_Unit_Number_Entry");
69
70 ---------------------------------
71 -- Condition/Pragma Hash Table --
72 ---------------------------------
73
74 -- We need to be able to get to conditions quickly for handling the calls
75 -- to Set_SCO_Condition efficiently, and similarly to get to pragmas to
76 -- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify the
77 -- conditions and pragmas in the table by their starting sloc, and use this
78 -- hash table to map from these sloc values to SCO_Table indexes.
79
80 type Header_Num is new Integer range 0 .. 996;
81 -- Type for hash table headers
82
83 function Hash (F : Source_Ptr) return Header_Num;
84 -- Function to Hash source pointer value
85
86 function Equal (F1, F2 : Source_Ptr) return Boolean;
87 -- Function to test two keys for equality
88
89 package Condition_Pragma_Hash_Table is new Simple_HTable
90 (Header_Num, Int, 0, Source_Ptr, Hash, Equal);
91 -- The actual hash table
92
93 --------------------------
94 -- Internal Subprograms --
95 --------------------------
96
97 function Has_Decision (N : Node_Id) return Boolean;
98 -- N is the node for a subexpression. Returns True if the subexpression
99 -- contains a nested decision (i.e. either is a logical operator, or
100 -- contains a logical operator in its subtree).
101
102 function Is_Logical_Operator (N : Node_Id) return Boolean;
103 -- N is the node for a subexpression. This procedure determines whether N
104 -- a logical operator (including short circuit conditions, but excluding
105 -- OR and AND) and returns True if so. Note that in cases where True is
106 -- returned, callers assume Nkind (N) in N_Op.
107
108 function To_Source_Location (S : Source_Ptr) return Source_Location;
109 -- Converts Source_Ptr value to Source_Location (line/col) format
110
111 procedure Process_Decisions
112 (N : Node_Id;
113 T : Character;
114 Pragma_Sloc : Source_Ptr);
115 -- If N is Empty, has no effect. Otherwise scans the tree for the node N,
116 -- to output any decisions it contains. T is one of IEGPWX (for context of
117 -- expression: if/exit when/entry guard/pragma/while/expression). If T is
118 -- other than X, the node N is the if expression involved, and a decision
119 -- is always present (at the very least a simple decision is present at the
120 -- top level).
121
122 procedure Process_Decisions
123 (L : List_Id;
124 T : Character;
125 Pragma_Sloc : Source_Ptr);
126 -- Calls above procedure for each element of the list L
127
128 procedure Set_Table_Entry
129 (C1 : Character;
130 C2 : Character;
131 From : Source_Ptr;
132 To : Source_Ptr;
133 Last : Boolean;
134 Pragma_Sloc : Source_Ptr := No_Location;
135 Pragma_Aspect_Name : Name_Id := No_Name);
136 -- Append an entry to SCO_Table with fields set as per arguments
137
138 type Dominant_Info is record
139 K : Character;
140 -- F/T/S/E for a valid dominance marker, or ' ' for no dominant
141
142 N : Node_Id;
143 -- Node providing the Sloc(s) for the dominance marker
144 end record;
145 No_Dominant : constant Dominant_Info := (' ', Empty);
146
147 procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr);
148 -- Add one entry from the instance table to the corresponding SCO table
149
150 procedure Traverse_Declarations_Or_Statements
151 (L : List_Id;
152 D : Dominant_Info := No_Dominant;
153 P : Node_Id := Empty);
154 -- Process L, a list of statements or declarations dominated by D.
155 -- If P is present, it is processed as though it had been prepended to L.
156
157 function Traverse_Declarations_Or_Statements
158 (L : List_Id;
159 D : Dominant_Info := No_Dominant;
160 P : Node_Id := Empty) return Dominant_Info;
161 -- Same as above, and returns dominant information corresponding to the
162 -- last node with SCO in L.
163
164 -- The following Traverse_* routines perform appropriate calls to
165 -- Traverse_Declarations_Or_Statements to traverse specific node kinds.
166 -- Parameter D, when present, indicates the dominant of the first
167 -- declaration or statement within N.
168
169 -- Why is Traverse_Sync_Definition commented specificaly and
170 -- the others are not???
171
172 procedure Traverse_Generic_Package_Declaration (N : Node_Id);
173 procedure Traverse_Handled_Statement_Sequence
174 (N : Node_Id;
175 D : Dominant_Info := No_Dominant);
176 procedure Traverse_Package_Body (N : Node_Id);
177 procedure Traverse_Package_Declaration
178 (N : Node_Id;
179 D : Dominant_Info := No_Dominant);
180 procedure Traverse_Subprogram_Or_Task_Body
181 (N : Node_Id;
182 D : Dominant_Info := No_Dominant);
183
184 procedure Traverse_Sync_Definition (N : Node_Id);
185 -- Traverse a protected definition or task definition
186
187 procedure Write_SCOs_To_ALI_File is new Put_SCOs;
188 -- Write SCO information to the ALI file using routines in Lib.Util
189
190 ----------
191 -- dsco --
192 ----------
193
194 procedure dsco is
195 begin
196 -- Dump SCO unit table
197
198 Write_Line ("SCO Unit Table");
199 Write_Line ("--------------");
200
201 for Index in 1 .. SCO_Unit_Table.Last loop
202 declare
203 UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (Index);
204
205 begin
206 Write_Str (" ");
207 Write_Int (Int (Index));
208 Write_Str (". Dep_Num = ");
209 Write_Int (Int (UTE.Dep_Num));
210 Write_Str (" From = ");
211 Write_Int (Int (UTE.From));
212 Write_Str (" To = ");
213 Write_Int (Int (UTE.To));
214
215 Write_Str (" File_Name = """);
216
217 if UTE.File_Name /= null then
218 Write_Str (UTE.File_Name.all);
219 end if;
220
221 Write_Char ('"');
222 Write_Eol;
223 end;
224 end loop;
225
226 -- Dump SCO Unit number table if it contains any entries
227
228 if SCO_Unit_Number_Table.Last >= 1 then
229 Write_Eol;
230 Write_Line ("SCO Unit Number Table");
231 Write_Line ("---------------------");
232
233 for Index in 1 .. SCO_Unit_Number_Table.Last loop
234 Write_Str (" ");
235 Write_Int (Int (Index));
236 Write_Str (". Unit_Number = ");
237 Write_Int (Int (SCO_Unit_Number_Table.Table (Index)));
238 Write_Eol;
239 end loop;
240 end if;
241
242 -- Dump SCO table itself
243
244 Write_Eol;
245 Write_Line ("SCO Table");
246 Write_Line ("---------");
247
248 for Index in 1 .. SCO_Table.Last loop
249 declare
250 T : SCO_Table_Entry renames SCO_Table.Table (Index);
251
252 begin
253 Write_Str (" ");
254 Write_Int (Index);
255 Write_Char ('.');
256
257 if T.C1 /= ' ' then
258 Write_Str (" C1 = '");
259 Write_Char (T.C1);
260 Write_Char (''');
261 end if;
262
263 if T.C2 /= ' ' then
264 Write_Str (" C2 = '");
265 Write_Char (T.C2);
266 Write_Char (''');
267 end if;
268
269 if T.From /= No_Source_Location then
270 Write_Str (" From = ");
271 Write_Int (Int (T.From.Line));
272 Write_Char (':');
273 Write_Int (Int (T.From.Col));
274 end if;
275
276 if T.To /= No_Source_Location then
277 Write_Str (" To = ");
278 Write_Int (Int (T.To.Line));
279 Write_Char (':');
280 Write_Int (Int (T.To.Col));
281 end if;
282
283 if T.Last then
284 Write_Str (" True");
285 else
286 Write_Str (" False");
287 end if;
288
289 Write_Eol;
290 end;
291 end loop;
292 end dsco;
293
294 -----------
295 -- Equal --
296 -----------
297
298 function Equal (F1, F2 : Source_Ptr) return Boolean is
299 begin
300 return F1 = F2;
301 end Equal;
302
303 ------------------
304 -- Has_Decision --
305 ------------------
306
307 function Has_Decision (N : Node_Id) return Boolean is
308
309 function Check_Node (N : Node_Id) return Traverse_Result;
310 -- Determine if Nkind (N) indicates the presence of a decision (i.e.
311 -- N is a logical operator, which is a decision in itself, or an
312 -- IF-expression whose Condition attribute is a decision).
313
314 ----------------
315 -- Check_Node --
316 ----------------
317
318 function Check_Node (N : Node_Id) return Traverse_Result is
319 begin
320 if Is_Logical_Operator (N) or else Nkind (N) = N_If_Expression then
321 return Abandon;
322 else
323 return OK;
324 end if;
325 end Check_Node;
326
327 function Traverse is new Traverse_Func (Check_Node);
328
329 -- Start of processing for Has_Decision
330
331 begin
332 return Traverse (N) = Abandon;
333 end Has_Decision;
334
335 ----------
336 -- Hash --
337 ----------
338
339 function Hash (F : Source_Ptr) return Header_Num is
340 begin
341 return Header_Num (Nat (F) mod 997);
342 end Hash;
343
344 ----------------
345 -- Initialize --
346 ----------------
347
348 procedure Initialize is
349 begin
350 SCO_Unit_Number_Table.Init;
351
352 -- The SCO_Unit_Number_Table entry with index 0 is intentionally set
353 -- aside to be used as temporary for sorting.
354
355 SCO_Unit_Number_Table.Increment_Last;
356 end Initialize;
357
358 -------------------------
359 -- Is_Logical_Operator --
360 -------------------------
361
362 function Is_Logical_Operator (N : Node_Id) return Boolean is
363 begin
364 return Nkind_In (N, N_Op_Not, N_And_Then, N_Or_Else);
365 end Is_Logical_Operator;
366
367 -----------------------
368 -- Process_Decisions --
369 -----------------------
370
371 -- Version taking a list
372
373 procedure Process_Decisions
374 (L : List_Id;
375 T : Character;
376 Pragma_Sloc : Source_Ptr)
377 is
378 N : Node_Id;
379 begin
380 if L /= No_List then
381 N := First (L);
382 while Present (N) loop
383 Process_Decisions (N, T, Pragma_Sloc);
384 Next (N);
385 end loop;
386 end if;
387 end Process_Decisions;
388
389 -- Version taking a node
390
391 Current_Pragma_Sloc : Source_Ptr := No_Location;
392 -- While processing a pragma, this is set to the sloc of the N_Pragma node
393
394 procedure Process_Decisions
395 (N : Node_Id;
396 T : Character;
397 Pragma_Sloc : Source_Ptr)
398 is
399 Mark : Nat;
400 -- This is used to mark the location of a decision sequence in the SCO
401 -- table. We use it for backing out a simple decision in an expression
402 -- context that contains only NOT operators.
403
404 X_Not_Decision : Boolean;
405 -- This flag keeps track of whether a decision sequence in the SCO table
406 -- contains only NOT operators, and is for an expression context (T=X).
407 -- The flag will be set False if T is other than X, or if an operator
408 -- other than NOT is in the sequence.
409
410 function Process_Node (N : Node_Id) return Traverse_Result;
411 -- Processes one node in the traversal, looking for logical operators,
412 -- and if one is found, outputs the appropriate table entries.
413
414 procedure Output_Decision_Operand (N : Node_Id);
415 -- The node N is the top level logical operator of a decision, or it is
416 -- one of the operands of a logical operator belonging to a single
417 -- complex decision. This routine outputs the sequence of table entries
418 -- corresponding to the node. Note that we do not process the sub-
419 -- operands to look for further decisions, that processing is done in
420 -- Process_Decision_Operand, because we can't get decisions mixed up in
421 -- the global table. Call has no effect if N is Empty.
422
423 procedure Output_Element (N : Node_Id);
424 -- Node N is an operand of a logical operator that is not itself a
425 -- logical operator, or it is a simple decision. This routine outputs
426 -- the table entry for the element, with C1 set to ' '. Last is set
427 -- False, and an entry is made in the condition hash table.
428
429 procedure Output_Header (T : Character);
430 -- Outputs a decision header node. T is I/W/E/P for IF/WHILE/EXIT WHEN/
431 -- PRAGMA, and 'X' for the expression case.
432
433 procedure Process_Decision_Operand (N : Node_Id);
434 -- This is called on node N, the top level node of a decision, or on one
435 -- of its operands or suboperands after generating the full output for
436 -- the complex decision. It process the suboperands of the decision
437 -- looking for nested decisions.
438
439 -----------------------------
440 -- Output_Decision_Operand --
441 -----------------------------
442
443 procedure Output_Decision_Operand (N : Node_Id) is
444 C : Character;
445 L : Node_Id;
446
447 begin
448 if No (N) then
449 return;
450
451 -- Logical operator
452
453 elsif Is_Logical_Operator (N) then
454 if Nkind (N) = N_Op_Not then
455 C := '!';
456 L := Empty;
457
458 else
459 L := Left_Opnd (N);
460
461 if Nkind_In (N, N_Op_Or, N_Or_Else) then
462 C := '|';
463
464 else pragma Assert (Nkind_In (N, N_Op_And, N_And_Then));
465 C := '&';
466 end if;
467 end if;
468
469 Set_Table_Entry
470 (C1 => C,
471 C2 => ' ',
472 From => Sloc (N),
473 To => No_Location,
474 Last => False);
475
476 Output_Decision_Operand (L);
477 Output_Decision_Operand (Right_Opnd (N));
478
479 -- Not a logical operator
480
481 else
482 Output_Element (N);
483 end if;
484 end Output_Decision_Operand;
485
486 --------------------
487 -- Output_Element --
488 --------------------
489
490 procedure Output_Element (N : Node_Id) is
491 FSloc : Source_Ptr;
492 LSloc : Source_Ptr;
493 begin
494 Sloc_Range (N, FSloc, LSloc);
495 Set_Table_Entry
496 (C1 => ' ',
497 C2 => 'c',
498 From => FSloc,
499 To => LSloc,
500 Last => False);
501 Condition_Pragma_Hash_Table.Set (FSloc, SCO_Table.Last);
502 end Output_Element;
503
504 -------------------
505 -- Output_Header --
506 -------------------
507
508 procedure Output_Header (T : Character) is
509 Loc : Source_Ptr := No_Location;
510 -- Node whose Sloc is used for the decision
511
512 Nam : Name_Id := No_Name;
513 -- For the case of an aspect, aspect name
514
515 begin
516 case T is
517 when 'I' | 'E' | 'W' | 'a' | 'A' =>
518
519 -- For IF, EXIT, WHILE, or aspects, the token SLOC is that of
520 -- the parent of the expression.
521
522 Loc := Sloc (Parent (N));
523
524 if T = 'a' or else T = 'A' then
525 Nam := Chars (Identifier (Parent (N)));
526 end if;
527
528 when 'G' | 'P' =>
529
530 -- For entry guard, the token sloc is from the N_Entry_Body.
531 -- For PRAGMA, we must get the location from the pragma node.
532 -- Argument N is the pragma argument, and we have to go up
533 -- two levels (through the pragma argument association) to
534 -- get to the pragma node itself. For the guard on a select
535 -- alternative, we do not have access to the token location for
536 -- the WHEN, so we use the first sloc of the condition itself
537 -- (note: we use First_Sloc, not Sloc, because this is what is
538 -- referenced by dominance markers).
539
540 -- Doesn't this requirement of using First_Sloc need to be
541 -- documented in the spec ???
542
543 if Nkind_In (Parent (N), N_Accept_Alternative,
544 N_Delay_Alternative,
545 N_Terminate_Alternative)
546 then
547 Loc := First_Sloc (N);
548 else
549 Loc := Sloc (Parent (Parent (N)));
550 end if;
551
552 when 'X' =>
553
554 -- For an expression, no Sloc
555
556 null;
557
558 -- No other possibilities
559
560 when others =>
561 raise Program_Error;
562 end case;
563
564 Set_Table_Entry
565 (C1 => T,
566 C2 => ' ',
567 From => Loc,
568 To => No_Location,
569 Last => False,
570 Pragma_Sloc => Pragma_Sloc,
571 Pragma_Aspect_Name => Nam);
572
573 -- For an aspect specification, which will be rewritten into a
574 -- pragma, enter a hash table entry now.
575
576 if T = 'a' then
577 Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
578 end if;
579 end Output_Header;
580
581 ------------------------------
582 -- Process_Decision_Operand --
583 ------------------------------
584
585 procedure Process_Decision_Operand (N : Node_Id) is
586 begin
587 if Is_Logical_Operator (N) then
588 if Nkind (N) /= N_Op_Not then
589 Process_Decision_Operand (Left_Opnd (N));
590 X_Not_Decision := False;
591 end if;
592
593 Process_Decision_Operand (Right_Opnd (N));
594
595 else
596 Process_Decisions (N, 'X', Pragma_Sloc);
597 end if;
598 end Process_Decision_Operand;
599
600 ------------------
601 -- Process_Node --
602 ------------------
603
604 function Process_Node (N : Node_Id) return Traverse_Result is
605 begin
606 case Nkind (N) is
607
608 -- Logical operators, output table entries and then process
609 -- operands recursively to deal with nested conditions.
610
611 when N_And_Then | N_Or_Else | N_Op_Not =>
612 declare
613 T : Character;
614
615 begin
616 -- If outer level, then type comes from call, otherwise it
617 -- is more deeply nested and counts as X for expression.
618
619 if N = Process_Decisions.N then
620 T := Process_Decisions.T;
621 else
622 T := 'X';
623 end if;
624
625 -- Output header for sequence
626
627 X_Not_Decision := T = 'X' and then Nkind (N) = N_Op_Not;
628 Mark := SCO_Table.Last;
629 Output_Header (T);
630
631 -- Output the decision
632
633 Output_Decision_Operand (N);
634
635 -- If the decision was in an expression context (T = 'X')
636 -- and contained only NOT operators, then we don't output
637 -- it, so delete it.
638
639 if X_Not_Decision then
640 SCO_Table.Set_Last (Mark);
641
642 -- Otherwise, set Last in last table entry to mark end
643
644 else
645 SCO_Table.Table (SCO_Table.Last).Last := True;
646 end if;
647
648 -- Process any embedded decisions
649
650 Process_Decision_Operand (N);
651 return Skip;
652 end;
653
654 -- Case expression
655
656 -- Really hard to believe this is correct given the special
657 -- handling for if expressions below ???
658
659 when N_Case_Expression =>
660 return OK; -- ???
661
662 -- If expression, processed like an if statement
663
664 when N_If_Expression =>
665 declare
666 Cond : constant Node_Id := First (Expressions (N));
667 Thnx : constant Node_Id := Next (Cond);
668 Elsx : constant Node_Id := Next (Thnx);
669 begin
670 Process_Decisions (Cond, 'I', Pragma_Sloc);
671 Process_Decisions (Thnx, 'X', Pragma_Sloc);
672 Process_Decisions (Elsx, 'X', Pragma_Sloc);
673 return Skip;
674 end;
675
676 -- All other cases, continue scan
677
678 when others =>
679 return OK;
680
681 end case;
682 end Process_Node;
683
684 procedure Traverse is new Traverse_Proc (Process_Node);
685
686 -- Start of processing for Process_Decisions
687
688 begin
689 if No (N) then
690 return;
691 end if;
692
693 -- See if we have simple decision at outer level and if so then
694 -- generate the decision entry for this simple decision. A simple
695 -- decision is a boolean expression (which is not a logical operator
696 -- or short circuit form) appearing as the operand of an IF, WHILE,
697 -- EXIT WHEN, or special PRAGMA construct.
698
699 if T /= 'X' and then not Is_Logical_Operator (N) then
700 Output_Header (T);
701 Output_Element (N);
702
703 -- Change Last in last table entry to True to mark end of
704 -- sequence, which is this case is only one element long.
705
706 SCO_Table.Table (SCO_Table.Last).Last := True;
707 end if;
708
709 Traverse (N);
710 end Process_Decisions;
711
712 -----------
713 -- pscos --
714 -----------
715
716 procedure pscos is
717
718 procedure Write_Info_Char (C : Character) renames Write_Char;
719 -- Write one character;
720
721 procedure Write_Info_Initiate (Key : Character) renames Write_Char;
722 -- Start new one and write one character;
723
724 procedure Write_Info_Nat (N : Nat);
725 -- Write value of N
726
727 procedure Write_Info_Terminate renames Write_Eol;
728 -- Terminate current line
729
730 --------------------
731 -- Write_Info_Nat --
732 --------------------
733
734 procedure Write_Info_Nat (N : Nat) is
735 begin
736 Write_Int (N);
737 end Write_Info_Nat;
738
739 procedure Debug_Put_SCOs is new Put_SCOs;
740
741 -- Start of processing for pscos
742
743 begin
744 Debug_Put_SCOs;
745 end pscos;
746
747 ---------------------
748 -- Record_Instance --
749 ---------------------
750
751 procedure Record_Instance (Id : Instance_Id; Inst_Sloc : Source_Ptr) is
752 Inst_Src : constant Source_File_Index :=
753 Get_Source_File_Index (Inst_Sloc);
754 begin
755 SCO_Instance_Table.Append
756 ((Inst_Dep_Num => Dependency_Num (Unit (Inst_Src)),
757 Inst_Loc => To_Source_Location (Inst_Sloc),
758 Enclosing_Instance => SCO_Instance_Index (Instance (Inst_Src))));
759 pragma Assert
760 (SCO_Instance_Table.Last = SCO_Instance_Index (Id));
761 end Record_Instance;
762
763 ----------------
764 -- SCO_Output --
765 ----------------
766
767 procedure SCO_Output is
768 procedure Populate_SCO_Instance_Table is
769 new Sinput.Iterate_On_Instances (Record_Instance);
770
771 SCO_Index : Nat;
772
773 begin
774 if Debug_Flag_Dot_OO then
775 dsco;
776 end if;
777
778 Populate_SCO_Instance_Table;
779
780 -- Sort the unit tables based on dependency numbers
781
782 Unit_Table_Sort : declare
783
784 function Lt (Op1, Op2 : Natural) return Boolean;
785 -- Comparison routine for sort call
786
787 procedure Move (From : Natural; To : Natural);
788 -- Move routine for sort call
789
790 --------
791 -- Lt --
792 --------
793
794 function Lt (Op1, Op2 : Natural) return Boolean is
795 begin
796 return
797 Dependency_Num
798 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op1)))
799 <
800 Dependency_Num
801 (SCO_Unit_Number_Table.Table (SCO_Unit_Index (Op2)));
802 end Lt;
803
804 ----------
805 -- Move --
806 ----------
807
808 procedure Move (From : Natural; To : Natural) is
809 begin
810 SCO_Unit_Table.Table (SCO_Unit_Index (To)) :=
811 SCO_Unit_Table.Table (SCO_Unit_Index (From));
812 SCO_Unit_Number_Table.Table (SCO_Unit_Index (To)) :=
813 SCO_Unit_Number_Table.Table (SCO_Unit_Index (From));
814 end Move;
815
816 package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
817
818 -- Start of processing for Unit_Table_Sort
819
820 begin
821 Sorting.Sort (Integer (SCO_Unit_Table.Last));
822 end Unit_Table_Sort;
823
824 -- Loop through entries in the unit table to set file name and
825 -- dependency number entries.
826
827 for J in 1 .. SCO_Unit_Table.Last loop
828 declare
829 U : constant Unit_Number_Type := SCO_Unit_Number_Table.Table (J);
830 UTE : SCO_Unit_Table_Entry renames SCO_Unit_Table.Table (J);
831 begin
832 Get_Name_String (Reference_Name (Source_Index (U)));
833 UTE.File_Name := new String'(Name_Buffer (1 .. Name_Len));
834 UTE.Dep_Num := Dependency_Num (U);
835 end;
836 end loop;
837
838 -- Stamp out SCO entries for decisions in disabled constructs (pragmas
839 -- or aspects).
840
841 SCO_Index := 1;
842 while SCO_Index <= SCO_Table.Last loop
843 if Is_Decision (SCO_Table.Table (SCO_Index).C1)
844 and then SCO_Pragma_Disabled
845 (SCO_Table.Table (SCO_Index).Pragma_Sloc)
846 then
847 loop
848 SCO_Table.Table (SCO_Index).C1 := ASCII.NUL;
849 exit when SCO_Table.Table (SCO_Index).Last;
850 SCO_Index := SCO_Index + 1;
851 end loop;
852 end if;
853
854 SCO_Index := SCO_Index + 1;
855 end loop;
856
857 -- Now the tables are all setup for output to the ALI file
858
859 Write_SCOs_To_ALI_File;
860 end SCO_Output;
861
862 -------------------------
863 -- SCO_Pragma_Disabled --
864 -------------------------
865
866 function SCO_Pragma_Disabled (Loc : Source_Ptr) return Boolean is
867 Index : Nat;
868
869 begin
870 if Loc = No_Location then
871 return False;
872 end if;
873
874 Index := Condition_Pragma_Hash_Table.Get (Loc);
875
876 -- The test here for zero is to deal with possible previous errors, and
877 -- for the case of pragma statement SCOs, for which we always set the
878 -- Pragma_Sloc even if the particular pragma cannot be specifically
879 -- disabled.
880
881 if Index /= 0 then
882 declare
883 T : SCO_Table_Entry renames SCO_Table.Table (Index);
884 begin
885 case T.C1 is
886 when 'S' =>
887 -- Pragma statement
888
889 return T.C2 = 'p';
890
891 when 'A' =>
892 -- Aspect decision (enabled)
893
894 return False;
895
896 when 'a' =>
897 -- Aspect decision (not enabled)
898
899 return True;
900
901 when ASCII.NUL =>
902 -- Nullified disabled SCO
903
904 return True;
905
906 when others =>
907 raise Program_Error;
908 end case;
909 end;
910
911 else
912 return False;
913 end if;
914 end SCO_Pragma_Disabled;
915
916 ----------------
917 -- SCO_Record --
918 ----------------
919
920 procedure SCO_Record (U : Unit_Number_Type) is
921 Lu : Node_Id;
922 From : Nat;
923
924 procedure Traverse_Aux_Decls (N : Node_Id);
925 -- Traverse the Aux_Decls_Node of compilation unit N
926
927 ------------------------
928 -- Traverse_Aux_Decls --
929 ------------------------
930
931 procedure Traverse_Aux_Decls (N : Node_Id) is
932 ADN : constant Node_Id := Aux_Decls_Node (N);
933 begin
934 Traverse_Declarations_Or_Statements (Config_Pragmas (ADN));
935 Traverse_Declarations_Or_Statements (Pragmas_After (ADN));
936
937 -- Declarations and Actions do not correspond to source constructs,
938 -- they contain only nodes from expansion, so at this point they
939 -- should still be empty:
940
941 pragma Assert (No (Declarations (ADN)));
942 pragma Assert (No (Actions (ADN)));
943 end Traverse_Aux_Decls;
944
945 -- Start of processing for SCO_Record
946
947 begin
948 -- Ignore call if not generating code and generating SCO's
949
950 if not (Generate_SCO and then Operating_Mode = Generate_Code) then
951 return;
952 end if;
953
954 -- Ignore call if this unit already recorded
955
956 for J in 1 .. SCO_Unit_Number_Table.Last loop
957 if U = SCO_Unit_Number_Table.Table (J) then
958 return;
959 end if;
960 end loop;
961
962 -- Otherwise record starting entry
963
964 From := SCO_Table.Last + 1;
965
966 -- Get Unit (checking case of subunit)
967
968 Lu := Unit (Cunit (U));
969
970 if Nkind (Lu) = N_Subunit then
971 Lu := Proper_Body (Lu);
972 end if;
973
974 -- Traverse the unit
975
976 Traverse_Aux_Decls (Cunit (U));
977
978 case Nkind (Lu) is
979 when
980 N_Package_Declaration |
981 N_Package_Body |
982 N_Subprogram_Declaration |
983 N_Subprogram_Body |
984 N_Generic_Package_Declaration |
985 N_Protected_Body |
986 N_Task_Body |
987 N_Generic_Instantiation =>
988
989 Traverse_Declarations_Or_Statements (L => No_List, P => Lu);
990
991 when others =>
992
993 -- All other cases of compilation units (e.g. renamings), generate
994 -- no SCO information.
995
996 null;
997 end case;
998
999 -- Make entry for new unit in unit tables, we will fill in the file
1000 -- name and dependency numbers later.
1001
1002 SCO_Unit_Table.Append (
1003 (Dep_Num => 0,
1004 File_Name => null,
1005 File_Index => Get_Source_File_Index (Sloc (Lu)),
1006 From => From,
1007 To => SCO_Table.Last));
1008
1009 SCO_Unit_Number_Table.Append (U);
1010 end SCO_Record;
1011
1012 -----------------------
1013 -- Set_SCO_Condition --
1014 -----------------------
1015
1016 procedure Set_SCO_Condition (Cond : Node_Id; Val : Boolean) is
1017 Orig : constant Node_Id := Original_Node (Cond);
1018 Index : Nat;
1019 Start : Source_Ptr;
1020 Dummy : Source_Ptr;
1021
1022 Constant_Condition_Code : constant array (Boolean) of Character :=
1023 (False => 'f', True => 't');
1024 begin
1025 Sloc_Range (Orig, Start, Dummy);
1026 Index := Condition_Pragma_Hash_Table.Get (Start);
1027
1028 -- Index can be zero for boolean expressions that do not have SCOs
1029 -- (simple decisions outside of a control flow structure), or in case
1030 -- of a previous error.
1031
1032 if Index = 0 then
1033 return;
1034
1035 else
1036 pragma Assert (SCO_Table.Table (Index).C1 = ' ');
1037 SCO_Table.Table (Index).C2 := Constant_Condition_Code (Val);
1038 end if;
1039 end Set_SCO_Condition;
1040
1041 ----------------------------
1042 -- Set_SCO_Pragma_Enabled --
1043 ----------------------------
1044
1045 procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is
1046 Index : Nat;
1047
1048 begin
1049 -- Nothing to do if not generating SCO, or if we're not processing the
1050 -- original source occurrence of the pragma.
1051
1052 if not (Generate_SCO
1053 and then In_Extended_Main_Source_Unit (Loc)
1054 and then not (In_Instance or In_Inlined_Body))
1055 then
1056 return;
1057 end if;
1058
1059 -- Note: the reason we use the Sloc value as the key is that in the
1060 -- generic case, the call to this procedure is made on a copy of the
1061 -- original node, so we can't use the Node_Id value.
1062
1063 Index := Condition_Pragma_Hash_Table.Get (Loc);
1064
1065 -- A zero index here indicates that semantic analysis found an
1066 -- activated pragma at Loc which does not have a corresponding pragma
1067 -- or aspect at the syntax level. This may occur in legitimate cases
1068 -- because of expanded code (such are Pre/Post conditions generated for
1069 -- formal parameter validity checks), or as a consequence of a previous
1070 -- error.
1071
1072 if Index = 0 then
1073 return;
1074
1075 else
1076 declare
1077 T : SCO_Table_Entry renames SCO_Table.Table (Index);
1078
1079 begin
1080 -- Note: may be called multiple times for the same sloc, so
1081 -- account for the fact that the entry may already have been
1082 -- marked enabled.
1083
1084 case T.C1 is
1085 -- Aspect (decision SCO)
1086
1087 when 'a' =>
1088 T.C1 := 'A';
1089
1090 when 'A' =>
1091 null;
1092
1093 -- Pragma (statement SCO)
1094
1095 when 'S' =>
1096 pragma Assert (T.C2 = 'p' or else T.C2 = 'P');
1097 T.C2 := 'P';
1098
1099 when others =>
1100 raise Program_Error;
1101 end case;
1102 end;
1103 end if;
1104 end Set_SCO_Pragma_Enabled;
1105
1106 ---------------------
1107 -- Set_Table_Entry --
1108 ---------------------
1109
1110 procedure Set_Table_Entry
1111 (C1 : Character;
1112 C2 : Character;
1113 From : Source_Ptr;
1114 To : Source_Ptr;
1115 Last : Boolean;
1116 Pragma_Sloc : Source_Ptr := No_Location;
1117 Pragma_Aspect_Name : Name_Id := No_Name)
1118 is
1119 begin
1120 SCO_Table.Append
1121 ((C1 => C1,
1122 C2 => C2,
1123 From => To_Source_Location (From),
1124 To => To_Source_Location (To),
1125 Last => Last,
1126 Pragma_Sloc => Pragma_Sloc,
1127 Pragma_Aspect_Name => Pragma_Aspect_Name));
1128 end Set_Table_Entry;
1129
1130 ------------------------
1131 -- To_Source_Location --
1132 ------------------------
1133
1134 function To_Source_Location (S : Source_Ptr) return Source_Location is
1135 begin
1136 if S = No_Location then
1137 return No_Source_Location;
1138 else
1139 return
1140 (Line => Get_Logical_Line_Number (S),
1141 Col => Get_Column_Number (S));
1142 end if;
1143 end To_Source_Location;
1144
1145 -----------------------------------------
1146 -- Traverse_Declarations_Or_Statements --
1147 -----------------------------------------
1148
1149 -- Tables used by Traverse_Declarations_Or_Statements for temporarily
1150 -- holding statement and decision entries. These are declared globally
1151 -- since they are shared by recursive calls to this procedure.
1152
1153 type SC_Entry is record
1154 N : Node_Id;
1155 From : Source_Ptr;
1156 To : Source_Ptr;
1157 Typ : Character;
1158 end record;
1159 -- Used to store a single entry in the following table, From:To represents
1160 -- the range of entries in the CS line entry, and typ is the type, with
1161 -- space meaning that no type letter will accompany the entry.
1162
1163 package SC is new Table.Table (
1164 Table_Component_Type => SC_Entry,
1165 Table_Index_Type => Nat,
1166 Table_Low_Bound => 1,
1167 Table_Initial => 1000,
1168 Table_Increment => 200,
1169 Table_Name => "SCO_SC");
1170 -- Used to store statement components for a CS entry to be output
1171 -- as a result of the call to this procedure. SC.Last is the last
1172 -- entry stored, so the current statement sequence is represented
1173 -- by SC_Array (SC_First .. SC.Last), where SC_First is saved on
1174 -- entry to each recursive call to the routine.
1175 --
1176 -- Extend_Statement_Sequence adds an entry to this array, and then
1177 -- Set_Statement_Entry clears the entries starting with SC_First,
1178 -- copying these entries to the main SCO output table. The reason that
1179 -- we do the temporary caching of results in this array is that we want
1180 -- the SCO table entries for a given CS line to be contiguous, and the
1181 -- processing may output intermediate entries such as decision entries.
1182
1183 type SD_Entry is record
1184 Nod : Node_Id;
1185 Lst : List_Id;
1186 Typ : Character;
1187 Plo : Source_Ptr;
1188 end record;
1189 -- Used to store a single entry in the following table. Nod is the node to
1190 -- be searched for decisions for the case of Process_Decisions_Defer with a
1191 -- node argument (with Lst set to No_List. Lst is the list to be searched
1192 -- for decisions for the case of Process_Decisions_Defer with a List
1193 -- argument (in which case Nod is set to Empty). Plo is the sloc of the
1194 -- enclosing pragma, if any.
1195
1196 package SD is new Table.Table (
1197 Table_Component_Type => SD_Entry,
1198 Table_Index_Type => Nat,
1199 Table_Low_Bound => 1,
1200 Table_Initial => 1000,
1201 Table_Increment => 200,
1202 Table_Name => "SCO_SD");
1203 -- Used to store possible decision information. Instead of calling the
1204 -- Process_Decisions procedures directly, we call Process_Decisions_Defer,
1205 -- which simply stores the arguments in this table. Then when we clear
1206 -- out a statement sequence using Set_Statement_Entry, after generating
1207 -- the CS lines for the statements, the entries in this table result in
1208 -- calls to Process_Decision. The reason for doing things this way is to
1209 -- ensure that decisions are output after the CS line for the statements
1210 -- in which the decisions occur.
1211
1212 procedure Traverse_Declarations_Or_Statements
1213 (L : List_Id;
1214 D : Dominant_Info := No_Dominant;
1215 P : Node_Id := Empty)
1216 is
1217 Discard_Dom : Dominant_Info;
1218 pragma Warnings (Off, Discard_Dom);
1219 begin
1220 Discard_Dom := Traverse_Declarations_Or_Statements (L, D, P);
1221 end Traverse_Declarations_Or_Statements;
1222
1223 function Traverse_Declarations_Or_Statements
1224 (L : List_Id;
1225 D : Dominant_Info := No_Dominant;
1226 P : Node_Id := Empty) return Dominant_Info
1227 is
1228 Current_Dominant : Dominant_Info := D;
1229 -- Dominance information for the current basic block
1230
1231 Current_Test : Node_Id;
1232 -- Conditional node (N_If_Statement or N_Elsiif being processed
1233
1234 N : Node_Id;
1235
1236 SC_First : constant Nat := SC.Last + 1;
1237 SD_First : constant Nat := SD.Last + 1;
1238 -- Record first entries used in SC/SD at this recursive level
1239
1240 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character);
1241 -- Extend the current statement sequence to encompass the node N. Typ
1242 -- is the letter that identifies the type of statement/declaration that
1243 -- is being added to the sequence.
1244
1245 procedure Set_Statement_Entry;
1246 -- Output CS entries for all statements saved in table SC, and end the
1247 -- current CS sequence. Then output entries for all decisions nested in
1248 -- these statements, which have been deferred so far.
1249
1250 procedure Process_Decisions_Defer (N : Node_Id; T : Character);
1251 pragma Inline (Process_Decisions_Defer);
1252 -- This routine is logically the same as Process_Decisions, except that
1253 -- the arguments are saved in the SD table for later processing when
1254 -- Set_Statement_Entry is called, which goes through the saved entries
1255 -- making the corresponding calls to Process_Decision.
1256
1257 procedure Process_Decisions_Defer (L : List_Id; T : Character);
1258 pragma Inline (Process_Decisions_Defer);
1259 -- Same case for list arguments, deferred call to Process_Decisions
1260
1261 procedure Traverse_One (N : Node_Id);
1262 -- Traverse one declaration or statement
1263
1264 procedure Traverse_Aspects (N : Node_Id);
1265 -- Helper for Traverse_One: traverse N's aspect specifications
1266
1267 -------------------------
1268 -- Set_Statement_Entry --
1269 -------------------------
1270
1271 procedure Set_Statement_Entry is
1272 SC_Last : constant Int := SC.Last;
1273 SD_Last : constant Int := SD.Last;
1274
1275 begin
1276 -- Output statement entries from saved entries in SC table
1277
1278 for J in SC_First .. SC_Last loop
1279 if J = SC_First then
1280
1281 if Current_Dominant /= No_Dominant then
1282 declare
1283 From, To : Source_Ptr;
1284 begin
1285 Sloc_Range (Current_Dominant.N, From, To);
1286 if Current_Dominant.K /= 'E' then
1287 To := No_Location;
1288 end if;
1289 Set_Table_Entry
1290 (C1 => '>',
1291 C2 => Current_Dominant.K,
1292 From => From,
1293 To => To,
1294 Last => False,
1295 Pragma_Sloc => No_Location,
1296 Pragma_Aspect_Name => No_Name);
1297 end;
1298 end if;
1299 end if;
1300
1301 declare
1302 SCE : SC_Entry renames SC.Table (J);
1303 Pragma_Sloc : Source_Ptr := No_Location;
1304 Pragma_Aspect_Name : Name_Id := No_Name;
1305 begin
1306 -- For the case of a statement SCO for a pragma controlled by
1307 -- Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
1308 -- those of any nested decision) is emitted only if the pragma
1309 -- is enabled.
1310
1311 if SCE.Typ = 'p' then
1312 Pragma_Sloc := SCE.From;
1313 Condition_Pragma_Hash_Table.Set
1314 (Pragma_Sloc, SCO_Table.Last + 1);
1315 Pragma_Aspect_Name := Pragma_Name (SCE.N);
1316 pragma Assert (Pragma_Aspect_Name /= No_Name);
1317
1318 elsif SCE.Typ = 'P' then
1319 Pragma_Aspect_Name := Pragma_Name (SCE.N);
1320 pragma Assert (Pragma_Aspect_Name /= No_Name);
1321 end if;
1322
1323 Set_Table_Entry
1324 (C1 => 'S',
1325 C2 => SCE.Typ,
1326 From => SCE.From,
1327 To => SCE.To,
1328 Last => (J = SC_Last),
1329 Pragma_Sloc => Pragma_Sloc,
1330 Pragma_Aspect_Name => Pragma_Aspect_Name);
1331 end;
1332 end loop;
1333
1334 -- Last statement of basic block, if present, becomes new current
1335 -- dominant.
1336
1337 if SC_Last >= SC_First then
1338 Current_Dominant := ('S', SC.Table (SC_Last).N);
1339 end if;
1340
1341 -- Clear out used section of SC table
1342
1343 SC.Set_Last (SC_First - 1);
1344
1345 -- Output any embedded decisions
1346
1347 for J in SD_First .. SD_Last loop
1348 declare
1349 SDE : SD_Entry renames SD.Table (J);
1350 begin
1351 if Present (SDE.Nod) then
1352 Process_Decisions (SDE.Nod, SDE.Typ, SDE.Plo);
1353 else
1354 Process_Decisions (SDE.Lst, SDE.Typ, SDE.Plo);
1355 end if;
1356 end;
1357 end loop;
1358
1359 -- Clear out used section of SD table
1360
1361 SD.Set_Last (SD_First - 1);
1362 end Set_Statement_Entry;
1363
1364 -------------------------------
1365 -- Extend_Statement_Sequence --
1366 -------------------------------
1367
1368 procedure Extend_Statement_Sequence (N : Node_Id; Typ : Character) is
1369 F : Source_Ptr;
1370 T : Source_Ptr;
1371 Dummy : Source_Ptr;
1372 To_Node : Node_Id := Empty;
1373
1374 begin
1375 Sloc_Range (N, F, T);
1376
1377 case Nkind (N) is
1378 when N_Accept_Statement =>
1379 if Present (Parameter_Specifications (N)) then
1380 To_Node := Last (Parameter_Specifications (N));
1381 elsif Present (Entry_Index (N)) then
1382 To_Node := Entry_Index (N);
1383 end if;
1384
1385 when N_Case_Statement =>
1386 To_Node := Expression (N);
1387
1388 when N_If_Statement | N_Elsif_Part =>
1389 To_Node := Condition (N);
1390
1391 when N_Extended_Return_Statement =>
1392 To_Node := Last (Return_Object_Declarations (N));
1393
1394 when N_Loop_Statement =>
1395 To_Node := Iteration_Scheme (N);
1396
1397 when N_Selective_Accept |
1398 N_Timed_Entry_Call |
1399 N_Conditional_Entry_Call |
1400 N_Asynchronous_Select |
1401 N_Single_Protected_Declaration |
1402 N_Single_Task_Declaration =>
1403 T := F;
1404
1405 when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
1406 if Has_Aspects (N) then
1407 To_Node := Last (Aspect_Specifications (N));
1408
1409 elsif Present (Discriminant_Specifications (N)) then
1410 To_Node := Last (Discriminant_Specifications (N));
1411
1412 else
1413 To_Node := Defining_Identifier (N);
1414 end if;
1415
1416 when others =>
1417 null;
1418
1419 end case;
1420
1421 if Present (To_Node) then
1422 Sloc_Range (To_Node, Dummy, T);
1423 end if;
1424
1425 SC.Append ((N, F, T, Typ));
1426 end Extend_Statement_Sequence;
1427
1428 -----------------------------
1429 -- Process_Decisions_Defer --
1430 -----------------------------
1431
1432 procedure Process_Decisions_Defer (N : Node_Id; T : Character) is
1433 begin
1434 SD.Append ((N, No_List, T, Current_Pragma_Sloc));
1435 end Process_Decisions_Defer;
1436
1437 procedure Process_Decisions_Defer (L : List_Id; T : Character) is
1438 begin
1439 SD.Append ((Empty, L, T, Current_Pragma_Sloc));
1440 end Process_Decisions_Defer;
1441
1442 ----------------------
1443 -- Traverse_Aspects --
1444 ----------------------
1445
1446 procedure Traverse_Aspects (N : Node_Id) is
1447 AN : Node_Id;
1448 AE : Node_Id;
1449 C1 : Character;
1450
1451 begin
1452 AN := First (Aspect_Specifications (N));
1453 while Present (AN) loop
1454 AE := Expression (AN);
1455
1456 -- SCOs are generated before semantic analysis/expansion:
1457 -- PPCs are not split yet.
1458
1459 pragma Assert (not Split_PPC (AN));
1460
1461 C1 := ASCII.NUL;
1462
1463 case Get_Aspect_Id (AN) is
1464
1465 -- Aspects rewritten into pragmas controlled by a Check_Policy:
1466 -- Current_Pragma_Sloc must be set to the sloc of the aspect
1467 -- specification. The corresponding pragma will have the same
1468 -- sloc.
1469
1470 when Aspect_Pre |
1471 Aspect_Precondition |
1472 Aspect_Post |
1473 Aspect_Postcondition |
1474 Aspect_Invariant =>
1475
1476 C1 := 'a';
1477
1478 -- Aspects whose checks are generated in client units,
1479 -- regardless of whether or not the check is activated in the
1480 -- unit which contains the declaration: create decision as
1481 -- unconditionally enabled aspect (but still make a pragma
1482 -- entry since Set_SCO_Pragma_Enabled will be called when
1483 -- analyzing actual checks, possibly in other units).
1484
1485 -- Pre/post can have checks in client units too because of
1486 -- inheritance, so should they be moved here???
1487
1488 when Aspect_Predicate |
1489 Aspect_Static_Predicate |
1490 Aspect_Dynamic_Predicate |
1491 Aspect_Type_Invariant =>
1492
1493 C1 := 'A';
1494
1495 -- Other aspects: just process any decision nested in the
1496 -- aspect expression.
1497
1498 when others =>
1499
1500 if Has_Decision (AE) then
1501 C1 := 'X';
1502 end if;
1503
1504 end case;
1505
1506 if C1 /= ASCII.NUL then
1507 pragma Assert (Current_Pragma_Sloc = No_Location);
1508
1509 if C1 = 'a' or else C1 = 'A' then
1510 Current_Pragma_Sloc := Sloc (AN);
1511 end if;
1512
1513 Process_Decisions_Defer (AE, C1);
1514
1515 Current_Pragma_Sloc := No_Location;
1516 end if;
1517
1518 Next (AN);
1519 end loop;
1520 end Traverse_Aspects;
1521
1522 ------------------
1523 -- Traverse_One --
1524 ------------------
1525
1526 procedure Traverse_One (N : Node_Id) is
1527 begin
1528 -- Initialize or extend current statement sequence. Note that for
1529 -- special cases such as IF and Case statements we will modify
1530 -- the range to exclude internal statements that should not be
1531 -- counted as part of the current statement sequence.
1532
1533 case Nkind (N) is
1534
1535 -- Package declaration
1536
1537 when N_Package_Declaration =>
1538 Set_Statement_Entry;
1539 Traverse_Package_Declaration (N, Current_Dominant);
1540
1541 -- Generic package declaration
1542
1543 when N_Generic_Package_Declaration =>
1544 Set_Statement_Entry;
1545 Traverse_Generic_Package_Declaration (N);
1546
1547 -- Package body
1548
1549 when N_Package_Body =>
1550 Set_Statement_Entry;
1551 Traverse_Package_Body (N);
1552
1553 -- Subprogram declaration or subprogram body stub
1554
1555 when N_Subprogram_Declaration | N_Subprogram_Body_Stub =>
1556 Process_Decisions_Defer
1557 (Parameter_Specifications (Specification (N)), 'X');
1558
1559 -- Entry declaration
1560
1561 when N_Entry_Declaration =>
1562 Process_Decisions_Defer (Parameter_Specifications (N), 'X');
1563
1564 -- Generic subprogram declaration
1565
1566 when N_Generic_Subprogram_Declaration =>
1567 Process_Decisions_Defer
1568 (Generic_Formal_Declarations (N), 'X');
1569 Process_Decisions_Defer
1570 (Parameter_Specifications (Specification (N)), 'X');
1571
1572 -- Task or subprogram body
1573
1574 when N_Task_Body | N_Subprogram_Body =>
1575 Set_Statement_Entry;
1576 Traverse_Subprogram_Or_Task_Body (N);
1577
1578 -- Entry body
1579
1580 when N_Entry_Body =>
1581 declare
1582 Cond : constant Node_Id :=
1583 Condition (Entry_Body_Formal_Part (N));
1584
1585 Inner_Dominant : Dominant_Info := No_Dominant;
1586
1587 begin
1588 Set_Statement_Entry;
1589
1590 if Present (Cond) then
1591 Process_Decisions_Defer (Cond, 'G');
1592
1593 -- For an entry body with a barrier, the entry body
1594 -- is dominanted by a True evaluation of the barrier.
1595
1596 Inner_Dominant := ('T', N);
1597 end if;
1598
1599 Traverse_Subprogram_Or_Task_Body (N, Inner_Dominant);
1600 end;
1601
1602 -- Protected body
1603
1604 when N_Protected_Body =>
1605 Set_Statement_Entry;
1606 Traverse_Declarations_Or_Statements (Declarations (N));
1607
1608 -- Exit statement, which is an exit statement in the SCO sense,
1609 -- so it is included in the current statement sequence, but
1610 -- then it terminates this sequence. We also have to process
1611 -- any decisions in the exit statement expression.
1612
1613 when N_Exit_Statement =>
1614 Extend_Statement_Sequence (N, 'E');
1615 Process_Decisions_Defer (Condition (N), 'E');
1616 Set_Statement_Entry;
1617
1618 -- If condition is present, then following statement is
1619 -- only executed if the condition evaluates to False.
1620
1621 if Present (Condition (N)) then
1622 Current_Dominant := ('F', N);
1623 else
1624 Current_Dominant := No_Dominant;
1625 end if;
1626
1627 -- Label, which breaks the current statement sequence, but the
1628 -- label itself is not included in the next statement sequence,
1629 -- since it generates no code.
1630
1631 when N_Label =>
1632 Set_Statement_Entry;
1633 Current_Dominant := No_Dominant;
1634
1635 -- Block statement, which breaks the current statement sequence
1636
1637 when N_Block_Statement =>
1638 Set_Statement_Entry;
1639
1640 -- The first statement in the handled sequence of statements
1641 -- is dominated by the elaboration of the last declaration.
1642
1643 Current_Dominant := Traverse_Declarations_Or_Statements
1644 (L => Declarations (N),
1645 D => Current_Dominant);
1646
1647 Traverse_Handled_Statement_Sequence
1648 (N => Handled_Statement_Sequence (N),
1649 D => Current_Dominant);
1650
1651 -- If statement, which breaks the current statement sequence,
1652 -- but we include the condition in the current sequence.
1653
1654 when N_If_Statement =>
1655 Current_Test := N;
1656 Extend_Statement_Sequence (N, 'I');
1657 Process_Decisions_Defer (Condition (N), 'I');
1658 Set_Statement_Entry;
1659
1660 -- Now we traverse the statements in the THEN part
1661
1662 Traverse_Declarations_Or_Statements
1663 (L => Then_Statements (N),
1664 D => ('T', N));
1665
1666 -- Loop through ELSIF parts if present
1667
1668 if Present (Elsif_Parts (N)) then
1669 declare
1670 Saved_Dominant : constant Dominant_Info :=
1671 Current_Dominant;
1672
1673 Elif : Node_Id := First (Elsif_Parts (N));
1674
1675 begin
1676 while Present (Elif) loop
1677
1678 -- An Elsif is executed only if the previous test
1679 -- got a FALSE outcome.
1680
1681 Current_Dominant := ('F', Current_Test);
1682
1683 -- Now update current test information
1684
1685 Current_Test := Elif;
1686
1687 -- We generate a statement sequence for the
1688 -- construct "ELSIF condition", so that we have
1689 -- a statement for the resulting decisions.
1690
1691 Extend_Statement_Sequence (Elif, 'I');
1692 Process_Decisions_Defer (Condition (Elif), 'I');
1693 Set_Statement_Entry;
1694
1695 -- An ELSIF part is never guaranteed to have
1696 -- been executed, following statements are only
1697 -- dominated by the initial IF statement.
1698
1699 Current_Dominant := Saved_Dominant;
1700
1701 -- Traverse the statements in the ELSIF
1702
1703 Traverse_Declarations_Or_Statements
1704 (L => Then_Statements (Elif),
1705 D => ('T', Elif));
1706 Next (Elif);
1707 end loop;
1708 end;
1709 end if;
1710
1711 -- Finally traverse the ELSE statements if present
1712
1713 Traverse_Declarations_Or_Statements
1714 (L => Else_Statements (N),
1715 D => ('F', Current_Test));
1716
1717 -- CASE statement, which breaks the current statement sequence,
1718 -- but we include the expression in the current sequence.
1719
1720 when N_Case_Statement =>
1721 Extend_Statement_Sequence (N, 'C');
1722 Process_Decisions_Defer (Expression (N), 'X');
1723 Set_Statement_Entry;
1724
1725 -- Process case branches, all of which are dominated by the
1726 -- CASE statement.
1727
1728 declare
1729 Alt : Node_Id;
1730 begin
1731 Alt := First (Alternatives (N));
1732 while Present (Alt) loop
1733 Traverse_Declarations_Or_Statements
1734 (L => Statements (Alt),
1735 D => Current_Dominant);
1736 Next (Alt);
1737 end loop;
1738 end;
1739
1740 -- ACCEPT statement
1741
1742 when N_Accept_Statement =>
1743 Extend_Statement_Sequence (N, 'A');
1744 Set_Statement_Entry;
1745
1746 -- Process sequence of statements, dominant is the ACCEPT
1747 -- statement.
1748
1749 Traverse_Handled_Statement_Sequence
1750 (N => Handled_Statement_Sequence (N),
1751 D => Current_Dominant);
1752
1753 -- SELECT
1754
1755 when N_Selective_Accept =>
1756 Extend_Statement_Sequence (N, 'S');
1757 Set_Statement_Entry;
1758
1759 -- Process alternatives
1760
1761 declare
1762 Alt : Node_Id;
1763 Guard : Node_Id;
1764 S_Dom : Dominant_Info;
1765
1766 begin
1767 Alt := First (Select_Alternatives (N));
1768 while Present (Alt) loop
1769 S_Dom := Current_Dominant;
1770 Guard := Condition (Alt);
1771
1772 if Present (Guard) then
1773 Process_Decisions
1774 (Guard,
1775 'G',
1776 Pragma_Sloc => No_Location);
1777 Current_Dominant := ('T', Guard);
1778 end if;
1779
1780 Traverse_One (Alt);
1781
1782 Current_Dominant := S_Dom;
1783 Next (Alt);
1784 end loop;
1785 end;
1786
1787 Traverse_Declarations_Or_Statements
1788 (L => Else_Statements (N),
1789 D => Current_Dominant);
1790
1791 when N_Timed_Entry_Call | N_Conditional_Entry_Call =>
1792 Extend_Statement_Sequence (N, 'S');
1793 Set_Statement_Entry;
1794
1795 -- Process alternatives
1796
1797 Traverse_One (Entry_Call_Alternative (N));
1798
1799 if Nkind (N) = N_Timed_Entry_Call then
1800 Traverse_One (Delay_Alternative (N));
1801 else
1802 Traverse_Declarations_Or_Statements
1803 (L => Else_Statements (N),
1804 D => Current_Dominant);
1805 end if;
1806
1807 when N_Asynchronous_Select =>
1808 Extend_Statement_Sequence (N, 'S');
1809 Set_Statement_Entry;
1810
1811 Traverse_One (Triggering_Alternative (N));
1812 Traverse_Declarations_Or_Statements
1813 (L => Statements (Abortable_Part (N)),
1814 D => Current_Dominant);
1815
1816 when N_Accept_Alternative =>
1817 Traverse_Declarations_Or_Statements
1818 (L => Statements (N),
1819 D => Current_Dominant,
1820 P => Accept_Statement (N));
1821
1822 when N_Entry_Call_Alternative =>
1823 Traverse_Declarations_Or_Statements
1824 (L => Statements (N),
1825 D => Current_Dominant,
1826 P => Entry_Call_Statement (N));
1827
1828 when N_Delay_Alternative =>
1829 Traverse_Declarations_Or_Statements
1830 (L => Statements (N),
1831 D => Current_Dominant,
1832 P => Delay_Statement (N));
1833
1834 when N_Triggering_Alternative =>
1835 Traverse_Declarations_Or_Statements
1836 (L => Statements (N),
1837 D => Current_Dominant,
1838 P => Triggering_Statement (N));
1839
1840 when N_Terminate_Alternative =>
1841
1842 -- It is dubious to emit a statement SCO for a TERMINATE
1843 -- alternative, since no code is actually executed if the
1844 -- alternative is selected -- the tasking runtime call just
1845 -- never returns???
1846
1847 Extend_Statement_Sequence (N, ' ');
1848 Set_Statement_Entry;
1849
1850 -- Unconditional exit points, which are included in the current
1851 -- statement sequence, but then terminate it
1852
1853 when N_Requeue_Statement |
1854 N_Goto_Statement |
1855 N_Raise_Statement =>
1856 Extend_Statement_Sequence (N, ' ');
1857 Set_Statement_Entry;
1858 Current_Dominant := No_Dominant;
1859
1860 -- Simple return statement. which is an exit point, but we
1861 -- have to process the return expression for decisions.
1862
1863 when N_Simple_Return_Statement =>
1864 Extend_Statement_Sequence (N, ' ');
1865 Process_Decisions_Defer (Expression (N), 'X');
1866 Set_Statement_Entry;
1867 Current_Dominant := No_Dominant;
1868
1869 -- Extended return statement
1870
1871 when N_Extended_Return_Statement =>
1872 Extend_Statement_Sequence (N, 'R');
1873 Process_Decisions_Defer
1874 (Return_Object_Declarations (N), 'X');
1875 Set_Statement_Entry;
1876
1877 Traverse_Handled_Statement_Sequence
1878 (N => Handled_Statement_Sequence (N),
1879 D => Current_Dominant);
1880
1881 Current_Dominant := No_Dominant;
1882
1883 -- Loop ends the current statement sequence, but we include
1884 -- the iteration scheme if present in the current sequence.
1885 -- But the body of the loop starts a new sequence, since it
1886 -- may not be executed as part of the current sequence.
1887
1888 when N_Loop_Statement =>
1889 declare
1890 ISC : constant Node_Id := Iteration_Scheme (N);
1891 Inner_Dominant : Dominant_Info := No_Dominant;
1892
1893 begin
1894 if Present (ISC) then
1895
1896 -- If iteration scheme present, extend the current
1897 -- statement sequence to include the iteration scheme
1898 -- and process any decisions it contains.
1899
1900 -- While loop
1901
1902 if Present (Condition (ISC)) then
1903 Extend_Statement_Sequence (N, 'W');
1904 Process_Decisions_Defer (Condition (ISC), 'W');
1905
1906 -- Set more specific dominant for inner statements
1907 -- (the control sloc for the decision is that of
1908 -- the WHILE token).
1909
1910 Inner_Dominant := ('T', ISC);
1911
1912 -- For loop
1913
1914 else
1915 Extend_Statement_Sequence (N, 'F');
1916 Process_Decisions_Defer
1917 (Loop_Parameter_Specification (ISC), 'X');
1918 end if;
1919 end if;
1920
1921 Set_Statement_Entry;
1922
1923 if Inner_Dominant = No_Dominant then
1924 Inner_Dominant := Current_Dominant;
1925 end if;
1926
1927 Traverse_Declarations_Or_Statements
1928 (L => Statements (N),
1929 D => Inner_Dominant);
1930 end;
1931
1932 -- Pragma
1933
1934 when N_Pragma =>
1935
1936 -- Record sloc of pragma (pragmas don't nest)
1937
1938 pragma Assert (Current_Pragma_Sloc = No_Location);
1939 Current_Pragma_Sloc := Sloc (N);
1940
1941 -- Processing depends on the kind of pragma
1942
1943 declare
1944 Nam : constant Name_Id := Pragma_Name (N);
1945 Arg : Node_Id :=
1946 First (Pragma_Argument_Associations (N));
1947 Typ : Character;
1948
1949 begin
1950 case Nam is
1951 when Name_Assert |
1952 Name_Assert_And_Cut |
1953 Name_Assume |
1954 Name_Check |
1955 Name_Loop_Invariant |
1956 Name_Precondition |
1957 Name_Postcondition =>
1958
1959 -- For Assert/Check/Precondition/Postcondition, we
1960 -- must generate a P entry for the decision. Note
1961 -- that this is done unconditionally at this stage.
1962 -- Output for disabled pragmas is suppressed later
1963 -- on when we output the decision line in Put_SCOs,
1964 -- depending on setting by Set_SCO_Pragma_Enabled.
1965
1966 if Nam = Name_Check then
1967 Next (Arg);
1968 end if;
1969
1970 Process_Decisions_Defer (Expression (Arg), 'P');
1971 Typ := 'p';
1972
1973 -- Pre/postconditions can be inherited so SCO should
1974 -- never be deactivated???
1975
1976 when Name_Debug =>
1977 if Present (Arg) and then Present (Next (Arg)) then
1978
1979 -- Case of a dyadic pragma Debug: first argument
1980 -- is a P decision, any nested decision in the
1981 -- second argument is an X decision.
1982
1983 Process_Decisions_Defer (Expression (Arg), 'P');
1984 Next (Arg);
1985 end if;
1986
1987 Process_Decisions_Defer (Expression (Arg), 'X');
1988 Typ := 'p';
1989
1990 -- For all other pragmas, we generate decision entries
1991 -- for any embedded expressions, and the pragma is
1992 -- never disabled.
1993
1994 -- Should generate P decisions (not X) for assertion
1995 -- related pragmas: [Type_]Invariant,
1996 -- [{Static,Dynamic}_]Predicate???
1997
1998 when others =>
1999 Process_Decisions_Defer (N, 'X');
2000 Typ := 'P';
2001 end case;
2002
2003 -- Add statement SCO
2004
2005 Extend_Statement_Sequence (N, Typ);
2006
2007 Current_Pragma_Sloc := No_Location;
2008 end;
2009
2010 -- Object declaration. Ignored if Prev_Ids is set, since the
2011 -- parser generates multiple instances of the whole declaration
2012 -- if there is more than one identifier declared, and we only
2013 -- want one entry in the SCOs, so we take the first, for which
2014 -- Prev_Ids is False.
2015
2016 when N_Object_Declaration | N_Number_Declaration =>
2017 if not Prev_Ids (N) then
2018 Extend_Statement_Sequence (N, 'o');
2019
2020 if Has_Decision (N) then
2021 Process_Decisions_Defer (N, 'X');
2022 end if;
2023 end if;
2024
2025 -- All other cases, which extend the current statement sequence
2026 -- but do not terminate it, even if they have nested decisions.
2027
2028 when N_Protected_Type_Declaration | N_Task_Type_Declaration =>
2029 Extend_Statement_Sequence (N, 't');
2030 Process_Decisions_Defer (Discriminant_Specifications (N), 'X');
2031 Set_Statement_Entry;
2032
2033 Traverse_Sync_Definition (N);
2034
2035 when N_Single_Protected_Declaration | N_Single_Task_Declaration =>
2036 Extend_Statement_Sequence (N, 'o');
2037 Set_Statement_Entry;
2038
2039 Traverse_Sync_Definition (N);
2040
2041 when others =>
2042
2043 -- Determine required type character code, or ASCII.NUL if
2044 -- no SCO should be generated for this node.
2045
2046 declare
2047 NK : constant Node_Kind := Nkind (N);
2048 Typ : Character;
2049
2050 begin
2051 case NK is
2052 when N_Full_Type_Declaration |
2053 N_Incomplete_Type_Declaration |
2054 N_Private_Type_Declaration |
2055 N_Private_Extension_Declaration =>
2056 Typ := 't';
2057
2058 when N_Subtype_Declaration =>
2059 Typ := 's';
2060
2061 when N_Renaming_Declaration =>
2062 Typ := 'r';
2063
2064 when N_Generic_Instantiation =>
2065 Typ := 'i';
2066
2067 when N_Representation_Clause |
2068 N_Use_Package_Clause |
2069 N_Use_Type_Clause |
2070 N_Package_Body_Stub |
2071 N_Task_Body_Stub |
2072 N_Protected_Body_Stub =>
2073 Typ := ASCII.NUL;
2074
2075 when N_Procedure_Call_Statement =>
2076 Typ := ' ';
2077
2078 when others =>
2079 if NK in N_Statement_Other_Than_Procedure_Call then
2080 Typ := ' ';
2081 else
2082 Typ := 'd';
2083 end if;
2084 end case;
2085
2086 if Typ /= ASCII.NUL then
2087 Extend_Statement_Sequence (N, Typ);
2088 end if;
2089 end;
2090
2091 -- Process any embedded decisions
2092
2093 if Has_Decision (N) then
2094 Process_Decisions_Defer (N, 'X');
2095 end if;
2096 end case;
2097
2098 -- Process aspects if present
2099
2100 Traverse_Aspects (N);
2101 end Traverse_One;
2102
2103 -- Start of processing for Traverse_Declarations_Or_Statements
2104
2105 begin
2106 -- Process single prefixed node
2107
2108 if Present (P) then
2109 Traverse_One (P);
2110 end if;
2111
2112 -- Loop through statements or declarations
2113
2114 if Is_Non_Empty_List (L) then
2115 N := First (L);
2116 while Present (N) loop
2117
2118 -- Note: For separate bodies, we see the tree after Par.Labl has
2119 -- introduced implicit labels, so we need to ignore those nodes.
2120
2121 if Nkind (N) /= N_Implicit_Label_Declaration then
2122 Traverse_One (N);
2123 end if;
2124
2125 Next (N);
2126 end loop;
2127
2128 end if;
2129
2130 -- End sequence of statements and flush deferred decisions
2131
2132 if Present (P) or else Is_Non_Empty_List (L) then
2133 Set_Statement_Entry;
2134 end if;
2135
2136 return Current_Dominant;
2137 end Traverse_Declarations_Or_Statements;
2138
2139 ------------------------------------------
2140 -- Traverse_Generic_Package_Declaration --
2141 ------------------------------------------
2142
2143 procedure Traverse_Generic_Package_Declaration (N : Node_Id) is
2144 begin
2145 Process_Decisions (Generic_Formal_Declarations (N), 'X', No_Location);
2146 Traverse_Package_Declaration (N);
2147 end Traverse_Generic_Package_Declaration;
2148
2149 -----------------------------------------
2150 -- Traverse_Handled_Statement_Sequence --
2151 -----------------------------------------
2152
2153 procedure Traverse_Handled_Statement_Sequence
2154 (N : Node_Id;
2155 D : Dominant_Info := No_Dominant)
2156 is
2157 Handler : Node_Id;
2158
2159 begin
2160 -- For package bodies without a statement part, the parser adds an empty
2161 -- one, to normalize the representation. The null statement therein,
2162 -- which does not come from source, does not get a SCO.
2163
2164 if Present (N) and then Comes_From_Source (N) then
2165 Traverse_Declarations_Or_Statements (Statements (N), D);
2166
2167 if Present (Exception_Handlers (N)) then
2168 Handler := First (Exception_Handlers (N));
2169 while Present (Handler) loop
2170 Traverse_Declarations_Or_Statements
2171 (L => Statements (Handler),
2172 D => ('E', Handler));
2173 Next (Handler);
2174 end loop;
2175 end if;
2176 end if;
2177 end Traverse_Handled_Statement_Sequence;
2178
2179 ---------------------------
2180 -- Traverse_Package_Body --
2181 ---------------------------
2182
2183 procedure Traverse_Package_Body (N : Node_Id) is
2184 Dom : Dominant_Info;
2185 begin
2186 -- The first statement in the handled sequence of statements is
2187 -- dominated by the elaboration of the last declaration.
2188
2189 Dom := Traverse_Declarations_Or_Statements (Declarations (N));
2190
2191 Traverse_Handled_Statement_Sequence
2192 (Handled_Statement_Sequence (N), Dom);
2193 end Traverse_Package_Body;
2194
2195 ----------------------------------
2196 -- Traverse_Package_Declaration --
2197 ----------------------------------
2198
2199 procedure Traverse_Package_Declaration
2200 (N : Node_Id;
2201 D : Dominant_Info := No_Dominant)
2202 is
2203 Spec : constant Node_Id := Specification (N);
2204 Dom : Dominant_Info;
2205
2206 begin
2207 Dom :=
2208 Traverse_Declarations_Or_Statements (Visible_Declarations (Spec), D);
2209
2210 -- First private declaration is dominated by last visible declaration
2211
2212 Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
2213 end Traverse_Package_Declaration;
2214
2215 ------------------------------
2216 -- Traverse_Sync_Definition --
2217 ------------------------------
2218
2219 procedure Traverse_Sync_Definition (N : Node_Id) is
2220 Dom_Info : Dominant_Info := ('S', N);
2221 -- The first declaration is dominated by the protected or task [type]
2222 -- declaration.
2223
2224 Sync_Def : Node_Id;
2225 -- N's protected or task definition
2226
2227 Vis_Decl : List_Id;
2228 -- Sync_Def's Visible_Declarations
2229
2230 begin
2231 case Nkind (N) is
2232 when N_Single_Protected_Declaration | N_Protected_Type_Declaration =>
2233 Sync_Def := Protected_Definition (N);
2234
2235 when N_Single_Task_Declaration | N_Task_Type_Declaration =>
2236 Sync_Def := Task_Definition (N);
2237
2238 when others =>
2239 raise Program_Error;
2240 end case;
2241
2242 Vis_Decl := Visible_Declarations (Sync_Def);
2243
2244 Dom_Info := Traverse_Declarations_Or_Statements
2245 (L => Vis_Decl,
2246 D => Dom_Info);
2247
2248 -- If visible declarations are present, the first private declaration
2249 -- is dominated by the last visible declaration.
2250
2251 Traverse_Declarations_Or_Statements
2252 (L => Private_Declarations (Sync_Def),
2253 D => Dom_Info);
2254 end Traverse_Sync_Definition;
2255
2256 --------------------------------------
2257 -- Traverse_Subprogram_Or_Task_Body --
2258 --------------------------------------
2259
2260 procedure Traverse_Subprogram_Or_Task_Body
2261 (N : Node_Id;
2262 D : Dominant_Info := No_Dominant)
2263 is
2264 Decls : constant List_Id := Declarations (N);
2265 Dom_Info : Dominant_Info := D;
2266 begin
2267 -- If declarations are present, the first statement is dominated by the
2268 -- last declaration.
2269
2270 Dom_Info := Traverse_Declarations_Or_Statements
2271 (L => Decls, D => Dom_Info);
2272
2273 Traverse_Handled_Statement_Sequence
2274 (N => Handled_Statement_Sequence (N),
2275 D => Dom_Info);
2276 end Traverse_Subprogram_Or_Task_Body;
2277
2278 end Par_SCO;
Mirror of the offical gcc git repository hosted at gcc.gnu.org