diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 129 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 12 | ||||
| -rwxr-xr-x | gcc/ada/namet-sp.adb | 17 | ||||
| -rwxr-xr-x | gcc/ada/namet-sp.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 8 |
7 files changed, 118 insertions, 75 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7075b6f5e54..1ef52e07f47 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +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> * gcc-interface/trans.c (call_to_gnu): When creating the copy for a diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index bae10b7e4b8..17332f26fbc 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -215,6 +215,10 @@ package body Exp_Ch6 is -- reference to the object itself, and the call becomes a call to the -- 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 -- ---------------------------------------------- @@ -2887,6 +2891,14 @@ package body Exp_Ch6 is if Ekind (Subp) = E_Function or else Ekind (Subp) = E_Procedure 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 Inlined_Subprogram : declare @@ -3216,10 +3228,6 @@ package body Exp_Ch6 is -- If the type returned by the function is unconstrained and the -- 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; -- Build declaration for exit label to be used in Return statements @@ -3246,50 +3254,6 @@ package body Exp_Ch6 is function Formal_Is_Used_Once (Formal : Entity_Id) return Boolean; -- 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 -- --------------------- @@ -3611,11 +3575,11 @@ package body Exp_Ch6 is -- Start of processing for Expand_Inlined_Call 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 - -- more efficient, but it also avoids problem with order of elaboration - -- when address clauses are inlined (address expression elaborated at - -- wrong point). + + -- For To_Address, just do an unchecked conversion . Not only is this + -- efficient, but it also avoids problem with order of elaboration + -- when address clauses are inlined (address expression elaborated + -- at the wrong point). if Subp = RTE (RE_To_Address) then Rewrite (N, @@ -3623,10 +3587,6 @@ package body Exp_Ch6 is (RTE (RE_Address), Relocate_Node (First_Actual (N)))); return; - - elsif Is_Null_Procedure then - Rewrite (N, Make_Null_Statement (Loc)); - return; end if; -- Check for an illegal attempt to inline a recursive procedure. If the @@ -4930,6 +4890,61 @@ package body Exp_Ch6 is end; 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 -- ------------------------------------------- diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 857b609b0bc..508b2e871ad 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -714,12 +714,12 @@ package body Lib.Load is -- it may very likely be the case that there is also pragma -- Restriction forbidding its usage. This is typically the -- case when building a configurable run time, where the - -- usage of certain run-time units is restricted by - -- means of both the corresponding pragma Restriction (such - -- as No_Calendar), and by not including the unit. Hence, - -- we check whether this predefined unit is forbidden, so - -- that the message about the restriction violation is - -- generated, if needed. + -- usage of certain run-time units is restricted by means + -- of both the corresponding pragma Restriction (such as + -- No_Calendar), and by not including the unit. Hence, we + -- check whether this predefined unit is forbidden, so that + -- the message about the restriction violation is generated, + -- if needed. Check_Restricted_Unit (Load_Name, Error_Node); diff --git a/gcc/ada/namet-sp.adb b/gcc/ada/namet-sp.adb index e2deda941fa..30f85f52c02 100755 --- a/gcc/ada/namet-sp.adb +++ b/gcc/ada/namet-sp.adb @@ -6,7 +6,7 @@ -- -- -- 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 -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -186,9 +186,18 @@ package body Namet.Sp is begin Get_Name_String_UTF_32 (Found, FB, FBL); Get_Name_String_UTF_32 (Expect, EB, EBL); - return - GNAT.UTF_32_Spelling_Checker.Is_Bad_Spelling_Of - (FB (1 .. FBL), EB (1 .. 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 + GNAT.UTF_32_Spelling_Checker.Is_Bad_Spelling_Of + (FB (1 .. FBL), EB (1 .. EBL)); + end if; end Is_Bad_Spelling_Of; end Namet.Sp; diff --git a/gcc/ada/namet-sp.ads b/gcc/ada/namet-sp.ads index d1de142eacd..15d41a07b05 100755 --- a/gcc/ada/namet-sp.ads +++ b/gcc/ada/namet-sp.ads @@ -40,6 +40,7 @@ package Namet.Sp is function Is_Bad_Spelling_Of (Found, Expect : Name_Id) return Boolean; -- Compares two identifier names from the names table, and returns True if -- 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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 049752941d6..e80c6626a3b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -993,9 +993,9 @@ package body Sem_Ch3 is is procedure Check_For_Premature_Usage (Def : Node_Id); - -- Check that type T_Name is not used, directly or recursively, - -- as a parameter or a return type in Def. Def is either a subtype, - -- an access_definition, or an access_to_subprogram_definition. + -- Check that type T_Name is not used, directly or recursively, as a + -- parameter or a return type in Def. Def is either a subtype, an + -- access_definition, or an access_to_subprogram_definition. ------------------------------- -- Check_For_Premature_Usage -- diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e1829054ade..e572f56905b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -127,10 +127,10 @@ package body Sem_Ch4 is procedure Check_Misspelled_Selector (Prefix : Entity_Id; Sel : Node_Id); - -- Give possible misspelling diagnostic if Sel is likely to be - -- a misspelling of one of the selectors of the Prefix. - -- This is called by Analyze_Selected_Component after producing - -- an invalid selector error message. + -- Give possible misspelling diagnostic if Sel is likely to be a mis- + -- spelling of one of the selectors of the Prefix. This is called by + -- Analyze_Selected_Component after producing an invalid selector error + -- message. 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 |