Patchwork [Ada] Implement pragma No_Inline (front-end part)

login
register
mail settings
Submitter Arnaud Charlet
Date Feb. 6, 2013, 11:23 a.m.
Message ID <20130206112353.GA20810@adacore.com>
Download mbox | patch
Permalink /patch/218560/
State New
Headers show

Comments

Arnaud Charlet - Feb. 6, 2013, 11:23 a.m.
This implements the front-end part of pragma No_Inline, which makes it possible
for the programmer to suppress inlining on a finer-grained basis than
-fno-inline.  This pragma is strictly equivalent to the "noinline" attribute
supported by the C family of compilers.

The interaction with the other 2 pragmas controlling inlining is as follows:
  - No_Inline and Inline_Always are mutually exclusive, i.e. specifying both
    for a subprogram is an error
  - No_Inline overrides Inline and a warning is issued by the front-end.

The corresponding gigi part will be committed later.

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-02-06  Eric Botcazou  <ebotcazou@adacore.com>

	* einfo.ads (Has_Pragma_No_Inline): New flag using Flag201.
	(Has_Pragma_No_Inline): Declare and mark as inline.
	(Set_Has_Pragma_No_Inline): Likewise.
	* einfo.adb (Has_Pragma_No_Inline): New function.
	(Set_Has_Pragma_No_Inline): New procedure.
	(Write_Entity_Flags): Handle Has_Pragma_No_Inline.
	* snames.ads-tmpl (Name_No_Inline): New pragma-related name.
	(Pragma_Id): Add Pragma_No_Inline value.
	* par-prag.adb (Prag): Handle Pragma_Inline.
	* sem_prag.adb (Inline_Status): New enumeration type.
	(Process_Inline): Change Active parameter
	to Inline_Status and add support for suppressed inlining.
	(Analyze_Pragma) <Pragma_Inline>: Adjust to above change.
	<Pragma_Inline_Always>: Likewise.
	 <Pragma_No_Inline>: Implement new pragma No_Inline.
	(Sig_Flags): Add Pragma_No_Inline.
	* gnat_rm.texi (Implementation Defined Pragmas): Add No_Inline.
	* gnat_ugn.texi (Switches for gcc): Mention Pragma No_Inline.

Patch

Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi	(revision 195800)
+++ gnat_rm.texi	(working copy)
@@ -182,6 +182,7 @@ 
 * Pragma Main::
 * Pragma Main_Storage::
 * Pragma No_Body::
+* Pragma No_Inline::
 * Pragma No_Return::
 * Pragma No_Strict_Aliasing ::
 * Pragma Normalize_Scalars::
@@ -934,6 +935,7 @@ 
 * Pragma Main::
 * Pragma Main_Storage::
 * Pragma No_Body::
+* Pragma No_Inline::
 * Pragma No_Return::
 * Pragma No_Strict_Aliasing::
 * Pragma Normalize_Scalars::
@@ -3373,8 +3375,8 @@ 
 
 @noindent
 Similar to pragma @code{Inline} except that inlining is not subject to
-the use of option @option{-gnatn} and the inlining happens regardless of
-whether this option is used.
+the use of option @option{-gnatn} or @option{-gnatN} and the inlining
+happens regardless of whether these options are used.
 
 @node Pragma Inline_Generic
 @unnumberedsec Pragma Inline_Generic
@@ -4020,6 +4022,24 @@ 
 dummy body with a No_Body pragma ensures that there is no interference from
 earlier versions of the package body.
 
+@node Pragma No_Inline
+@unnumberedsec Pragma No_Inline
+@findex No_Inline
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma No_Inline (NAME [, NAME]);
+@end smallexample
+
+@noindent
+This pragma suppresses inlining for the callable entity or the instances of
+the generic subprogram designated by @var{NAME}, including inlining that
+results from the use of pragma @code{Inline}.  This pragma is always active,
+in particular it is not subject to the use of option @option{-gnatn} or
+@option{-gnatN}.  It is illegal to specify both pragma @code{No_Inline} and
+pragma @code{Inline_Always} for the same @var{NAME}.
+
 @node Pragma No_Return
 @unnumberedsec Pragma No_Return
 @findex No_Return
Index: einfo.adb
===================================================================
--- einfo.adb	(revision 195784)
+++ einfo.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -483,6 +483,7 @@ 
    --    Is_Ada_2012_Only                Flag199
 
    --    Has_Delayed_Aspects             Flag200
+   --    Has_Pragma_No_Inline            Flag201
    --    Itype_Printed                   Flag202
    --    Has_Pragma_Pure                 Flag203
    --    Is_Known_Null                   Flag204
@@ -542,8 +543,6 @@ 
    --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
 
-   --    (unused)                        Flag201
-
    --    (unused)                        Flag255
    --    (unused)                        Flag256
    --    (unused)                        Flag257
@@ -1560,6 +1559,11 @@ 
       return Flag230 (Id);
    end Has_Pragma_Inline_Always;
 
+   function Has_Pragma_No_Inline (Id : E) return B is
+   begin
+      return Flag201 (Id);
+   end Has_Pragma_No_Inline;
+
    function Has_Pragma_Ordered (Id : E) return B is
    begin
       pragma Assert (Is_Enumeration_Type (Id));
@@ -4111,6 +4115,11 @@ 
       Set_Flag230 (Id, V);
    end Set_Has_Pragma_Inline_Always;
 
+   procedure Set_Has_Pragma_No_Inline (Id : E; V : B := True) is
+   begin
+      Set_Flag201 (Id, V);
+   end Set_Has_Pragma_No_Inline;
+
    procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
    begin
       pragma Assert (Is_Enumeration_Type (Id));
@@ -7686,6 +7695,7 @@ 
       W ("Has_Pragma_Elaborate_Body",       Flag150 (Id));
       W ("Has_Pragma_Inline",               Flag157 (Id));
       W ("Has_Pragma_Inline_Always",        Flag230 (Id));
+      W ("Has_Pragma_No_Inline",            Flag201 (Id));
       W ("Has_Pragma_Ordered",              Flag198 (Id));
       W ("Has_Pragma_Pack",                 Flag121 (Id));
       W ("Has_Pragma_Preelab_Init",         Flag221 (Id));
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 195791)
+++ einfo.ads	(working copy)
@@ -1671,6 +1671,11 @@ 
 --       pragma Inline_Always applies. Note that if this flag is set, the flag
 --       Has_Pragma_Inline is also set.
 
+--    Has_Pragma_No_Inline (Flag201)
+--       Defined in all entities. Set for functions and procedures for which a
+--       pragma No_Inline applies. Note that if this flag is set, the flag
+--       Has_Pragma_Inline_Always cannot be set.
+
 --    Has_Pragma_Ordered (Flag198) [implementation base type only]
 --       Defined in entities for enumeration types. If set indicates that a
 --       valid pragma Ordered was given for the type. This flag is inherited
@@ -4833,6 +4838,7 @@ 
    --    Has_Pragma_Elaborate_Body           (Flag150)
    --    Has_Pragma_Inline                   (Flag157)
    --    Has_Pragma_Inline_Always            (Flag230)
+   --    Has_Pragma_No_Inline                (Flag201)
    --    Has_Pragma_Pure                     (Flag203)
    --    Has_Pragma_Pure_Function            (Flag179)
    --    Has_Pragma_Thread_Local_Storage     (Flag169)
@@ -6232,6 +6238,7 @@ 
    function Has_Pragma_Elaborate_Body           (Id : E) return B;
    function Has_Pragma_Inline                   (Id : E) return B;
    function Has_Pragma_Inline_Always            (Id : E) return B;
+   function Has_Pragma_No_Inline                (Id : E) return B;
    function Has_Pragma_Ordered                  (Id : E) return B;
    function Has_Pragma_Pack                     (Id : E) return B;
    function Has_Pragma_Preelab_Init             (Id : E) return B;
@@ -6831,6 +6838,7 @@ 
    procedure Set_Has_Pragma_Elaborate_Body       (Id : E; V : B := True);
    procedure Set_Has_Pragma_Inline               (Id : E; V : B := True);
    procedure Set_Has_Pragma_Inline_Always        (Id : E; V : B := True);
+   procedure Set_Has_Pragma_No_Inline            (Id : E; V : B := True);
    procedure Set_Has_Pragma_Ordered              (Id : E; V : B := True);
    procedure Set_Has_Pragma_Pack                 (Id : E; V : B := True);
    procedure Set_Has_Pragma_Preelab_Init         (Id : E; V : B := True);
@@ -7521,6 +7529,7 @@ 
    pragma Inline (Has_Pragma_Elaborate_Body);
    pragma Inline (Has_Pragma_Inline);
    pragma Inline (Has_Pragma_Inline_Always);
+   pragma Inline (Has_Pragma_No_Inline);
    pragma Inline (Has_Pragma_Ordered);
    pragma Inline (Has_Pragma_Pack);
    pragma Inline (Has_Pragma_Preelab_Init);
@@ -7971,6 +7980,7 @@ 
    pragma Inline (Set_Has_Pragma_Elaborate_Body);
    pragma Inline (Set_Has_Pragma_Inline);
    pragma Inline (Set_Has_Pragma_Inline_Always);
+   pragma Inline (Set_Has_Pragma_No_Inline);
    pragma Inline (Set_Has_Pragma_Ordered);
    pragma Inline (Set_Has_Pragma_Pack);
    pragma Inline (Set_Has_Pragma_Preelab_Init);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 195800)
+++ sem_prag.adb	(working copy)
@@ -886,11 +886,16 @@ 
       --  to declare types that match predefined C types, especially for cases
       --  without corresponding Ada predefined type.
 
-      procedure Process_Inline (Active : Boolean);
-      --  Common processing for Inline and Inline_Always. The parameter
-      --  indicates if the inline pragma is active, i.e. if it should actually
-      --  cause inlining to occur.
+      type Inline_Status is (Suppressed, Disabled, Enabled);
+      --  Inline status of a subprogram, indicated as follows:
+      --    Suppressed: inlining is suppressed for the subprogram
+      --    Disabled:   no inlining is requested for the subprogram
+      --    Enabled:    inlining is requested/required for the subprogram
 
+      procedure Process_Inline (Status : Inline_Status);
+      --  Common processing for Inline, Inline_Always and No_Inline. Parameter
+      --  indicates the inline status specified by the pragma.
+
       procedure Process_Interface_Name
         (Subprogram_Def : Entity_Id;
          Ext_Arg        : Node_Id;
@@ -4912,7 +4917,7 @@ 
       -- Process_Inline --
       --------------------
 
-      procedure Process_Inline (Active : Boolean) is
+      procedure Process_Inline (Status : Inline_Status) is
          Assoc     : Node_Id;
          Decl      : Node_Id;
          Subp_Id   : Node_Id;
@@ -5017,7 +5022,9 @@ 
 
             --  If inlining is not possible, for now do not treat as an error
 
-            elsif Inlining_Not_Possible (Subp) then
+            elsif Status /= Suppressed
+              and then Inlining_Not_Possible (Subp)
+            then
                Applies := True;
                return;
 
@@ -5145,18 +5152,56 @@ 
 
          procedure Set_Inline_Flags (Subp : Entity_Id) is
          begin
-            if Active then
-               Set_Is_Inlined (Subp);
-            end if;
+            --  First set the Has_Pragma_XXX flags and issue the appropriate
+            --  errors and warnings for suspicious combinations.
 
-            if not Has_Pragma_Inline (Subp) then
-               Set_Has_Pragma_Inline (Subp);
-               Effective := True;
+            if Prag_Id = Pragma_No_Inline then
+               if Has_Pragma_Inline_Always (Subp) then
+                  Error_Msg_N
+                    ("Inline_Always and No_Inline are mutually exclusive", N);
+               elsif Has_Pragma_Inline (Subp) then
+                  Error_Msg_NE
+                    ("Inline and No_Inline both specified for& ??",
+                     N, Entity (Subp_Id));
+               end if;
+
+               Set_Has_Pragma_No_Inline (Subp);
+            else
+               if Prag_Id = Pragma_Inline_Always then
+                  if Has_Pragma_No_Inline (Subp) then
+                     Error_Msg_N
+                       ("Inline_Always and No_Inline are mutually exclusive",
+                        N);
+                  end if;
+
+                  Set_Has_Pragma_Inline_Always (Subp);
+               else
+                  if Has_Pragma_No_Inline (Subp) then
+                     Error_Msg_NE
+                       ("Inline and No_Inline both specified for& ??",
+                        N, Entity (Subp_Id));
+                  end if;
+               end if;
+
+               if not Has_Pragma_Inline (Subp) then
+                  Set_Has_Pragma_Inline (Subp);
+                  Effective := True;
+               end if;
             end if;
 
-            if Prag_Id = Pragma_Inline_Always then
-               Set_Has_Pragma_Inline_Always (Subp);
-            end if;
+            --  Then adjust the Is_Inlined flag. It can never be set if the
+            --  subprogram is subject to pragma No_Inline.
+
+            case Status is
+               when Suppressed =>
+                  Set_Is_Inlined (Subp, False);
+               when Disabled =>
+                  null;
+               when Enabled =>
+                  if not Has_Pragma_No_Inline (Subp) then
+                     Set_Is_Inlined (Subp, True);
+                  end if;
+            end case;
          end Set_Inline_Flags;
 
       --  Start of processing for Process_Inline
@@ -5165,7 +5210,7 @@ 
          Check_No_Identifiers;
          Check_At_Least_N_Arguments (1);
 
-         if Active then
+         if Status = Enabled then
             Inline_Processing_Required := True;
          end if;
 
@@ -5211,7 +5256,7 @@ 
 
             elsif not Effective
               and then Warn_On_Redundant_Constructs
-              and then not Suppress_All_Inlining
+              and then not (Status = Suppressed or Suppress_All_Inlining)
             then
                if Inlining_Not_Possible (Subp) then
                   Error_Msg_NE
@@ -11061,9 +11106,13 @@ 
 
          when Pragma_Inline =>
 
-            --  Pragma is active if inlining option is active
+            --  Inline status is Enabled if inlining option is active
 
-            Process_Inline (Inline_Active);
+            if Inline_Active then
+               Process_Inline (Enabled);
+            else
+               Process_Inline (Disabled);
+            end if;
 
          -------------------
          -- Inline_Always --
@@ -11078,7 +11127,7 @@ 
             --  this causes walk order issues.
 
             if not (CodePeer_Mode or Alfa_Mode) then
-               Process_Inline (True);
+               Process_Inline (Enabled);
             end if;
 
          --------------------
@@ -12614,6 +12663,16 @@ 
             Pragma_Misplaced;
 
          ---------------
+         -- No_Inline --
+         ---------------
+
+         --  pragma No_Inline ( NAME {, NAME} );
+
+         when Pragma_No_Inline =>
+            GNAT_Pragma;
+            Process_Inline (Suppressed);
+
+         ---------------
          -- No_Return --
          ---------------
 
@@ -16630,6 +16689,7 @@ 
       Pragma_Memory_Size                    => -1,
       Pragma_No_Return                      =>  0,
       Pragma_No_Body                        =>  0,
+      Pragma_No_Inline                      =>  0,
       Pragma_No_Run_Time                    => -1,
       Pragma_No_Strict_Aliasing             => -1,
       Pragma_Normalize_Scalars              => -1,
Index: gnat_ugn.texi
===================================================================
--- gnat_ugn.texi	(revision 195799)
+++ gnat_ugn.texi	(working copy)
@@ -4055,7 +4055,8 @@ 
 results from the use of the pragma @code{Inline_Always}.
 Any occurrences of pragma @code{Inline} or @code{Inline_Always}
 are ignored, and @option{-gnatn} and @option{-gnatN} have no
-effect if this switch is present.
+effects if this switch is present.  Note that inlining can also
+be suppressed on a finer-grained basis with pragma @code{No_Inline}.
 
 @item -fno-inline-functions
 @cindex @option{-fno-inline-functions} (@command{gcc})
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 195799)
+++ par-prag.adb	(working copy)
@@ -1210,6 +1210,7 @@ 
            Pragma_Main_Storage                   |
            Pragma_Memory_Size                    |
            Pragma_No_Body                        |
+           Pragma_No_Inline                      |
            Pragma_No_Return                      |
            Pragma_No_Run_Time                    |
            Pragma_No_Strict_Aliasing             |
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 195799)
+++ snames.ads-tmpl	(working copy)
@@ -549,6 +549,7 @@ 
    Name_Main_Storage                   : constant Name_Id := N + $; -- GNAT
    Name_Memory_Size                    : constant Name_Id := N + $; -- Ada 83
    Name_No_Body                        : constant Name_Id := N + $; -- GNAT
+   Name_No_Inline                      : constant Name_Id := N + $; -- GNAT
    Name_No_Return                      : constant Name_Id := N + $; -- Ada 05
    Name_Obsolescent                    : constant Name_Id := N + $; -- GNAT
    Name_Optimize                       : constant Name_Id := N + $;
@@ -1819,6 +1820,7 @@ 
       Pragma_Main_Storage,
       Pragma_Memory_Size,
       Pragma_No_Body,
+      Pragma_No_Inline,
       Pragma_No_Return,
       Pragma_Obsolescent,
       Pragma_Optimize,