with Debug; use Debug;
with Debug_A; use Debug_A;
with Elists; use Elists;
-with Errout; use Errout;
with Expander; use Expander;
with Fname; use Fname;
-with HLO; use HLO;
with Lib; use Lib;
with Lib.Load; use Lib.Load;
with Nlists; use Nlists;
+with Opt; use Opt;
with Output; use Output;
with Restrict; use Restrict;
with Sem_Attr; use Sem_Attr;
-- of this unit, since they count as dependences on their parent library
-- item. CU must be an N_Compilation_Unit whose Unit is not an N_Subunit.
- procedure Write_Unit_Info
- (Unit_Num : Unit_Number_Type;
- Item : Node_Id;
- Prefix : String := "";
- Withs : Boolean := False);
- -- Print out debugging information about the unit. Prefix precedes the rest
- -- of the printout. If Withs is True, we print out units with'ed by this
- -- unit (not counting limited withs).
-
-------------
-- Analyze --
-------------
when N_Component_Declaration =>
Analyze_Component_Declaration (N);
- when N_Conditional_Expression =>
- Analyze_Conditional_Expression (N);
-
when N_Conditional_Entry_Call =>
Analyze_Conditional_Entry_Call (N);
when N_Identifier =>
Analyze_Identifier (N);
+ when N_If_Expression =>
+ Analyze_If_Expression (N);
+
when N_If_Statement =>
Analyze_If_Statement (N);
when N_Label =>
Analyze_Label (N);
+ when N_Loop_Parameter_Specification =>
+ Analyze_Loop_Parameter_Specification (N);
+
when N_Loop_Statement =>
Analyze_Loop_Statement (N);
N_Generic_Association |
N_Index_Or_Discriminant_Constraint |
N_Iteration_Scheme |
- N_Loop_Parameter_Specification |
N_Mod_Clause |
N_Modular_Type_Definition |
N_Ordinary_Fixed_Point_Definition |
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Analyze (N);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
- else
+ elsif Suppress = Overflow_Check then
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze (N);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Analyze_List (L);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Analyze_List (L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Analyze_List;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Insert_After_And_Analyze (N, M);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_After_And_Analyze (N, M);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_After_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Insert_Before_And_Analyze (N, M);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_Before_And_Analyze (N, M);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_Before_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Insert_List_After_And_Analyze (N, L);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_List_After_And_Analyze (N, L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_List_After_And_Analyze;
begin
if Suppress = All_Checks then
declare
- Svg : constant Suppress_Array := Scope_Suppress;
+ Svs : constant Suppress_Array := Scope_Suppress.Suppress;
begin
- Scope_Suppress := (others => True);
+ Scope_Suppress.Suppress := (others => True);
Insert_List_Before_And_Analyze (N, L);
- Scope_Suppress := Svg;
+ Scope_Suppress.Suppress := Svs;
end;
else
declare
- Svg : constant Boolean := Scope_Suppress (Suppress);
+ Svg : constant Boolean := Scope_Suppress.Suppress (Suppress);
begin
- Scope_Suppress (Suppress) := True;
+ Scope_Suppress.Suppress (Suppress) := True;
Insert_List_Before_And_Analyze (N, L);
- Scope_Suppress (Suppress) := Svg;
+ Scope_Suppress.Suppress (Suppress) := Svg;
end;
end if;
end Insert_List_Before_And_Analyze;
- -------------------------
- -- Is_Check_Suppressed --
- -------------------------
-
- function Is_Check_Suppressed (E : Entity_Id; C : Check_Id) return Boolean is
-
- Ptr : Suppress_Stack_Entry_Ptr;
-
- begin
- -- First search the local entity suppress stack. We search this from the
- -- top of the stack down so that we get the innermost entry that applies
- -- to this case if there are nested entries.
-
- Ptr := Local_Suppress_Stack_Top;
- while Ptr /= null loop
- if (Ptr.Entity = Empty or else Ptr.Entity = E)
- and then (Ptr.Check = All_Checks or else Ptr.Check = C)
- then
- return Ptr.Suppress;
- end if;
-
- Ptr := Ptr.Prev;
- end loop;
-
- -- Now search the global entity suppress table for a matching entry.
- -- We also search this from the top down so that if there are multiple
- -- pragmas for the same entity, the last one applies (not clear what
- -- or whether the RM specifies this handling, but it seems reasonable).
-
- Ptr := Global_Suppress_Stack_Top;
- while Ptr /= null loop
- if (Ptr.Entity = Empty or else Ptr.Entity = E)
- and then (Ptr.Check = All_Checks or else Ptr.Check = C)
- then
- return Ptr.Suppress;
- end if;
-
- Ptr := Ptr.Prev;
- end loop;
-
- -- If we did not find a matching entry, then use the normal scope
- -- suppress value after all (actually this will be the global setting
- -- since it clearly was not overridden at any point). For a predefined
- -- check, we test the specific flag. For a user defined check, we check
- -- the All_Checks flag.
-
- if C in Predefined_Check_Id then
- return Scope_Suppress (C);
- else
- return Scope_Suppress (All_Checks);
- end if;
- end Is_Check_Suppressed;
-
----------
-- Lock --
----------
Scope_Stack.Release;
end Lock;
+ ----------------
+ -- Preanalyze --
+ ----------------
+
+ procedure Preanalyze (N : Node_Id) is
+ Save_Full_Analysis : constant Boolean := Full_Analysis;
+
+ begin
+ Full_Analysis := False;
+ Expander_Mode_Save_And_Set (False);
+
+ Analyze (N);
+
+ Expander_Mode_Restore;
+ Full_Analysis := Save_Full_Analysis;
+ end Preanalyze;
+
--------------------------------------
-- Push_Global_Suppress_Stack_Entry --
--------------------------------------
-- these variables, and also that such calls do not disturb the settings
-- for units being analyzed at a higher level.
- S_Current_Sem_Unit : constant Unit_Number_Type := Current_Sem_Unit;
- S_Full_Analysis : constant Boolean := Full_Analysis;
- S_GNAT_Mode : constant Boolean := GNAT_Mode;
- S_Global_Dis_Names : constant Boolean := Global_Discard_Names;
- S_In_Spec_Expr : constant Boolean := In_Spec_Expression;
- S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
- S_New_Nodes_OK : constant Int := New_Nodes_OK;
- S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
+ S_Current_Sem_Unit : constant Unit_Number_Type := Current_Sem_Unit;
+ S_Full_Analysis : constant Boolean := Full_Analysis;
+ S_GNAT_Mode : constant Boolean := GNAT_Mode;
+ S_Global_Dis_Names : constant Boolean := Global_Discard_Names;
+ S_In_Assertion_Expr : constant Nat := In_Assertion_Expr;
+ S_In_Spec_Expr : constant Boolean := In_Spec_Expression;
+ S_Inside_A_Generic : constant Boolean := Inside_A_Generic;
+ S_Outer_Gen_Scope : constant Entity_Id := Outer_Generic_Scope;
Generic_Main : constant Boolean :=
Nkind (Unit (Cunit (Main_Unit)))
-- and we need to restore these saved values at the end.
procedure Do_Analyze;
- -- Procedure to analyze the compilation unit. This is called more than
- -- once when the high level optimizer is activated.
+ -- Procedure to analyze the compilation unit
----------------
-- Do_Analyze --
Full_Analysis := True;
Inside_A_Generic := False;
+ In_Assertion_Expr := 0;
In_Spec_Expression := False;
Set_Comes_From_Source_Default (False);
if not Analyzed (Comp_Unit) then
Initialize_Version (Current_Sem_Unit);
- if HLO_Active then
- Expander_Mode_Save_And_Set (False);
- New_Nodes_OK := 1;
- Do_Analyze;
- Reset_Analyzed_Flags (Comp_Unit);
- Expander_Mode_Restore;
- High_Level_Optimize (Comp_Unit);
- New_Nodes_OK := 0;
- end if;
-- Do analysis, and then append the compilation unit onto the
-- Comp_Unit_List, if appropriate. This is done after analysis,
Full_Analysis := S_Full_Analysis;
Global_Discard_Names := S_Global_Dis_Names;
GNAT_Mode := S_GNAT_Mode;
+ In_Assertion_Expr := S_In_Assertion_Expr;
In_Spec_Expression := S_In_Spec_Expr;
Inside_A_Generic := S_Inside_A_Generic;
- New_Nodes_OK := S_New_Nodes_OK;
Outer_Generic_Scope := S_Outer_Gen_Scope;
Restore_Opt_Config_Switches (Save_Config_Switches);
end loop;
end Walk_Withs_Immediate;
- ---------------------
- -- Write_Unit_Info --
- ---------------------
-
- procedure Write_Unit_Info
- (Unit_Num : Unit_Number_Type;
- Item : Node_Id;
- Prefix : String := "";
- Withs : Boolean := False)
- is
- begin
- Write_Str (Prefix);
- Write_Unit_Name (Unit_Name (Unit_Num));
- Write_Str (", unit ");
- Write_Int (Int (Unit_Num));
- Write_Str (", ");
- Write_Int (Int (Item));
- Write_Str ("=");
- Write_Str (Node_Kind'Image (Nkind (Item)));
-
- if Item /= Original_Node (Item) then
- Write_Str (", orig = ");
- Write_Int (Int (Original_Node (Item)));
- Write_Str ("=");
- Write_Str (Node_Kind'Image (Nkind (Original_Node (Item))));
- end if;
-
- Write_Eol;
-
- -- Skip the rest if we're not supposed to print the withs
-
- if not Withs then
- return;
- end if;
-
- declare
- Context_Item : Node_Id;
-
- begin
- Context_Item := First (Context_Items (Cunit (Unit_Num)));
- while Present (Context_Item)
- and then (Nkind (Context_Item) /= N_With_Clause
- or else Limited_Present (Context_Item))
- loop
- Context_Item := Next (Context_Item);
- end loop;
-
- if Present (Context_Item) then
- Indent;
- Write_Line ("withs:");
- Indent;
-
- while Present (Context_Item) loop
- if Nkind (Context_Item) = N_With_Clause
- and then not Limited_Present (Context_Item)
- then
- pragma Assert (Present (Library_Unit (Context_Item)));
- Write_Unit_Name
- (Unit_Name
- (Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
-
- if Implicit_With (Context_Item) then
- Write_Str (" -- implicit");
- end if;
-
- Write_Eol;
- end if;
-
- Context_Item := Next (Context_Item);
- end loop;
-
- Outdent;
- Write_Line ("end withs");
- Outdent;
- end if;
- end;
- end Write_Unit_Info;
-
end Sem;
projects / platform / upstream / gcc48.git / blobdiff