1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Debug_A; use Debug_A;
30 with Einfo; use Einfo;
31 with Errout; use Errout;
32 with Expander; use Expander;
33 with Fname; use Fname;
36 with Lib.Load; use Lib.Load;
37 with Nlists; use Nlists;
39 with Sem_Attr; use Sem_Attr;
40 with Sem_Ch2; use Sem_Ch2;
41 with Sem_Ch3; use Sem_Ch3;
42 with Sem_Ch4; use Sem_Ch4;
43 with Sem_Ch5; use Sem_Ch5;
44 with Sem_Ch6; use Sem_Ch6;
45 with Sem_Ch7; use Sem_Ch7;
46 with Sem_Ch8; use Sem_Ch8;
47 with Sem_Ch9; use Sem_Ch9;
48 with Sem_Ch10; use Sem_Ch10;
49 with Sem_Ch11; use Sem_Ch11;
50 with Sem_Ch12; use Sem_Ch12;
51 with Sem_Ch13; use Sem_Ch13;
52 with Sem_Prag; use Sem_Prag;
53 with Sem_Util; use Sem_Util;
54 with Sinfo; use Sinfo;
55 with Stand; use Stand;
56 with Uintp; use Uintp;
58 pragma Warnings (Off, Sem_Util);
59 -- Suppress warnings of unused with for Sem_Util (used only in asserts)
63 Outer_Generic_Scope : Entity_Id := Empty;
64 -- Global reference to the outer scope that is generic. In a non
65 -- generic context, it is empty. At the moment, it is only used
66 -- for avoiding freezing of external references in generics.
72 procedure Analyze (N : Node_Id) is
74 Debug_A_Entry ("analyzing ", N);
76 -- Immediate return if already analyzed
79 Debug_A_Exit ("analyzing ", N, " (done, analyzed already)");
83 -- Otherwise processing depends on the node kind
87 when N_Abort_Statement =>
88 Analyze_Abort_Statement (N);
90 when N_Abstract_Subprogram_Declaration =>
91 Analyze_Abstract_Subprogram_Declaration (N);
93 when N_Accept_Alternative =>
94 Analyze_Accept_Alternative (N);
96 when N_Accept_Statement =>
97 Analyze_Accept_Statement (N);
100 Analyze_Aggregate (N);
103 Analyze_Allocator (N);
106 Analyze_Short_Circuit (N);
108 when N_Assignment_Statement =>
109 Analyze_Assignment (N);
111 when N_Asynchronous_Select =>
112 Analyze_Asynchronous_Select (N);
115 Analyze_At_Clause (N);
117 when N_Attribute_Reference =>
118 Analyze_Attribute (N);
120 when N_Attribute_Definition_Clause =>
121 Analyze_Attribute_Definition_Clause (N);
123 when N_Block_Statement =>
124 Analyze_Block_Statement (N);
126 when N_Case_Statement =>
127 Analyze_Case_Statement (N);
129 when N_Character_Literal =>
130 Analyze_Character_Literal (N);
132 when N_Code_Statement =>
133 Analyze_Code_Statement (N);
135 when N_Compilation_Unit =>
136 Analyze_Compilation_Unit (N);
138 when N_Component_Declaration =>
139 Analyze_Component_Declaration (N);
141 when N_Conditional_Expression =>
142 Analyze_Conditional_Expression (N);
144 when N_Conditional_Entry_Call =>
145 Analyze_Conditional_Entry_Call (N);
147 when N_Delay_Alternative =>
148 Analyze_Delay_Alternative (N);
150 when N_Delay_Relative_Statement =>
151 Analyze_Delay_Relative (N);
153 when N_Delay_Until_Statement =>
154 Analyze_Delay_Until (N);
157 Analyze_Entry_Body (N);
159 when N_Entry_Body_Formal_Part =>
160 Analyze_Entry_Body_Formal_Part (N);
162 when N_Entry_Call_Alternative =>
163 Analyze_Entry_Call_Alternative (N);
165 when N_Entry_Declaration =>
166 Analyze_Entry_Declaration (N);
168 when N_Entry_Index_Specification =>
169 Analyze_Entry_Index_Specification (N);
171 when N_Enumeration_Representation_Clause =>
172 Analyze_Enumeration_Representation_Clause (N);
174 when N_Exception_Declaration =>
175 Analyze_Exception_Declaration (N);
177 when N_Exception_Renaming_Declaration =>
178 Analyze_Exception_Renaming (N);
180 when N_Exit_Statement =>
181 Analyze_Exit_Statement (N);
183 when N_Expanded_Name =>
184 Analyze_Expanded_Name (N);
186 when N_Explicit_Dereference =>
187 Analyze_Explicit_Dereference (N);
189 when N_Extension_Aggregate =>
190 Analyze_Aggregate (N);
192 when N_Formal_Object_Declaration =>
193 Analyze_Formal_Object_Declaration (N);
195 when N_Formal_Package_Declaration =>
196 Analyze_Formal_Package (N);
198 when N_Formal_Subprogram_Declaration =>
199 Analyze_Formal_Subprogram (N);
201 when N_Formal_Type_Declaration =>
202 Analyze_Formal_Type_Declaration (N);
204 when N_Free_Statement =>
205 Analyze_Free_Statement (N);
207 when N_Freeze_Entity =>
208 null; -- no semantic processing required
210 when N_Full_Type_Declaration =>
211 Analyze_Type_Declaration (N);
213 when N_Function_Call =>
214 Analyze_Function_Call (N);
216 when N_Function_Instantiation =>
217 Analyze_Function_Instantiation (N);
219 when N_Generic_Function_Renaming_Declaration =>
220 Analyze_Generic_Function_Renaming (N);
222 when N_Generic_Package_Declaration =>
223 Analyze_Generic_Package_Declaration (N);
225 when N_Generic_Package_Renaming_Declaration =>
226 Analyze_Generic_Package_Renaming (N);
228 when N_Generic_Procedure_Renaming_Declaration =>
229 Analyze_Generic_Procedure_Renaming (N);
231 when N_Generic_Subprogram_Declaration =>
232 Analyze_Generic_Subprogram_Declaration (N);
234 when N_Goto_Statement =>
235 Analyze_Goto_Statement (N);
237 when N_Handled_Sequence_Of_Statements =>
238 Analyze_Handled_Statements (N);
241 Analyze_Identifier (N);
243 when N_If_Statement =>
244 Analyze_If_Statement (N);
246 when N_Implicit_Label_Declaration =>
247 Analyze_Implicit_Label_Declaration (N);
250 Analyze_Membership_Op (N);
252 when N_Incomplete_Type_Declaration =>
253 Analyze_Incomplete_Type_Decl (N);
255 when N_Indexed_Component =>
256 Analyze_Indexed_Component_Form (N);
258 when N_Integer_Literal =>
259 Analyze_Integer_Literal (N);
261 when N_Itype_Reference =>
262 Analyze_Itype_Reference (N);
267 when N_Loop_Statement =>
268 Analyze_Loop_Statement (N);
271 Analyze_Membership_Op (N);
276 when N_Null_Statement =>
277 Analyze_Null_Statement (N);
279 when N_Number_Declaration =>
280 Analyze_Number_Declaration (N);
282 when N_Object_Declaration =>
283 Analyze_Object_Declaration (N);
285 when N_Object_Renaming_Declaration =>
286 Analyze_Object_Renaming (N);
288 when N_Operator_Symbol =>
289 Analyze_Operator_Symbol (N);
292 Analyze_Unary_Op (N);
295 Analyze_Arithmetic_Op (N);
298 Analyze_Logical_Op (N);
301 Analyze_Concatenation (N);
304 Analyze_Arithmetic_Op (N);
307 Analyze_Equality_Op (N);
310 Analyze_Arithmetic_Op (N);
313 Analyze_Comparison_Op (N);
316 Analyze_Comparison_Op (N);
319 Analyze_Comparison_Op (N);
322 Analyze_Comparison_Op (N);
325 Analyze_Unary_Op (N);
328 Analyze_Arithmetic_Op (N);
330 when N_Op_Multiply =>
331 Analyze_Arithmetic_Op (N);
334 Analyze_Equality_Op (N);
337 Analyze_Negation (N);
340 Analyze_Logical_Op (N);
343 Analyze_Unary_Op (N);
346 Analyze_Arithmetic_Op (N);
348 when N_Op_Rotate_Left =>
349 Analyze_Arithmetic_Op (N);
351 when N_Op_Rotate_Right =>
352 Analyze_Arithmetic_Op (N);
354 when N_Op_Shift_Left =>
355 Analyze_Arithmetic_Op (N);
357 when N_Op_Shift_Right =>
358 Analyze_Arithmetic_Op (N);
360 when N_Op_Shift_Right_Arithmetic =>
361 Analyze_Arithmetic_Op (N);
363 when N_Op_Subtract =>
364 Analyze_Arithmetic_Op (N);
367 Analyze_Logical_Op (N);
370 Analyze_Short_Circuit (N);
372 when N_Others_Choice =>
373 Analyze_Others_Choice (N);
375 when N_Package_Body =>
376 Analyze_Package_Body (N);
378 when N_Package_Body_Stub =>
379 Analyze_Package_Body_Stub (N);
381 when N_Package_Declaration =>
382 Analyze_Package_Declaration (N);
384 when N_Package_Instantiation =>
385 Analyze_Package_Instantiation (N);
387 when N_Package_Renaming_Declaration =>
388 Analyze_Package_Renaming (N);
390 when N_Package_Specification =>
391 Analyze_Package_Specification (N);
393 when N_Parameter_Association =>
394 Analyze_Parameter_Association (N);
399 when N_Private_Extension_Declaration =>
400 Analyze_Private_Extension_Declaration (N);
402 when N_Private_Type_Declaration =>
403 Analyze_Private_Type_Declaration (N);
405 when N_Procedure_Call_Statement =>
406 Analyze_Procedure_Call (N);
408 when N_Procedure_Instantiation =>
409 Analyze_Procedure_Instantiation (N);
411 when N_Protected_Body =>
412 Analyze_Protected_Body (N);
414 when N_Protected_Body_Stub =>
415 Analyze_Protected_Body_Stub (N);
417 when N_Protected_Definition =>
418 Analyze_Protected_Definition (N);
420 when N_Protected_Type_Declaration =>
421 Analyze_Protected_Type (N);
423 when N_Qualified_Expression =>
424 Analyze_Qualified_Expression (N);
426 when N_Raise_Statement =>
427 Analyze_Raise_Statement (N);
429 when N_Raise_xxx_Error =>
430 Analyze_Raise_xxx_Error (N);
435 when N_Range_Constraint =>
436 Analyze_Range (Range_Expression (N));
438 when N_Real_Literal =>
439 Analyze_Real_Literal (N);
441 when N_Record_Representation_Clause =>
442 Analyze_Record_Representation_Clause (N);
445 Analyze_Reference (N);
447 when N_Requeue_Statement =>
450 when N_Return_Statement =>
451 Analyze_Return_Statement (N);
453 when N_Selected_Component =>
454 Find_Selected_Component (N);
455 -- ??? why not Analyze_Selected_Component, needs comments
457 when N_Selective_Accept =>
458 Analyze_Selective_Accept (N);
460 when N_Single_Protected_Declaration =>
461 Analyze_Single_Protected (N);
463 when N_Single_Task_Declaration =>
464 Analyze_Single_Task (N);
469 when N_String_Literal =>
470 Analyze_String_Literal (N);
472 when N_Subprogram_Body =>
473 Analyze_Subprogram_Body (N);
475 when N_Subprogram_Body_Stub =>
476 Analyze_Subprogram_Body_Stub (N);
478 when N_Subprogram_Declaration =>
479 Analyze_Subprogram_Declaration (N);
481 when N_Subprogram_Info =>
482 Analyze_Subprogram_Info (N);
484 when N_Subprogram_Renaming_Declaration =>
485 Analyze_Subprogram_Renaming (N);
487 when N_Subtype_Declaration =>
488 Analyze_Subtype_Declaration (N);
490 when N_Subtype_Indication =>
491 Analyze_Subtype_Indication (N);
497 Analyze_Task_Body (N);
499 when N_Task_Body_Stub =>
500 Analyze_Task_Body_Stub (N);
502 when N_Task_Definition =>
503 Analyze_Task_Definition (N);
505 when N_Task_Type_Declaration =>
506 Analyze_Task_Type (N);
508 when N_Terminate_Alternative =>
509 Analyze_Terminate_Alternative (N);
511 when N_Timed_Entry_Call =>
512 Analyze_Timed_Entry_Call (N);
514 when N_Triggering_Alternative =>
515 Analyze_Triggering_Alternative (N);
517 when N_Type_Conversion =>
518 Analyze_Type_Conversion (N);
520 when N_Unchecked_Expression =>
521 Analyze_Unchecked_Expression (N);
523 when N_Unchecked_Type_Conversion =>
524 Analyze_Unchecked_Type_Conversion (N);
526 when N_Use_Package_Clause =>
527 Analyze_Use_Package (N);
529 when N_Use_Type_Clause =>
530 Analyze_Use_Type (N);
532 when N_Validate_Unchecked_Conversion =>
535 when N_Variant_Part =>
536 Analyze_Variant_Part (N);
538 when N_With_Clause =>
539 Analyze_With_Clause (N);
541 when N_With_Type_Clause =>
542 Analyze_With_Type_Clause (N);
544 -- A call to analyze the Empty node is an error, but most likely
545 -- it is an error caused by an attempt to analyze a malformed
546 -- piece of tree caused by some other error, so if there have
547 -- been any other errors, we just ignore it, otherwise it is
548 -- a real internal error which we complain about.
551 pragma Assert (Serious_Errors_Detected /= 0);
554 -- A call to analyze the error node is simply ignored, to avoid
555 -- causing cascaded errors (happens of course only in error cases)
560 -- For the remaining node types, we generate compiler abort, because
561 -- these nodes are always analyzed within the Sem_Chn routines and
562 -- there should never be a case of making a call to the main Analyze
563 -- routine for these node kinds. For example, an N_Access_Definition
564 -- node appears only in the context of a type declaration, and is
565 -- processed by the analyze routine for type declarations.
569 N_Access_Definition |
570 N_Access_Function_Definition |
571 N_Access_Procedure_Definition |
572 N_Access_To_Object_Definition |
573 N_Case_Statement_Alternative |
574 N_Compilation_Unit_Aux |
575 N_Component_Association |
577 N_Component_Definition |
579 N_Constrained_Array_Definition |
580 N_Decimal_Fixed_Point_Definition |
581 N_Defining_Character_Literal |
582 N_Defining_Identifier |
583 N_Defining_Operator_Symbol |
584 N_Defining_Program_Unit_Name |
586 N_Derived_Type_Definition |
588 N_Digits_Constraint |
589 N_Discriminant_Association |
590 N_Discriminant_Specification |
592 N_Entry_Call_Statement |
593 N_Enumeration_Type_Definition |
594 N_Exception_Handler |
595 N_Floating_Point_Definition |
596 N_Formal_Decimal_Fixed_Point_Definition |
597 N_Formal_Derived_Type_Definition |
598 N_Formal_Discrete_Type_Definition |
599 N_Formal_Floating_Point_Definition |
600 N_Formal_Modular_Type_Definition |
601 N_Formal_Ordinary_Fixed_Point_Definition |
602 N_Formal_Private_Type_Definition |
603 N_Formal_Signed_Integer_Type_Definition |
604 N_Function_Specification |
605 N_Generic_Association |
606 N_Index_Or_Discriminant_Constraint |
608 N_Loop_Parameter_Specification |
610 N_Modular_Type_Definition |
611 N_Ordinary_Fixed_Point_Definition |
612 N_Parameter_Specification |
613 N_Pragma_Argument_Association |
614 N_Procedure_Specification |
615 N_Real_Range_Specification |
616 N_Record_Definition |
617 N_Signed_Integer_Type_Definition |
618 N_Unconstrained_Array_Definition |
626 Debug_A_Exit ("analyzing ", N, " (done)");
628 -- Now that we have analyzed the node, we call the expander to
629 -- perform possible expansion. This is done only for nodes that
630 -- are not subexpressions, because in the case of subexpressions,
631 -- we don't have the type yet, and the expander will need to know
632 -- the type before it can do its job. For subexpression nodes, the
633 -- call to the expander happens in the Sem_Res.Resolve.
635 -- The Analyzed flag is also set at this point for non-subexpression
636 -- nodes (in the case of subexpression nodes, we can't set the flag
637 -- yet, since resolution and expansion have not yet been completed)
639 if Nkind (N) not in N_Subexpr then
644 -- Version with check(s) suppressed
646 procedure Analyze (N : Node_Id; Suppress : Check_Id) is
648 if Suppress = All_Checks then
650 Svg : constant Suppress_Array := Scope_Suppress;
653 Scope_Suppress := (others => True);
655 Scope_Suppress := Svg;
660 Svg : constant Boolean := Scope_Suppress (Suppress);
663 Scope_Suppress (Suppress) := True;
665 Scope_Suppress (Suppress) := Svg;
674 procedure Analyze_List (L : List_Id) is
679 while Present (Node) loop
685 -- Version with check(s) suppressed
687 procedure Analyze_List (L : List_Id; Suppress : Check_Id) is
689 if Suppress = All_Checks then
691 Svg : constant Suppress_Array := Scope_Suppress;
694 Scope_Suppress := (others => True);
696 Scope_Suppress := Svg;
701 Svg : constant Boolean := Scope_Suppress (Suppress);
704 Scope_Suppress (Suppress) := True;
706 Scope_Suppress (Suppress) := Svg;
711 --------------------------
712 -- Copy_Suppress_Status --
713 --------------------------
715 procedure Copy_Suppress_Status
721 if not Checks_May_Be_Suppressed (From) then
725 -- First search the local entity suppress table, we search this in
726 -- reverse order so that we get the innermost entry that applies to
727 -- this case if there are nested entries. Note that for the purpose
728 -- of this procedure we are ONLY looking for entries corresponding
729 -- to a two-argument Suppress, where the second argument matches From.
732 reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last
735 R : Entity_Check_Suppress_Record
736 renames Local_Entity_Suppress.Table (J);
740 and then (R.Check = All_Checks or else R.Check = C)
743 Set_Checks_May_Be_Suppressed (To, True);
744 Local_Entity_Suppress.Append
754 -- Now search the global entity suppress table for a matching entry
755 -- We also search this in reverse order so that if there are multiple
756 -- pragmas for the same entity, the last one applies.
759 reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
762 R : Entity_Check_Suppress_Record
763 renames Global_Entity_Suppress.Table (J);
767 and then (R.Check = All_Checks or else R.Check = C)
770 Set_Checks_May_Be_Suppressed (To, True);
771 Local_Entity_Suppress.Append
779 end Copy_Suppress_Status;
781 -------------------------
782 -- Enter_Generic_Scope --
783 -------------------------
785 procedure Enter_Generic_Scope (S : Entity_Id) is
787 if No (Outer_Generic_Scope) then
788 Outer_Generic_Scope := S;
790 end Enter_Generic_Scope;
792 ------------------------
793 -- Exit_Generic_Scope --
794 ------------------------
796 procedure Exit_Generic_Scope (S : Entity_Id) is
798 if S = Outer_Generic_Scope then
799 Outer_Generic_Scope := Empty;
801 end Exit_Generic_Scope;
803 -----------------------
804 -- Explicit_Suppress --
805 -----------------------
807 function Explicit_Suppress (E : Entity_Id; C : Check_Id) return Boolean is
809 if not Checks_May_Be_Suppressed (E) then
814 reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
817 R : Entity_Check_Suppress_Record
818 renames Global_Entity_Suppress.Table (J);
822 and then (R.Check = All_Checks or else R.Check = C)
831 end Explicit_Suppress;
833 -----------------------------
834 -- External_Ref_In_Generic --
835 -----------------------------
837 function External_Ref_In_Generic (E : Entity_Id) return Boolean is
841 -- Entity is global if defined outside of current outer_generic_scope:
842 -- Either the entity has a smaller depth that the outer generic, or it
843 -- is in a different compilation unit, or it is defined within a unit
844 -- in the same compilation, that is not within the outer_generic.
846 if No (Outer_Generic_Scope) then
849 elsif Scope_Depth (Scope (E)) < Scope_Depth (Outer_Generic_Scope)
850 or else not In_Same_Source_Unit (E, Outer_Generic_Scope)
857 while Present (Scop) loop
858 if Scop = Outer_Generic_Scope then
860 elsif Scope_Depth (Scop) < Scope_Depth (Outer_Generic_Scope) then
863 Scop := Scope (Scop);
869 end External_Ref_In_Generic;
875 procedure Initialize is
877 Local_Entity_Suppress.Init;
878 Global_Entity_Suppress.Init;
880 Unloaded_Subunits := False;
883 ------------------------------
884 -- Insert_After_And_Analyze --
885 ------------------------------
887 procedure Insert_After_And_Analyze (N : Node_Id; M : Node_Id) is
893 -- If we are not at the end of the list, then the easiest
894 -- coding is simply to insert before our successor
896 if Present (Next (N)) then
897 Insert_Before_And_Analyze (Next (N), M);
899 -- Case of inserting at the end of the list
902 -- Capture the Node_Id of the node to be inserted. This Node_Id
903 -- will still be the same after the insert operation.
908 -- Now just analyze from the inserted node to the end of
909 -- the new list (note that this properly handles the case
910 -- where any of the analyze calls result in the insertion of
911 -- nodes after the analyzed node, expecting analysis).
913 while Present (Node) loop
915 Mark_Rewrite_Insertion (Node);
920 end Insert_After_And_Analyze;
922 -- Version with check(s) suppressed
924 procedure Insert_After_And_Analyze
930 if Suppress = All_Checks then
932 Svg : constant Suppress_Array := Scope_Suppress;
935 Scope_Suppress := (others => True);
936 Insert_After_And_Analyze (N, M);
937 Scope_Suppress := Svg;
942 Svg : constant Boolean := Scope_Suppress (Suppress);
945 Scope_Suppress (Suppress) := True;
946 Insert_After_And_Analyze (N, M);
947 Scope_Suppress (Suppress) := Svg;
950 end Insert_After_And_Analyze;
952 -------------------------------
953 -- Insert_Before_And_Analyze --
954 -------------------------------
956 procedure Insert_Before_And_Analyze (N : Node_Id; M : Node_Id) is
962 -- Capture the Node_Id of the first list node to be inserted.
963 -- This will still be the first node after the insert operation,
964 -- since Insert_List_After does not modify the Node_Id values.
967 Insert_Before (N, M);
969 -- The insertion does not change the Id's of any of the nodes in
970 -- the list, and they are still linked, so we can simply loop from
971 -- the original first node until we meet the node before which the
972 -- insertion is occurring. Note that this properly handles the case
973 -- where any of the analyzed nodes insert nodes after themselves,
974 -- expecting them to get analyzed.
978 Mark_Rewrite_Insertion (Node);
982 end Insert_Before_And_Analyze;
984 -- Version with check(s) suppressed
986 procedure Insert_Before_And_Analyze
992 if Suppress = All_Checks then
994 Svg : constant Suppress_Array := Scope_Suppress;
997 Scope_Suppress := (others => True);
998 Insert_Before_And_Analyze (N, M);
999 Scope_Suppress := Svg;
1004 Svg : constant Boolean := Scope_Suppress (Suppress);
1007 Scope_Suppress (Suppress) := True;
1008 Insert_Before_And_Analyze (N, M);
1009 Scope_Suppress (Suppress) := Svg;
1012 end Insert_Before_And_Analyze;
1014 -----------------------------------
1015 -- Insert_List_After_And_Analyze --
1016 -----------------------------------
1018 procedure Insert_List_After_And_Analyze (N : Node_Id; L : List_Id) is
1019 After : constant Node_Id := Next (N);
1023 if Is_Non_Empty_List (L) then
1025 -- Capture the Node_Id of the first list node to be inserted.
1026 -- This will still be the first node after the insert operation,
1027 -- since Insert_List_After does not modify the Node_Id values.
1030 Insert_List_After (N, L);
1032 -- Now just analyze from the original first node until we get to
1033 -- the successor of the original insertion point (which may be
1034 -- Empty if the insertion point was at the end of the list). Note
1035 -- that this properly handles the case where any of the analyze
1036 -- calls result in the insertion of nodes after the analyzed
1037 -- node (possibly calling this routine recursively).
1039 while Node /= After loop
1041 Mark_Rewrite_Insertion (Node);
1045 end Insert_List_After_And_Analyze;
1047 -- Version with check(s) suppressed
1049 procedure Insert_List_After_And_Analyze
1050 (N : Node_Id; L : List_Id; Suppress : Check_Id)
1053 if Suppress = All_Checks then
1055 Svg : constant Suppress_Array := Scope_Suppress;
1058 Scope_Suppress := (others => True);
1059 Insert_List_After_And_Analyze (N, L);
1060 Scope_Suppress := Svg;
1065 Svg : constant Boolean := Scope_Suppress (Suppress);
1068 Scope_Suppress (Suppress) := True;
1069 Insert_List_After_And_Analyze (N, L);
1070 Scope_Suppress (Suppress) := Svg;
1073 end Insert_List_After_And_Analyze;
1075 ------------------------------------
1076 -- Insert_List_Before_And_Analyze --
1077 ------------------------------------
1079 procedure Insert_List_Before_And_Analyze (N : Node_Id; L : List_Id) is
1083 if Is_Non_Empty_List (L) then
1085 -- Capture the Node_Id of the first list node to be inserted.
1086 -- This will still be the first node after the insert operation,
1087 -- since Insert_List_After does not modify the Node_Id values.
1090 Insert_List_Before (N, L);
1092 -- The insertion does not change the Id's of any of the nodes in
1093 -- the list, and they are still linked, so we can simply loop from
1094 -- the original first node until we meet the node before which the
1095 -- insertion is occurring. Note that this properly handles the case
1096 -- where any of the analyzed nodes insert nodes after themselves,
1097 -- expecting them to get analyzed.
1099 while Node /= N loop
1101 Mark_Rewrite_Insertion (Node);
1105 end Insert_List_Before_And_Analyze;
1107 -- Version with check(s) suppressed
1109 procedure Insert_List_Before_And_Analyze
1110 (N : Node_Id; L : List_Id; Suppress : Check_Id)
1113 if Suppress = All_Checks then
1115 Svg : constant Suppress_Array := Scope_Suppress;
1118 Scope_Suppress := (others => True);
1119 Insert_List_Before_And_Analyze (N, L);
1120 Scope_Suppress := Svg;
1125 Svg : constant Boolean := Scope_Suppress (Suppress);
1128 Scope_Suppress (Suppress) := True;
1129 Insert_List_Before_And_Analyze (N, L);
1130 Scope_Suppress (Suppress) := Svg;
1133 end Insert_List_Before_And_Analyze;
1135 -------------------------
1136 -- Is_Check_Suppressed --
1137 -------------------------
1139 function Is_Check_Suppressed (E : Entity_Id; C : Check_Id) return Boolean is
1141 -- First search the local entity suppress table, we search this in
1142 -- reverse order so that we get the innermost entry that applies to
1143 -- this case if there are nested entries.
1146 reverse Local_Entity_Suppress.First .. Local_Entity_Suppress.Last
1149 R : Entity_Check_Suppress_Record
1150 renames Local_Entity_Suppress.Table (J);
1153 if (R.Entity = Empty or else R.Entity = E)
1154 and then (R.Check = All_Checks or else R.Check = C)
1161 -- Now search the global entity suppress table for a matching entry
1162 -- We also search this in reverse order so that if there are multiple
1163 -- pragmas for the same entity, the last one applies (not clear what
1164 -- or whether the RM specifies this handling, but it seems reasonable).
1167 reverse Global_Entity_Suppress.First .. Global_Entity_Suppress.Last
1170 R : Entity_Check_Suppress_Record
1171 renames Global_Entity_Suppress.Table (J);
1175 and then (R.Check = All_Checks or else R.Check = C)
1182 -- If we did not find a matching entry, then use the normal scope
1183 -- suppress value after all (actually this will be the global setting
1184 -- since it clearly was not overridden at any point)
1186 return Scope_Suppress (C);
1187 end Is_Check_Suppressed;
1195 Local_Entity_Suppress.Locked := True;
1196 Global_Entity_Suppress.Locked := True;
1197 Scope_Stack.Locked := True;
1198 Local_Entity_Suppress.Release;
1199 Global_Entity_Suppress.Release;
1200 Scope_Stack.Release;
1207 procedure Semantics (Comp_Unit : Node_Id) is
1209 -- The following locations save the corresponding global flags and
1210 -- variables so that they can be restored on completion. This is
1211 -- needed so that calls to Rtsfind start with the proper default
1212 -- values for these variables, and also that such calls do not
1213 -- disturb the settings for units being analyzed at a higher level.
1215 S_Full_Analysis : constant Boolean := Full_Analysis;
1216 S_In_Default_Expr : constant Boolean := In_Default_Expression;
1217 S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
1218 S_New_Nodes_OK : constant Int := New_Nodes_OK;
1219 S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
1220 S_Sem_Unit : constant Unit_Number_Type := Current_Sem_Unit;
1222 Generic_Main : constant Boolean :=
1223 Nkind (Unit (Cunit (Main_Unit)))
1224 in N_Generic_Declaration;
1226 -- If the main unit is generic, every compiled unit, including its
1227 -- context, is compiled with expansion disabled.
1229 Save_Config_Switches : Config_Switches_Type;
1230 -- Variable used to save values of config switches while we analyze
1231 -- the new unit, to be restored on exit for proper recursive behavior.
1233 procedure Do_Analyze;
1234 -- Procedure to analyze the compilation unit. This is called more
1235 -- than once when the high level optimizer is activated.
1241 procedure Do_Analyze is
1244 New_Scope (Standard_Standard);
1245 Scope_Suppress := Suppress_Options;
1247 (Scope_Stack.Last).Component_Alignment_Default := Calign_Default;
1249 (Scope_Stack.Last).Is_Active_Stack_Base := True;
1250 Outer_Generic_Scope := Empty;
1252 -- Now analyze the top level compilation unit node
1254 Analyze (Comp_Unit);
1256 -- Check for scope mismatch on exit from compilation
1258 pragma Assert (Current_Scope = Standard_Standard
1259 or else Comp_Unit = Cunit (Main_Unit));
1261 -- Then pop entry for Standard, and pop implicit types
1264 Restore_Scope_Stack;
1267 -- Start of processing for Semantics
1270 Compiler_State := Analyzing;
1271 Current_Sem_Unit := Get_Cunit_Unit_Number (Comp_Unit);
1273 if Generic_Main then
1274 Expander_Mode_Save_And_Set (False);
1276 Expander_Mode_Save_And_Set
1277 (Operating_Mode = Generate_Code or Debug_Flag_X);
1280 Full_Analysis := True;
1281 Inside_A_Generic := False;
1282 In_Default_Expression := False;
1284 Set_Comes_From_Source_Default (False);
1285 Save_Opt_Config_Switches (Save_Config_Switches);
1286 Set_Opt_Config_Switches
1287 (Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)));
1289 -- Only do analysis of unit that has not already been analyzed
1291 if not Analyzed (Comp_Unit) then
1292 Initialize_Version (Current_Sem_Unit);
1294 Expander_Mode_Save_And_Set (False);
1297 Reset_Analyzed_Flags (Comp_Unit);
1298 Expander_Mode_Restore;
1299 High_Level_Optimize (Comp_Unit);
1306 -- Save indication of dynamic elaboration checks for ALI file
1308 Set_Dynamic_Elab (Current_Sem_Unit, Dynamic_Elaboration_Checks);
1310 -- Restore settings of saved switches to entry values
1312 Current_Sem_Unit := S_Sem_Unit;
1313 Full_Analysis := S_Full_Analysis;
1314 In_Default_Expression := S_In_Default_Expr;
1315 Inside_A_Generic := S_Inside_A_Generic;
1316 New_Nodes_OK := S_New_Nodes_OK;
1317 Outer_Generic_Scope := S_Outer_Gen_Scope;
1319 Restore_Opt_Config_Switches (Save_Config_Switches);
1320 Expander_Mode_Restore;