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;
-- 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;
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
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'));
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
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
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'));
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);
Restore_Env;
- -- Cleanup mapping between formals and actuals, for other expansions.
+ -- Cleanup mapping between formals and actuals for other expansions
F := First_Formal (Subp);
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
-- ...
if Is_Subprogram (Proc)
and then Proc /= Corr
then
- -- Protected function or procedure.
+ -- Protected function or procedure
Set_Entity (Rec, Param);
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;
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
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))
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 --
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
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);
git://gcc.gnu.org / gcc.git / commitdiff