Commit 8dbf3473 by Arnaud Charlet

[multiple changes]

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor reformatting

	* lib-load.adb: Minor reformatting

	* sem_ch4.adb: Minor reformatting

2009-04-20  Robert Dewar  <dewar@adacore.com>

	* namet-sp.ads, namet-sp.adb (Is_Bad_Spelling_Of): Implement new spec
	(equal values => False).

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Is_Null_Procedure): predicate is global, so that calls
	to null procedures can be inlined unconditionally.

From-SVN: r146368
parent 56fe7b05
2009-04-20 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb: Minor reformatting
* lib-load.adb: Minor reformatting
* sem_ch4.adb: Minor reformatting
2009-04-20 Robert Dewar <dewar@adacore.com>
* namet-sp.ads, namet-sp.adb (Is_Bad_Spelling_Of): Implement new spec
(equal values => False).
2009-04-20 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Is_Null_Procedure): predicate is global, so that calls
to null procedures can be inlined unconditionally.
2009-04-20 Eric Botcazou <ebotcazou@adacore.com> 2009-04-20 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (call_to_gnu): When creating the copy for a * gcc-interface/trans.c (call_to_gnu): When creating the copy for a
...@@ -215,6 +215,10 @@ package body Exp_Ch6 is ...@@ -215,6 +215,10 @@ package body Exp_Ch6 is
-- reference to the object itself, and the call becomes a call to the -- reference to the object itself, and the call becomes a call to the
-- corresponding protected subprogram. -- corresponding protected subprogram.
function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
-- Predicate to recognize stubbed procedures and null procedures, which
-- can be inlined unconditionally in all cases.
---------------------------------------------- ----------------------------------------------
-- Add_Access_Actual_To_Build_In_Place_Call -- -- Add_Access_Actual_To_Build_In_Place_Call --
---------------------------------------------- ----------------------------------------------
...@@ -2887,6 +2891,14 @@ package body Exp_Ch6 is ...@@ -2887,6 +2891,14 @@ package body Exp_Ch6 is
if Ekind (Subp) = E_Function if Ekind (Subp) = E_Function
or else Ekind (Subp) = E_Procedure or else Ekind (Subp) = E_Procedure
then then
-- A simple optimization: always replace calls to null procedures
-- with a null statement.
if Is_Null_Procedure (Subp) then
Rewrite (N, Make_Null_Statement (Loc));
return;
end if;
if Is_Inlined (Subp) then if Is_Inlined (Subp) then
Inlined_Subprogram : declare Inlined_Subprogram : declare
...@@ -3216,10 +3228,6 @@ package body Exp_Ch6 is ...@@ -3216,10 +3228,6 @@ package body Exp_Ch6 is
-- If the type returned by the function is unconstrained and the -- If the type returned by the function is unconstrained and the
-- call can be inlined, special processing is required. -- call can be inlined, special processing is required.
function Is_Null_Procedure return Boolean;
-- Predicate to recognize stubbed procedures and null procedures, for
-- which there is no need for the full inlining mechanism.
procedure Make_Exit_Label; procedure Make_Exit_Label;
-- Build declaration for exit label to be used in Return statements -- Build declaration for exit label to be used in Return statements
...@@ -3246,50 +3254,6 @@ package body Exp_Ch6 is ...@@ -3246,50 +3254,6 @@ package body Exp_Ch6 is
function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean; function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean;
-- Determine whether a formal parameter is used only once in Orig_Bod -- Determine whether a formal parameter is used only once in Orig_Bod
-----------------------
-- Is_Null_Procedure --
-----------------------
function Is_Null_Procedure return Boolean is
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
begin
if Ekind (Subp) /= E_Procedure then
return False;
elsif Nkind (Orig_Bod) /= N_Subprogram_Body then
return False;
-- Check if this is an Ada 2005 null procedure
elsif Nkind (Decl) = N_Subprogram_Declaration
and then Null_Present (Specification (Decl))
then
return True;
-- Check if the body contains only a null statement, followed by the
-- return statement added during expansion.
else
declare
Stat : constant Node_Id :=
First
(Statements (Handled_Statement_Sequence (Orig_Bod)));
Stat2 : constant Node_Id := Next (Stat);
begin
return
Nkind (Stat) = N_Null_Statement
and then
(No (Stat2)
or else
(Nkind (Stat2) = N_Simple_Return_Statement
and then No (Next (Stat2))));
end;
end if;
end Is_Null_Procedure;
--------------------- ---------------------
-- Make_Exit_Label -- -- Make_Exit_Label --
--------------------- ---------------------
...@@ -3611,11 +3575,11 @@ package body Exp_Ch6 is ...@@ -3611,11 +3575,11 @@ package body Exp_Ch6 is
-- Start of processing for Expand_Inlined_Call -- Start of processing for Expand_Inlined_Call
begin begin
-- Check for special case of To_Address call, and if so, just do an
-- unchecked conversion instead of expanding the call. Not only is this -- For To_Address, just do an unchecked conversion . Not only is this
-- more efficient, but it also avoids problem with order of elaboration -- efficient, but it also avoids problem with order of elaboration
-- when address clauses are inlined (address expression elaborated at -- when address clauses are inlined (address expression elaborated
-- wrong point). -- at the wrong point).
if Subp = RTE (RE_To_Address) then if Subp = RTE (RE_To_Address) then
Rewrite (N, Rewrite (N,
...@@ -3623,10 +3587,6 @@ package body Exp_Ch6 is ...@@ -3623,10 +3587,6 @@ package body Exp_Ch6 is
(RTE (RE_Address), (RTE (RE_Address),
Relocate_Node (First_Actual (N)))); Relocate_Node (First_Actual (N))));
return; return;
elsif Is_Null_Procedure then
Rewrite (N, Make_Null_Statement (Loc));
return;
end if; end if;
-- Check for an illegal attempt to inline a recursive procedure. If the -- Check for an illegal attempt to inline a recursive procedure. If the
...@@ -4930,6 +4890,61 @@ package body Exp_Ch6 is ...@@ -4930,6 +4890,61 @@ package body Exp_Ch6 is
end; end;
end Freeze_Subprogram; end Freeze_Subprogram;
-----------------------
-- Is_Null_Procedure --
-----------------------
function Is_Null_Procedure (Subp : Entity_Id) return Boolean is
Decl : constant Node_Id := Unit_Declaration_Node (Subp);
begin
if Ekind (Subp) /= E_Procedure then
return False;
-- Check if this is a declared null procedure
elsif Nkind (Decl) = N_Subprogram_Declaration then
if Null_Present (Specification (Decl)) then
return True;
elsif No (Body_To_Inline (Decl)) then
return False;
-- Check if the body contains only a null statement, followed by
-- the return statement added during expansion.
else
declare
Orig_Bod : constant Node_Id := Body_To_Inline (Decl);
Stat : Node_Id;
Stat2 : Node_Id;
begin
if Nkind (Orig_Bod) /= N_Subprogram_Body then
return False;
else
Stat :=
First
(Statements (Handled_Statement_Sequence (Orig_Bod)));
Stat2 := Next (Stat);
return
Nkind (Stat) = N_Null_Statement
and then
(No (Stat2)
or else
(Nkind (Stat2) = N_Simple_Return_Statement
and then No (Next (Stat2))));
end if;
end;
end if;
else
return False;
end if;
end Is_Null_Procedure;
------------------------------------------- -------------------------------------------
-- Make_Build_In_Place_Call_In_Allocator -- -- Make_Build_In_Place_Call_In_Allocator --
------------------------------------------- -------------------------------------------
......
...@@ -714,12 +714,12 @@ package body Lib.Load is ...@@ -714,12 +714,12 @@ package body Lib.Load is
-- it may very likely be the case that there is also pragma -- it may very likely be the case that there is also pragma
-- Restriction forbidding its usage. This is typically the -- Restriction forbidding its usage. This is typically the
-- case when building a configurable run time, where the -- case when building a configurable run time, where the
-- usage of certain run-time units is restricted by -- usage of certain run-time units is restricted by means
-- means of both the corresponding pragma Restriction (such -- of both the corresponding pragma Restriction (such as
-- as No_Calendar), and by not including the unit. Hence, -- No_Calendar), and by not including the unit. Hence, we
-- we check whether this predefined unit is forbidden, so -- check whether this predefined unit is forbidden, so that
-- that the message about the restriction violation is -- the message about the restriction violation is generated,
-- generated, if needed. -- if needed.
Check_Restricted_Unit (Load_Name, Error_Node); Check_Restricted_Unit (Load_Name, Error_Node);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, Free Software Foundation, Inc. -- -- Copyright (C) 2008-2009, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -186,9 +186,18 @@ package body Namet.Sp is ...@@ -186,9 +186,18 @@ package body Namet.Sp is
begin begin
Get_Name_String_UTF_32 (Found, FB, FBL); Get_Name_String_UTF_32 (Found, FB, FBL);
Get_Name_String_UTF_32 (Expect, EB, EBL); Get_Name_String_UTF_32 (Expect, EB, EBL);
-- For an exact match, return False, otherwise check bad spelling. We
-- need this special test because the library routine returns True for
-- an exact match.
if FB (1 .. FBL) = EB (1 .. EBL) then
return False;
else
return return
GNAT.UTF_32_Spelling_Checker.Is_Bad_Spelling_Of GNAT.UTF_32_Spelling_Checker.Is_Bad_Spelling_Of
(FB (1 .. FBL), EB (1 .. EBL)); (FB (1 .. FBL), EB (1 .. EBL));
end if;
end Is_Bad_Spelling_Of; end Is_Bad_Spelling_Of;
end Namet.Sp; end Namet.Sp;
...@@ -40,6 +40,7 @@ package Namet.Sp is ...@@ -40,6 +40,7 @@ package Namet.Sp is
function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean; function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean;
-- Compares two identifier names from the names table, and returns True if -- Compares two identifier names from the names table, and returns True if
-- Found is a plausible misspelling of Expect. This function properly deals -- Found is a plausible misspelling of Expect. This function properly deals
-- with wide and wide wide character encodings in the input names. -- with wide and wide wide character encodings in the input names. Note
-- that an exact match in the names results in False being returned.
end Namet.Sp; end Namet.Sp;
...@@ -993,9 +993,9 @@ package body Sem_Ch3 is ...@@ -993,9 +993,9 @@ package body Sem_Ch3 is
is is
procedure Check_For_Premature_Usage (Def : Node_Id); procedure Check_For_Premature_Usage (Def : Node_Id);
-- Check that type T_Name is not used, directly or recursively, -- Check that type T_Name is not used, directly or recursively, as a
-- as a parameter or a return type in Def. Def is either a subtype, -- parameter or a return type in Def. Def is either a subtype, an
-- an access_definition, or an access_to_subprogram_definition. -- access_definition, or an access_to_subprogram_definition.
------------------------------- -------------------------------
-- Check_For_Premature_Usage -- -- Check_For_Premature_Usage --
......
...@@ -127,10 +127,10 @@ package body Sem_Ch4 is ...@@ -127,10 +127,10 @@ package body Sem_Ch4 is
procedure Check_Misspelled_Selector procedure Check_Misspelled_Selector
(Prefix : Entity_Id; (Prefix : Entity_Id;
Sel : Node_Id); Sel : Node_Id);
-- Give possible misspelling diagnostic if Sel is likely to be -- Give possible misspelling diagnostic if Sel is likely to be a mis-
-- a misspelling of one of the selectors of the Prefix. -- spelling of one of the selectors of the Prefix. This is called by
-- This is called by Analyze_Selected_Component after producing -- Analyze_Selected_Component after producing an invalid selector error
-- an invalid selector error message. -- message.
function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean; function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean;
-- Verify that type T is declared in scope S. Used to find interpretations -- Verify that type T is declared in scope S. Used to find interpretations
......
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