OSDN Git Service

2009-04-20 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Apr 2009 08:18:43 +0000 (08:18 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Apr 2009 08:18:43 +0000 (08:18 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146368 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/ada/lib-load.adb
gcc/ada/namet-sp.adb
gcc/ada/namet-sp.ads
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch4.adb

index 7075b6f..1ef52e0 100644 (file)
@@ -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
index bae10b7..17332f2 100644 (file)
@@ -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 --
    -------------------------------------------
index 857b609..508b2e8 100644 (file)
@@ -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);
 
index e2deda9..30f85f5 100755 (executable)
@@ -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;
index d1de142..15d41a0 100755 (executable)
@@ -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;
index 0497529..e80c662 100644 (file)
@@ -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 --
index e182905..e572f56 100644 (file)
@@ -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