Skip to content

R
riscv-gcc-1
Commit f6f4d8d4 by Javier Miranda Committed by Arnaud Charlet
Options

exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Do not add cleanup… 

exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Do not add cleanup actions in thunks associated with interface types.

2013-04-11  Javier Miranda  <miranda@adacore.com>

	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Do
	not add cleanup actions in thunks associated with interface types.
	* exp_ch3.ad[sb] (Is_Variable_Size_Record): Move declaration to
	the package spec.
	* exp_ch4.adb (Tagged_Conversion): Update call to
	Expand_Interface_Conversion since the parameter Is_Static is no
	longer needed.
	* exp_ch6.adb (Expand_N_Extended_Return_Statement): Adding
	assertion to ensure that interface thunks are never handled by
	this routine.
	(Expand_N_Simple_Function_Return): Do not rewrite this statement
	as an extended return statement in interface thunks, and do not
	perform copy in the secondary stack if the return statement is
	located in a thunk.
	* exp_disp.adb (Expand_Dispatching_Call): No longer displace
	the pointer to the returned object in functions returning interface
	types.
	(Expand_Interface_Thunk): For functions returning interface types
	displace the pointer to the returned object.
	(Expand_Interface_Conversion): Remove formal
	Is_Static since this subprogram can now evaluate it locally.
	* sem_ch3.adb (Add_Internal_Interface_Entities): For functions
	propagate the type returned by the covered interface primitive to
	the internal interface entity. Needed by the thunk to generate
	the code which displaces "this" to reference the corresponding
	secondary dispatch table.
	* sem_disp.adb (Propagate_Tag): Update call to
	Expand_Interface_Conversion since the parameter Is_Static is no
	longer needed.
	* sem_res.adb (Resolve_Type_Conversion): Update calls to
	Expand_Interface_Conversion since the parameter Is_Static is no
	longer needed plus code cleanup.

