Skip to content

R
riscv-gcc-1
Commit 6f21ed26 by Robert Dewar Committed by Arnaud Charlet
Options

sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as IF and CASE. 

2004-10-04  Robert Dewar  <dewar@gnat.com>

	* sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as
	IF and CASE.
	(Analyze_Block_Statement): Add circuitry to detect following dead code
	(Check_Unreachable_Code): Handle case of block exit

From-SVN: r88503
parent 4cded177
Showing with 134 additions and 62 deletions
gcc/ada/ChangeLog
2004-10-04 Robert Dewar <dewar@gnat.com> 2004-10-04 Robert Dewar <dewar@gnat.com>
* sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as
IF and CASE.
(Analyze_Block_Statement): Add circuitry to detect following dead code
(Check_Unreachable_Code): Handle case of block exit
2004-10-04 Robert Dewar <dewar@gnat.com>
* g-spipat.adb: (XMatch): Avoid warning for Logic_Error call * g-spipat.adb: (XMatch): Avoid warning for Logic_Error call
(XMatchD): Avoid warning for Logic_Error call (XMatchD): Avoid warning for Logic_Error call
......
gcc/ada/sem_ch5.adb
...@@ -54,13 +54,16 @@ with Uintp; use Uintp; ...@@ -54,13 +54,16 @@ with Uintp; use Uintp;
package body Sem_Ch5 is package body Sem_Ch5 is
Unblocked_Exit_Count : Nat := 0; Unblocked_Exit_Count : Nat := 0;
-- This variable is used when processing if statements or case -- This variable is used when processing if statements, case statements,
-- statements, it counts the number of branches of the conditional -- and block statements. It counts the number of exit points that are
-- that are not blocked by unconditional transfer instructions. At -- not blocked by unconditional transfer instructions (for IF and CASE,
-- the end of processing, if the count is zero, it means that control -- these are the branches of the conditional, for a block, they are the
-- cannot fall through the conditional statement. This is used for -- statement sequence of the block, and the statement sequences of any
-- the generation of warning messages. This variable is recursively -- exception handlers that are part of the block. When processing is
-- saved on entry to processing an if or case, and restored on exit. -- complete, if this count is zero, it means that control cannot fall
-- through the IF, CASE or block statement. This is used for the
-- generation of warning messages. This variable is recursively saved
-- on entry to processing the construct, and restored on exit.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -514,70 +517,92 @@ package body Sem_Ch5 is ...@@ -514,70 +517,92 @@ package body Sem_Ch5 is
procedure Analyze_Block_Statement (N : Node_Id) is procedure Analyze_Block_Statement (N : Node_Id) is
Decls : constant List_Id := Declarations (N); Decls : constant List_Id := Declarations (N);
Id : constant Node_Id := Identifier (N); Id : constant Node_Id := Identifier (N);
Ent : Entity_Id := Empty; HSS : constant Node_Id := Handled_Statement_Sequence (N);
begin begin
-- If a label is present analyze it and mark it as referenced -- If no handled statement sequence is present, things are really
-- messed up, and we just return immediately (this is a defence
-- against previous errors).
if Present (Id) then if No (HSS) then
Analyze (Id); return;
Ent := Entity (Id); end if;
-- An error defense. If we have an identifier, but no entity, then -- Normal processing with HSS present
-- something is wrong. If we have previous errors, then just remove
-- the identifier and continue, otherwise raise an exception.
if No (Ent) then declare
if Total_Errors_Detected /= 0 then EH : constant List_Id := Exception_Handlers (HSS);
Set_Identifier (N, Empty); Ent : Entity_Id := Empty;
else S : Entity_Id;
raise Program_Error;
end if;
else Save_Unblocked_Exit_Count : constant Nat := Unblocked_Exit_Count;
Set_Ekind (Ent, E_Block); -- Recursively save value of this global, will be restored on exit
Generate_Reference (Ent, N, ' ');
Generate_Definition (Ent);
if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then begin
Set_Label_Construct (Parent (Ent), N); -- Initialize unblocked exit count for statements of begin block
end if; -- plus one for each excption handler that is present.
Unblocked_Exit_Count := 1;
if Present (EH) then
Unblocked_Exit_Count := Unblocked_Exit_Count + List_Length (EH);
end if; end if;
end if;
-- If no entity set, create a label entity -- If a label is present analyze it and mark it as referenced
if No (Ent) then if Present (Id) then
Ent := New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B'); Analyze (Id);
Set_Identifier (N, New_Occurrence_Of (Ent, Sloc (N))); Ent := Entity (Id);
Set_Parent (Ent, N);
end if;
Set_Etype (Ent, Standard_Void_Type); -- An error defense. If we have an identifier, but no entity,
Set_Block_Node (Ent, Identifier (N)); -- then something is wrong. If we have previous errors, then
New_Scope (Ent); -- just remove the identifier and continue, otherwise raise
-- an exception.
if Present (Decls) then if No (Ent) then
Analyze_Declarations (Decls); if Total_Errors_Detected /= 0 then
Check_Completion; Set_Identifier (N, Empty);
end if; else
raise Program_Error;
end if;
Analyze (Handled_Statement_Sequence (N)); else
Process_End_Label (Handled_Statement_Sequence (N), 'e', Ent); Set_Ekind (Ent, E_Block);
Generate_Reference (Ent, N, ' ');
Generate_Definition (Ent);
-- Analyze exception handlers if present. Note that the test for if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then
-- HSS being present is an error defence against previous errors. Set_Label_Construct (Parent (Ent), N);
end if;
end if;
end if;
if Present (Handled_Statement_Sequence (N)) -- If no entity set, create a label entity
and then Present (Exception_Handlers (Handled_Statement_Sequence (N)))
then
declare
S : Entity_Id := Scope (Ent);
begin if No (Ent) then
-- Indicate that enclosing scopes contain a block with handlers. Ent := New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
-- Only non-generic scopes need to be marked. Set_Identifier (N, New_Occurrence_Of (Ent, Sloc (N)));
Set_Parent (Ent, N);
end if;
Set_Etype (Ent, Standard_Void_Type);
Set_Block_Node (Ent, Identifier (N));
New_Scope (Ent);
if Present (Decls) then
Analyze_Declarations (Decls);
Check_Completion;
end if;
Analyze (HSS);
Process_End_Label (HSS, 'e', Ent);
-- If exception handlers are present, then we indicate that
-- enclosing scopes contain a block with handlers. We only
-- need to mark non-generic scopes.
if Present (EH) then
S := Scope (Ent);
loop loop
Set_Has_Nested_Block_With_Handler (S); Set_Has_Nested_Block_With_Handler (S);
exit when Is_Overloadable (S) exit when Is_Overloadable (S)
...@@ -585,11 +610,18 @@ package body Sem_Ch5 is ...@@ -585,11 +610,18 @@ package body Sem_Ch5 is
or else Is_Generic_Unit (S); or else Is_Generic_Unit (S);
S := Scope (S); S := Scope (S);
end loop; end loop;
end; end if;
end if;
Check_References (Ent); Check_References (Ent);
End_Scope; End_Scope;
if Unblocked_Exit_Count = 0 then
Unblocked_Exit_Count := Save_Unblocked_Exit_Count;
Check_Unreachable_Code (N);
else
Unblocked_Exit_Count := Save_Unblocked_Exit_Count;
end if;
end;
end Analyze_Block_Statement; end Analyze_Block_Statement;
---------------------------- ----------------------------
...@@ -1557,7 +1589,15 @@ package body Sem_Ch5 is ...@@ -1557,7 +1589,15 @@ package body Sem_Ch5 is
begin begin
Nxt := Original_Node (Next (N)); Nxt := Original_Node (Next (N));
if Present (Nxt) -- If a label follows us, then we never have dead code, since
-- someone could branch to the label, so we just ignore it.
if Nkind (Nxt) = N_Label then
return;
-- Otherwise see if we have a real statement following us
elsif Present (Nxt)
and then Comes_From_Source (Nxt) and then Comes_From_Source (Nxt)
and then Is_Statement (Nxt) and then Is_Statement (Nxt)
then then
...@@ -1613,28 +1653,53 @@ package body Sem_Ch5 is ...@@ -1613,28 +1653,53 @@ package body Sem_Ch5 is
-- If the unconditional transfer of control instruction is -- If the unconditional transfer of control instruction is
-- the last statement of a sequence, then see if our parent -- the last statement of a sequence, then see if our parent
-- is an IF statement, and if so adjust the unblocked exit -- is one of the constructs for which we count unblocked exits,
-- count of the if statement to reflect the fact that this -- and if so, adjust the count.
-- branch of the if is indeed blocked by a transfer of control.
else else
P := Parent (N); P := Parent (N);
-- Statements in THEN part or ELSE part of IF statement
if Nkind (P) = N_If_Statement then if Nkind (P) = N_If_Statement then
null; null;
-- Statements in ELSIF part of an IF statement
elsif Nkind (P) = N_Elsif_Part then elsif Nkind (P) = N_Elsif_Part then
P := Parent (P); P := Parent (P);
pragma Assert (Nkind (P) = N_If_Statement); pragma Assert (Nkind (P) = N_If_Statement);
-- Statements in CASE statement alternative
elsif Nkind (P) = N_Case_Statement_Alternative then elsif Nkind (P) = N_Case_Statement_Alternative then
P := Parent (P); P := Parent (P);
pragma Assert (Nkind (P) = N_Case_Statement); pragma Assert (Nkind (P) = N_Case_Statement);
-- Statements in body of block
elsif Nkind (P) = N_Handled_Sequence_Of_Statements
and then Nkind (Parent (P)) = N_Block_Statement
then
null;
-- Statements in exception handler in a block
elsif Nkind (P) = N_Exception_Handler
and then Nkind (Parent (P)) = N_Handled_Sequence_Of_Statements
and then Nkind (Parent (Parent (P))) = N_Block_Statement
then
null;
-- None of these cases, so return
else else
return; return;
end if; end if;
-- This was one of the cases we are looking for (i.e. the
-- parent construct was IF, CASE or block) so decrement count.
Unblocked_Exit_Count := Unblocked_Exit_Count - 1; Unblocked_Exit_Count := Unblocked_Exit_Count - 1;
end if; end if;
end; end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment