exp_ch6.adb (Expand_Call): Add comment on handling of back end intrinsic

	* exp_ch6.adb (Expand_Call): Add comment on handling of back end
	intrinsic

	* exp_intr.adb (Expand_Intrinsic_Call): Ignore unrecognized intrinsic,
	leaving call unchanged.
	This deals with the case where the pragma Import specified
	an external name, to be handled by the back end.

	* sem_prag.adb (Process_Import_Or_Interface): Do not check validity of
	subprogram which is Imported with convention Intrinsic if an
	External_Name argument is specified.
	(Process_Import_Or_Interface): Properly diagnose link name argument.
	(Inlining_Not_Possible): New name for Cannot_Inline, to avoid confusion
	with Sem_Ch6.Cannot_Inline.
	(Process_Inline): Provide separate warning for inapplicable inline
	pragma.
	(Cannot_Inline): Reject subprograms that have an at_end handler, so that
	treatment is uniform on different targets.

From-SVN: r91882

gcc/ada/exp_ch6.adb

@@ -1051,7 +1051,7 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      --  The call node itself is re-analyzed in Expand_Call.
+      --  The call node itself is re-analyzed in Expand_Call
 
    end Expand_Actuals;
 
@@ -1974,6 +1974,10 @@ package body Exp_Ch6 is
       --  appropriate expansion to the corresponding tree node and we
       --  are all done (since after that the call is gone!)
 
+      --  In the case where the intrinsic is to be processed by the back end,
+      --  the call to Expand_Intrinsic_Call will do nothing, which is fine,
+      --  since the idea in this case is to pass the call unchanged.
+
       if Is_Intrinsic_Subprogram (Subp) then
          Expand_Intrinsic_Call (N, Subp);
          return;
@@ -2300,7 +2304,7 @@ package body Exp_Ch6 is
       Temp_Typ : Entity_Id;
 
       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
 
       function Process_Formals (N : Node_Id) return Traverse_Result;
       --  Replace occurrence of a formal with the corresponding actual, or
@@ -2331,7 +2335,7 @@ package body Exp_Ch6 is
 
       procedure Make_Exit_Label is
       begin
-         --  Create exit label for subprogram, if one doesn't exist yet.
+         --  Create exit label for subprogram if one does not exist yet
 
          if No (Exit_Lab) then
             Lab_Id := Make_Identifier (Loc, New_Internal_Name ('L'));
@@ -2509,15 +2513,13 @@ package body Exp_Ch6 is
          elsif Nkind (N) = N_Identifier
            and then Nkind (Parent (Entity (N))) = N_Object_Declaration
          then
-
-            --  The block assigns the result of the call to the temporary.
+            --  The block assigns the result of the call to the temporary
 
             Insert_After (Parent (Entity (N)), Blk);
 
          elsif Nkind (Parent (N)) = N_Assignment_Statement
            and then Is_Entity_Name (Name (Parent (N)))
          then
-
             --  Replace assignment with the block
 
             declare
@@ -2660,7 +2662,7 @@ package body Exp_Ch6 is
          Set_Declarations (Blk, New_List);
       end if;
 
-      --  If this is a derived function, establish the proper return type.
+      --  If this is a derived function, establish the proper return type
 
       if Present (Orig_Subp)
         and then Orig_Subp /= Subp
@@ -2797,7 +2799,7 @@ package body Exp_Ch6 is
             Targ := Name (Parent (N));
 
          else
-            --  Replace call with temporary, and create its declaration.
+            --  Replace call with temporary and create its declaration
 
             Temp :=
               Make_Defining_Identifier (Loc, New_Internal_Name ('C'));
@@ -2815,7 +2817,7 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      --  Traverse the tree and replace  formals with actuals or their thunks.
+      --  Traverse the tree and replace formals with actuals or their thunks.
       --  Attach block to tree before analysis and rewriting.
 
       Replace_Formals (Blk);
@@ -2879,7 +2881,7 @@ package body Exp_Ch6 is
 
       Restore_Env;
 
-      --  Cleanup mapping between formals and actuals, for other expansions.
+      --  Cleanup mapping between formals and actuals for other expansions
 
       F := First_Formal (Subp);
 
@@ -3493,9 +3495,9 @@ package body Exp_Ch6 is
             end loop;
          end if;
 
-      --  For a function, we must deal with the case where there is at
-      --  least one missing return. What we do is to wrap the entire body
-      --  of the function in a block:
+      --  For a function, we must deal with the case where there is at least
+      --  one missing return. What we do is to wrap the entire body of the
+      --  function in a block:
 
       --    begin
       --      ...
@@ -3732,7 +3734,7 @@ package body Exp_Ch6 is
       if Is_Subprogram (Proc)
         and then Proc /= Corr
       then
-         --  Protected function or procedure.
+         --  Protected function or procedure
 
          Set_Entity (Rec, Param);
 

gcc/ada/exp_intr.adb

@@ -281,12 +281,21 @@ package body Exp_Intr is
       then
          Expand_Source_Info (N, Nam);
 
-      else
-         --  Only other possibility is a renaming, in which case we expand
-         --  the call to the original operation (which must be intrinsic).
+         --  If we have a renaming, expand the call to the original operation,
+         --  which must itself be intrinsic, since renaming requires matching
+         --  conventions and this has already been checked.
 
-         pragma Assert (Present (Alias (E)));
+      elsif Present (Alias (E)) then
          Expand_Intrinsic_Call (N,  Alias (E));
+
+         --  The only other case is where an external name was specified,
+         --  since this is the only way that an otherwise unrecognized
+         --  name could escape the checking in Sem_Prag. Nothing needs
+         --  to be done in such a case, since we pass such a call to the
+         --  back end unchanged.
+
+      else
+         null;
       end if;
    end Expand_Intrinsic_Call;
 

gcc/ada/sem_prag.adb

@@ -2965,13 +2965,34 @@ package body Sem_Prag is
                else
                   Set_Imported (Def_Id);
 
-                  --  If Import intrinsic, set intrinsic flag and verify
-                  --  that it is known as such.
+                  --  Special processing for Convention_Intrinsic
 
                   if C = Convention_Intrinsic then
+
+                     --  Link_Name argument not allowed for intrinsic
+
+                     if Present (Arg3)
+                       and then Chars (Arg3) = Name_Link_Name
+                     then
+                        Arg4 := Arg3;
+                     end if;
+
+                     if Present (Arg4) then
+                        Error_Pragma_Arg
+                          ("Link_Name argument not allowed for " &
+                           "Import Intrinsic",
+                           Arg4);
+                     end if;
+
                      Set_Is_Intrinsic_Subprogram (Def_Id);
-                     Check_Intrinsic_Subprogram
-                       (Def_Id, Expression (Arg2));
+
+                     --  If no external name is present, then check that
+                     --  this is a valid intrinsic subprogram. If an external
+                     --  name is present, then this is handled by the back end.
+
+                     if No (Arg3) then
+                        Check_Intrinsic_Subprogram (Def_Id, Expression (Arg2));
+                     end if;
                   end if;
 
                   --  All interfaced procedures need an external symbol
@@ -3073,24 +3094,29 @@ package body Sem_Prag is
          procedure Set_Inline_Flags (Subp : Entity_Id);
          --  Sets Is_Inlined and Has_Pragma_Inline flags for Subp
 
-         function Cannot_Inline (Subp : Entity_Id) return Boolean;
-         --  Do not set the inline flag if body is available and contains
-         --  exception handlers, to prevent undefined symbols at link time.
-         --  Emit warning if front-end inlining is enabled and the pragma
-         --  appears too late.
+         function Inlining_Not_Possible (Subp : Entity_Id) return Boolean;
+         --  Returns True if it can be determined at this stage that inlining
+         --  is not possible, for examle if the body is available and contains
+         --  exception handlers, we prevent inlining, since otherwise we can
+         --  get undefined symbols at link time. This function also emits a
+         --  warning if front-end inlining is enabled and the pragma appears
+         --  too late.
+         --  ??? is business with link symbols still valid, or does it relate
+         --  to front end ZCX which is being phased out ???
 
-         -------------------
-         -- Cannot_Inline --
-         -------------------
+         ---------------------------
+         -- Inlining_Not_Possible --
+         ---------------------------
 
-         function Cannot_Inline (Subp : Entity_Id) return Boolean is
-            Decl : constant Node_Id := Unit_Declaration_Node (Subp);
+         function Inlining_Not_Possible (Subp : Entity_Id) return Boolean is
+            Decl  : constant Node_Id := Unit_Declaration_Node (Subp);
+            Stats : Node_Id;
 
          begin
             if Nkind (Decl) = N_Subprogram_Body then
-               return
-                 Present
-                   (Exception_Handlers (Handled_Statement_Sequence (Decl)));
+               Stats := Handled_Statement_Sequence (Decl);
+               return Present (Exception_Handlers (Stats))
+                 or else Present (At_End_Proc (Stats));
 
             elsif Nkind (Decl) = N_Subprogram_Declaration
               and then Present (Corresponding_Body (Decl))
@@ -3112,18 +3138,22 @@ package body Sem_Prag is
                   return False;
 
                else
+                  Stats :=
+                    Handled_Statement_Sequence
+                        (Unit_Declaration_Node (Corresponding_Body (Decl)));
+
                   return
-                    Present (Exception_Handlers
-                      (Handled_Statement_Sequence
-                        (Unit_Declaration_Node (Corresponding_Body (Decl)))));
+                    Present (Exception_Handlers (Stats))
+                      or else Present (At_End_Proc (Stats));
                end if;
+
             else
                --  If body is not available, assume the best, the check is
                --  performed again when compiling enclosing package bodies.
 
                return False;
             end if;
-         end Cannot_Inline;
+         end Inlining_Not_Possible;
 
          -----------------
          -- Make_Inline --
@@ -3137,8 +3167,10 @@ package body Sem_Prag is
             if Etype (Subp) = Any_Type then
                return;
 
-            elsif Cannot_Inline (Subp) then
-               Applies := True;    --  Do not treat as an error.
+            --  If inlining is not possible, for now do not treat as an error
+
+            elsif Inlining_Not_Possible (Subp) then
+               Applies := True;
                return;
 
             --  Here we have a candidate for inlining, but we must exclude
@@ -3277,8 +3309,13 @@ package body Sem_Prag is
             elsif not Effective
               and then Warn_On_Redundant_Constructs
             then
-               Error_Msg_NE ("pragma Inline for& is redundant?",
-                 N, Entity (Subp_Id));
+               if Inlining_Not_Possible (Subp) then
+                  Error_Msg_NE
+                    ("pragma Inline for& is ignored?", N, Entity (Subp_Id));
+               else
+                  Error_Msg_NE
+                    ("pragma Inline for& is redundant?", N, Entity (Subp_Id));
+               end if;
             end if;
 
             Next (Assoc);