From-SVN: r197786
parent 03eb6036
Showing with 235 additions and 122 deletions
gcc/ada/ChangeLog
2013-04-11 Javier Miranda <miranda@adacore.com>
* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Do
not add cleanup actions in thunks associated with interface types.
* exp_ch3.ad[sb] (Is_Variable_Size_Record): Move declaration to
the package spec.
* exp_ch4.adb (Tagged_Conversion): Update call to
Expand_Interface_Conversion since the parameter Is_Static is no
longer needed.
* exp_ch6.adb (Expand_N_Extended_Return_Statement): Adding
assertion to ensure that interface thunks are never handled by
this routine.
(Expand_N_Simple_Function_Return): Do not rewrite this statement
as an extended return statement in interface thunks, and do not
perform copy in the secondary stack if the return statement is
located in a thunk.
* exp_disp.adb (Expand_Dispatching_Call): No longer displace
the pointer to the returned object in functions returning interface
types.
(Expand_Interface_Thunk): For functions returning interface types
displace the pointer to the returned object.
(Expand_Interface_Conversion): Remove formal
Is_Static since this subprogram can now evaluate it locally.
* sem_ch3.adb (Add_Internal_Interface_Entities): For functions
propagate the type returned by the covered interface primitive to
the internal interface entity. Needed by the thunk to generate
the code which displaces "this" to reference the corresponding
secondary dispatch table.
* sem_disp.adb (Propagate_Tag): Update call to
Expand_Interface_Conversion since the parameter Is_Static is no
longer needed.
* sem_res.adb (Resolve_Type_Conversion): Update calls to
Expand_Interface_Conversion since the parameter Is_Static is no
longer needed plus code cleanup.
2013-04-11 Eric Botcazou <ebotcazou@adacore.com>
* init.c (RETURN_ADDR_OFFSET): Delete as unused.
......
gcc/ada/exp_ch11.adb
......@@ -1402,10 +1402,16 @@ package body Exp_Ch11 is
-- Add clean up actions if required
if Nkind (Parent (N)) /= N_Package_Body
and then Nkind (Parent (N)) /= N_Accept_Statement
and then Nkind (Parent (N)) /= N_Extended_Return_Statement
if not Nkind_In (Parent (N), N_Package_Body,
N_Accept_Statement,
N_Extended_Return_Statement)
and then not Delay_Cleanups (Current_Scope)
-- No cleanup action needed in thunks associated with interfaces
-- because they only displace the pointer to the object.
and then not (Is_Subprogram (Current_Scope)
and then Is_Thunk (Current_Scope))
then
Expand_Cleanup_Actions (Parent (N));
else
......
gcc/ada/exp_ch3.adb
......@@ -232,9 +232,6 @@ package body Exp_Ch3 is
function Is_Variable_Size_Array (E : Entity_Id) return Boolean;
-- Returns true if E has variable size components
function Is_Variable_Size_Record (E : Entity_Id) return Boolean;
-- Returns true if E has variable size components
function Make_Eq_Body
(Typ : Entity_Id;
Eq_Name : Name_Id) return Node_Id;
......
gcc/ada/exp_ch3.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -104,6 +104,9 @@ package Exp_Ch3 is
-- then tags components located at variable positions of Target are
-- initialized.
function Is_Variable_Size_Record (E : Entity_Id) return Boolean;
-- Returns true if E has variable size components (move to sem_util???)
function Needs_Simple_Initialization
(T : Entity_Id;
Consider_IS : Boolean := True) return Boolean;
......
gcc/ada/exp_ch4.adb
......@@ -10376,7 +10376,7 @@ package body Exp_Ch4 is
-- Ada 2005 (AI-251): Handle interface type conversion
if Is_Interface (Actual_Op_Typ) then
Expand_Interface_Conversion (N, Is_Static => False);
Expand_Interface_Conversion (N);
goto Done;
end if;
......
gcc/ada/exp_ch6.adb
......@@ -5489,6 +5489,13 @@ package body Exp_Ch6 is
-- Start of processing for Expand_N_Extended_Return_Statement
begin
-- Given that functionality of interface thunks is simple (just displace
-- the pointer to the object) they are always handled by means of
-- simple return statements.
pragma Assert (not Is_Subprogram (Current_Scope)
or else not Is_Thunk (Current_Scope));
if Nkind (Ret_Obj_Decl) = N_Object_Declaration then
Exp := Expression (Ret_Obj_Decl);
else
......@@ -7132,18 +7139,27 @@ package body Exp_Ch6 is
and then Is_Immutably_Limited_Type (Etype (Expression (N)))
and then Ada_Version >= Ada_2005
and then not Debug_Flag_Dot_L
-- The functionality of interface thunks is simple and it is always
-- handled by means of simple return statements. This leaves their
-- expansion simple and clean.
and then not (Is_Subprogram (Current_Scope)
and then Is_Thunk (Current_Scope))
then
declare
Return_Object_Entity : constant Entity_Id :=
Make_Temporary (Loc, 'R', Exp);
Obj_Decl : constant Node_Id :=
Make_Object_Declaration (Loc,
Defining_Identifier => Return_Object_Entity,
Object_Definition => Subtype_Ind,
Expression => Exp);
Ext : constant Node_Id := Make_Extended_Return_Statement (Loc,
Return_Object_Declarations => New_List (Obj_Decl));
Ext : constant Node_Id :=
Make_Extended_Return_Statement (Loc,
Return_Object_Declarations => New_List (Obj_Decl));
-- Do not perform this high-level optimization if the result type
-- is an interface because the "this" pointer must be displaced.
......@@ -7205,6 +7221,16 @@ package body Exp_Ch6 is
then
null;
-- No copy needed for thunks returning interface type objects since
-- the object is returned by reference and the maximum functionality
-- required is just to displace the pointer.
elsif Is_Subprogram (Current_Scope)
and then Is_Thunk (Current_Scope)
and then Is_Interface (Exptyp)
then
null;
elsif not Requires_Transient_Scope (R_Type) then
-- Mutable records with no variable length components are not
......
gcc/ada/exp_disp.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
......@@ -222,12 +222,10 @@ package Exp_Disp is
-- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
-- interfaces to reference the interface tag of the actual object
procedure Expand_Interface_Conversion
(N : Node_Id;
Is_Static : Boolean := True);
-- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
-- the object to give access to the interface tag associated with the
-- secondary dispatch table.
procedure Expand_Interface_Conversion (N : Node_Id);
-- Ada 2005 (AI-251): N is a type-conversion node. Displace the pointer
-- to the object to give access to the interface tag associated with the
-- dispatch table of the target type.
procedure Expand_Interface_Thunk
(Prim : Node_Id;
......
gcc/ada/sem_ch3.adb
......@@ -1661,6 +1661,15 @@ package body Sem_Ch3 is
(New_Subp, Is_Abstract_Subprogram (Prim));
Set_Interface_Alias (New_Subp, Iface_Prim);
-- If the returned type is an interface then propagate it to
-- the returned type. Needed by the thunk to generate the code
-- which displaces "this" to reference the corresponding
-- secondary dispatch table in the returned object.
if Is_Interface (Etype (Iface_Prim)) then
Set_Etype (New_Subp, Etype (Iface_Prim));
end if;
-- Internal entities associated with interface types are
-- only registered in the list of primitives of the tagged
-- type. They are only used to fill the contents of the
......
gcc/ada/sem_disp.adb
......@@ -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- --
......@@ -2445,7 +2445,7 @@ package body Sem_Disp is
Set_Etype (Call_Node, Etype (Control));
Set_Analyzed (Call_Node);
Expand_Interface_Conversion (Call_Node, Is_Static => False);
Expand_Interface_Conversion (Call_Node);
end if;
end;
......
gcc/ada/sem_res.adb
......@@ -9757,7 +9757,7 @@ package body Sem_Res is
N);
else
Expand_Interface_Conversion (N, Is_Static => False);
Expand_Interface_Conversion (N);
end if;
-- Conversion to interface type
......@@ -9770,29 +9770,18 @@ package body Sem_Res is
Opnd := Etype (Opnd);
end if;
if not Interface_Present_In_Ancestor
(Typ => Opnd,
Iface => Target)
if Is_Class_Wide_Type (Opnd)
or else Interface_Present_In_Ancestor
(Typ => Opnd,
Iface => Target)
then
if Is_Class_Wide_Type (Opnd) then
-- The static analysis is not enough to know if the
-- interface is implemented or not. Hence we must pass
-- the work to the expander to generate code to evaluate
-- the conversion at run time.
Expand_Interface_Conversion (N, Is_Static => False);
else
Error_Msg_Name_1 := Chars (Etype (Target));
Error_Msg_Name_2 := Chars (Opnd);
Error_Msg_N
("wrong interface conversion (% is not a progenitor "
& "of %)", N);
end if;
else
Expand_Interface_Conversion (N);
else
Error_Msg_Name_1 := Chars (Etype (Target));
Error_Msg_Name_2 := Chars (Opnd);
Error_Msg_N
("wrong interface conversion (% is not a progenitor "
& "of %)", N);
end if;
end if;
end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment