OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Arnaud Charlet 2004-12-08 12:27:00 +01:00
parent 2717634daa
commit 98f01d532a
3 changed files with 91 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/ada/exp_ch6.adb
View File

@ -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);

17
gcc/ada/exp_intr.adb
View File

@ -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;

87
gcc/ada/sem_prag.adb
View File

@ -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);